Hi, Thanks to everyone who reviewed my code and submitted comments the first time! I've updated the code and transitioned to using the State monad. Perhaps controversially, I've continued to use |> in a bunch of places that the monad didn't get rid of because I think it's more readable, but I'm still open for argument on this topic. Using the monad didn't make the code any shorter, but it kind of "felt" better, once I figured out how to use it. Figuring out how to use execState to get into and out of "monad-ity" was the hardest part, because it's mentioned in so few of the examples. I think it's fair to say, of course, that using a monad has increased the complexity, but I can still read what I wrote. I've posted my code below for additional comments. Thanks again! -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 <jjinux@gmail.com> Date: Fri Feb 17 00:03:38 PST 2006 -} import Char (isSpace, isAlphaNum, isDigit) import Control.Monad.State -- |> 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 -- Start a new State 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. writeOutput :: String -> State ParseContext () writeOutput s = modify (\ctx -> ctx {output = s : output ctx}) -- Return the top token on the stack. stackTop :: ParseContext -> Token stackTop ctx = ctx |> stack |> head -- Pop the stack. pop :: State ParseContext () pop = modify (\ctx -> ctx {stack = ctx |> stack |> tail}) -- Write the value of the top of the stack and then pop it. popAndWrite :: State ParseContext () popAndWrite = do top <- gets stackTop writeOutput (tokenValue top) pop -- Classify a string into a Token. classifyString :: String -> Token classifyString "const" = Token Qualifier "read-only" classifyString "*" = Token (Symbol '*') "pointer to" classifyString [c] | not (isAlphaNum c) = Token (Symbol c) [c] classifyString s = Token tokType s where tokType = case s of "volatile" -> Qualifier x | x `elem` ["void", "char", "signed", "unsigned", "short", "int", "long", "float", "double", "struct", "union", "enum"] -> Type x -> Identifier -- Read the next token into currTok. getToken :: State ParseContext () getToken = modify getToken' where getToken' ctx@(ParseContext {input = s}) = ctx {currTok = token, input = theRest} where (token, theRest) = s |> lstrip |> lexString lstrip s = dropWhile isSpace s -- Read a token. Return it and the left-over portion of the string. lexString :: String -> (Token, String) lexString s@(c:cs) | isAlphaNum c = (token, theRest) where (tokString, theRest) = span isAlphaNum s token = classifyString tokString lexString ('*':cs) = (classifyString "*", cs) lexString (c:cs) = (classifyString [c], cs) -- Put tokens on the stack until we reach the first identifier. readToFirstIdentifier :: State ParseContext () readToFirstIdentifier = do getToken pushUntilIdentifier afterIdentifier <- get let s = identifier ++ " is " identifier = currTokValue afterIdentifier in put (afterIdentifier {output = [s]}) getToken -- Keep pushing tokens until we hit an identifier. pushUntilIdentifier :: State ParseContext () pushUntilIdentifier = do ctx <- get if currTokType ctx == Identifier then return () -- Leave things as they are. else do put (ctx {stack = (currTok ctx) : (stack ctx)}) getToken pushUntilIdentifier return () -- Deal with arrays. dealWithArrays :: State ParseContext () dealWithArrays = do ctx <- get case currTokType ctx of Symbol '[' -> do writeOutput "array " getToken writeIfNumber getToken writeOutput "of " dealWithArrays _ -> return () -- Recurse until we get past the ['s. where writeIfNumber = do -- Call writeSize if a number. tokValue <- gets currTokValue if tokValue |> head |> isDigit then do writeSize getToken else return () writeSize = do -- Output the array size. tokValue <- gets currTokValue let num = tokValue |> read |> (+ -1) |> show s = "0.." ++ num ++ " " in -- Can't use where instead of let here. writeOutput s -- Deal with function arguments. dealWithFunctionArgs :: State ParseContext () dealWithFunctionArgs = do getUntilParen getToken writeOutput "function returning " where getUntilParen = do -- Read tokens until we hit ). ctx <- get case currTokType ctx of Symbol ')' -> return () _ -> do getToken getUntilParen -- Deal with pointers. dealWithPointers :: State ParseContext () dealWithPointers = do top <- gets stackTop case tokenType top of Symbol '*' -> do popAndWrite writeOutput " " dealWithPointers _ -> return () -- Recurse until we get past the *'s. -- Process tokens that we stacked while reading to identifier. dealWithStack :: State ParseContext () dealWithStack = do stack' <- gets stack case stack' of [] -> return () (x:xs) -> case tokenType x of Symbol '(' -> do pop getToken dealWithDeclarator _ -> popAndWrite -- Do all parsing after first identifier. dealWithDeclarator :: State ParseContext () dealWithDeclarator = do tokType <- gets currTokType case tokType of Symbol '[' -> dealWithArrays Symbol '(' -> dealWithFunctionArgs _ -> return () -- "Exit" the case, not the function. dealWithPointers dealWithStack -- Do all parsing. dealWithEverything :: State ParseContext () dealWithEverything = do readToFirstIdentifier dealWithDeclarator -- Translate a C type declaration into English. translate :: String -> String translate s = -- Change "consolidateOutput" to "show" to debug. s |> createParseContext |> execState dealWithEverything |> consolidateOutput main :: IO () main = do input <- getContents input |> translate |> putStrLn On 3/5/06, Shannon -jj Behrens <jjinux@gmail.com> wrote:
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. [snip]