Hi, I'm working on another article like <http://www.linuxjournal.com/article/8850>. This time, I'm taking an exercise out of "Expert C Programming: Deep C Secrets" and translating it into Haskell. The program translates C type declarations into English. I would greatly appreciate some code review. I'd prefer to look like an idiot in front of you guys rather than in front of everyone in the world! ;)
Please understand, I am not a Haskell expert! Therefore, please make your suggestions simple enough that I can actually accomplish them! By the way, my code *mostly* follows the code laid out in the book. I don't use a lexer or a parser or greatly improve on his algorithm. I'd like the Haskell and C versions to be similar so that they can be compared. The C version is: <http://www.cs.may.ie/~jpower/Courses/compilers/labs/lab3/parse_decl.c> The Haskell version is below. Thanks! -jj {- Translate C type declarations into English. This exercise was taken from "Expert C Programming: Deep C Secrets", p. 84. Example: echo -n "int *p;" | runhugs cdecl.hs Name: Shannon -jj Behrens <[EMAIL PROTECTED]> Date: Fri Feb 17 00:03:38 PST 2006 -} import Char (isSpace, isAlphaNum, isDigit) -- |> is like a UNIX pipe. infixl 9 |> x |> f = f x data TokenType = Identifier | Qualifier | Type | Symbol Char deriving (Show, Eq) data Token = Token { tokenType :: TokenType, tokenValue :: String } deriving Show data ParseContext = ParseContext { input :: String, -- The input that has not been parsed yet. output :: [String], -- A list of strings in the reverse order of that which -- they should be printed (e.g. [" a dog.", "I have"]). currTok :: Token, -- The current token, if defined. stack :: [Token] -- A stack of tokens we haven't dealt with yet. } deriving Show -- For convenience: currTokType :: ParseContext -> TokenType currTokType ctx = ctx |> currTok |> tokenType currTokValue :: ParseContext -> String currTokValue ctx = ctx |> currTok |> tokenValue type ParseContextTransformation = ParseContext -> ParseContext -- Start a new ParseContext given an input string. createParseContext :: String -> ParseContext createParseContext input = ParseContext {input=input, output=[], stack=[]} -- Create the final output string given a ParseContext. consolidateOutput :: ParseContext -> String consolidateOutput ctx = ctx |> output |> reverse |> concat {- "Write" to a ParseContext's output. The API is a bit strange. (writeOutput s) is itself a ParseContextTransformation which you can apply to ParseContexts. Strange but convenient. -} writeOutput :: String -> ParseContextTransformation writeOutput s = \ctx -> let newOutput = s : (output ctx) in ctx {output=newOutput} -- Return the top token on the stack. stackTop :: ParseContext -> Token stackTop ctx = let (x:xs) = stack ctx in x -- Pop the stack. pop :: ParseContextTransformation pop ctx = let (x:xs) = stack ctx in ctx {stack=xs} -- Write the value of the top of the stack and then pop it. popAndWrite :: ParseContextTransformation popAndWrite ctx = ctx |> ((stackTop ctx) |> tokenValue |> writeOutput) |> pop -- Classify a string into a Token. classifyString :: String -> Token classifyString "const" = Token Qualifier "read-only" classifyString "*" = Token (Symbol '*') "pointer to" classifyString s@(c:[]) | not (isAlphaNum c) = Token (Symbol c) s classifyString s = Token (whichType s) s where whichType "volatile" = Qualifier whichType "void" = Type whichType "char" = Type whichType "signed" = Type whichType "unsigned" = Type whichType "short" = Type whichType "int" = Type whichType "long" = Type whichType "float" = Type whichType "double" = Type whichType "struct" = Type whichType "union" = Type whichType "enum" = Type whichType _ = Identifier -- Read the next token into currTok. getToken :: ParseContextTransformation getToken ctx@(ParseContext {input=s}) = let lstrip s = dropWhile isSpace s (token, theRest) = s |> lstrip |> lexString in ctx {currTok=token, input=theRest} -- Read a token. Return it and the left-over portion of the string. lexString :: String -> (Token, String) lexString s@(c:cs) | isAlphaNum c = let (tokString, theRest) = span isAlphaNum s token = classifyString tokString in (token, theRest) lexString ('*':cs) = (classifyString "*", cs) lexString (c:cs) = (classifyString (c:[]), cs) -- Put tokens on the stack until we reach the first identifier. readToFirstIdentifier :: ParseContextTransformation readToFirstIdentifier ctx = let afterIdentifier = ctx |> getToken |> pushUntilIdentifier identifier = afterIdentifier |> currTokValue s = identifier ++ " is " in (afterIdentifier {output=[s]}) |> getToken -- Keep pushing tokens until we hit an identifier. pushUntilIdentifier :: ParseContextTransformation pushUntilIdentifier ctx | currTokType ctx == Identifier = ctx | otherwise = let newStack = (currTok ctx) : (stack ctx) in (ctx {stack=newStack}) |> getToken |> pushUntilIdentifier -- Deal with arrays. dealWithArrays :: ParseContextTransformation dealWithArrays ctx = let writeIfNumber ctx = -- Call writeSize if a number. if ctx |> currTokValue |> (!! 0) |> isDigit then ctx |> writeSize |> getToken else ctx writeSize ctx = -- Output the array size. let num = ctx |> currTokValue |> read |> (+ -1) |> show s = "0.." ++ num ++ " " in ctx |> (writeOutput s) in case currTokType ctx of Symbol '[' -> ctx |> (writeOutput "array ") |> getToken |> writeIfNumber |> getToken |> (writeOutput "of ") |> dealWithArrays _ -> ctx -- Recurse until we get past the ['s. -- Deal with function arguments. dealWithFunctionArgs :: ParseContextTransformation dealWithFunctionArgs ctx = let getUntilParen ctx = -- Read tokens until we hit ). case currTokType ctx of Symbol ')' -> ctx _ -> ctx |> getToken |> getUntilParen in ctx |> getUntilParen |> getToken |> (writeOutput "function returning ") -- Deal with pointers. dealWithPointers :: ParseContextTransformation dealWithPointers ctx = case ctx |> stackTop |> tokenType of Symbol '*' -> ctx |> popAndWrite |> (writeOutput " ") |> dealWithPointers _ -> ctx -- Recurse until we get past the *'s. -- Process tokens that we stacked while reading to identifier. dealWithStack :: ParseContextTransformation dealWithStack ctx = case stack ctx of [] -> ctx (x:xs) -> case tokenType x of Symbol '(' -> ctx |> pop |> getToken |> dealWithDeclarator _ -> ctx |> popAndWrite -- Do all parsing after first identifier. dealWithDeclarator :: ParseContextTransformation dealWithDeclarator ctx = ctx |> (case currTokType ctx of Symbol '[' -> dealWithArrays Symbol '(' -> dealWithFunctionArgs _ -> id) |> dealWithPointers |> dealWithStack -- Translate a C type declaration into English. translate :: String -> String translate s = s |> createParseContext |> readToFirstIdentifier |> dealWithDeclarator |> consolidateOutput -- Change this to "show" to debug. -- Main main :: IO () main = do input <- getContents input |> translate |> putStrLn _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe