Using Parsec for simple arithmetic language

Question

I've been reading Types and Programming Languages and I wanted to try to implement the first language in Haskell to understand it properly

I have barely written any Haskell before and not used Parsec so I would grateful for any feedback on this code

Here are some specific points I am unsure about

1. Is my main function sensible?
2. Can the eval function be expressed any better?
3. I'm unhappy with functionParser and ifParser. How can I code these better. In particular can the ifParser be coded in an applicative style?

If there's anything else you consider odd don't hesitate to mention it

import Control.Monad 
import System.Environment 
import Text.ParserCombinators.Parsec
data Term = TmTrue
 | TmFalse
 | TmIf Term Term Term
 | TmZero
 | TmSucc Term
 | TmPred Term
 | TmIsZero Term
 | TmError
 deriving Show
main :: IO[()]
main = do 
 args <- getArgs
 forM args (\arg -> case parseArith arg of
 Left e -> print e 
 Right term -> print $ eval term)
isNumerical :: Term -> Bool
isNumerical term = case term of
 TmZero -> True
 TmSucc subterm -> isNumerical subterm
 TmPred subterm -> isNumerical subterm
 _ -> False
eval :: Term -> Term
eval term = case term of 
 TmTrue -> TmTrue
 TmFalse -> TmFalse
 TmZero -> TmZero
 TmIf term1 term2 term3 -> case eval term1 of
 TmTrue -> eval term2
 TmFalse -> eval term3
 _ -> TmError
 TmIsZero subterm -> case eval subterm of
 TmZero -> TmTrue
 t2 | isNumerical t2 -> TmFalse
 _ -> TmError
 TmPred TmZero -> TmZero
 TmPred (TmSucc subterm) -> eval subterm
 TmSucc subterm -> case eval subterm of
 t2 | isNumerical t2 -> TmSucc t2
 _ -> TmError
 _ -> TmError
parseArith :: String -> Either ParseError Term
parseArith input = parse arithParser "Failed to parse arithmetic expression" input
arithParser :: GenParser Char st Term
arithParser = try( ifParser ) 
 <|> try( succParser )
 <|> try( predParser )
 <|> try( isZeroParser ) 
 <|> try( trueParser )
 <|> try( falseParser )
 <|> try( zeroParser )
trueParser :: GenParser Char st Term
trueParser = string "true" >> return TmTrue
falseParser :: GenParser Char st Term
falseParser = string "false" >> return TmFalse
zeroParser :: GenParser Char st Term
zeroParser = char '0' >> return TmZero
functionParser :: String -> (Term -> Term) -> GenParser Char st Term
functionParser name funcTerm = do
 string $ name ++ "(" 
 term <- arithParser
 char ')'
 return $ funcTerm term
succParser :: GenParser Char st Term
succParser = functionParser "succ" TmSucc
predParser :: GenParser Char st Term
predParser = functionParser "pred" TmPred
isZeroParser :: GenParser Char st Term
isZeroParser = functionParser "iszero" TmIsZero
ifParser :: GenParser Char st Term
ifParser = do
 string "if"
 spaces
 term1 <- arithParser
 spaces
 string "then"
 spaces
 term2 <- arithParser
 spaces
 string "else"
 spaces
 term3 <- arithParser
 return $ TmIf term1 term2 term3

Answer 1

Where you used case you could have used pattern matching. This yields more idiomatic code in many cases.

isNumerical :: Term -> Bool
isNumerical TmZero = True
isNumerical (TmSucc subterm) = isNumerical subterm
isNumerical (TmPred subterm) = isNumerical subterm
isNumerical _ = False
eval :: Term -> Term
eval TmTrue = TmTrue
eval TmFalse = TmFalse
eval TmZero = TmZero
eval (TmIf term1 term2 term3) = evalIf (eval term1) term2 term3
eval (TmIsZero subterm) = evalIsZero $ eval subterm
eval (TmPred subterm) = evalPred $ eval subterm
eval (TmSucc subterm) = evalSucc $ eval subterm
eval TmError = TmError
evalIf :: Term -> Term -> Term -> Term
evalIf TmTrue a _ = eval a
evalIf TmFalse _ b = eval b
evalIf _ _ _ = TmError
evalIsZero :: Term -> Term
evalIsZero TmZero = TmTrue
evalIsZero term
 | isNumerical term = TmFalse
 | otherwise = TmError
evalPred :: Term -> Term
evalPred TmZero = TmZero
evalPred t@(TmSucc subterm) = t
evalPred _ = TmError
evalSucc :: Term -> Term
evalSucc term
 | isNumerical term = TmSucc term
 | otherwise = TmError

Note the complex terms are farmed off to their own functions. This makes testing easier. Especially as the runtime gets more complex.

You asked about main's type. If you use forM_ you can define it as main :: IO ().

As for Applicative:

functionParser :: String -> (Term -> Term) -> GenParser Char st Term
functionParser name funcTerm = funcTerm <$> (string (name ++ "(")
 *> arithParser
 <* char ')')
ifParser :: GenParser Char st Term
ifParser = TmIf <$> (string "if" *> spaces *> arithParser)
 <*> (spaces *> string "then" *> spaces *> arithParser)
 <*> (spaces *> string "else" *> spaces *> arithParser)

Also, the last 'try' should not be used. 'try' means to attempt a parse and do not consume the input if it failed. The last parse action is the end of the parse so there is no need to leave the input in the parser.

• Brendanator: This is excellent. Thanks!! If you want to see the finished code it's here github.com/brendanator/tapl/blob/master/arith/arith.hs
• Sean Perry: I did not have time to add this part. Consider using an error monad.type TAPLArithResult = Either String Term eval :: Term -> TAPLArithResult eval (TmIf term1 term2 term3) = do term1' <- eval term1 evalIf term1' term2 term3 eval (TmIsZero subterm) = eval subterm >>= evalIsZero eval (TmPred subterm) = eval subterm >>= evalPred eval (TmSucc subterm) = eval subterm >>= evalSucc -- The next one will not be triggered unless a new value is added to Term eval _ = Left "unknown supported type in eval"
• Sean Perry: Sorry for the horrible formatting.
• Sean Perry: If this were a real language, TAPLArithResult would probably be an ErrorT using Either and IO. By using the type synonym you make it easy to change your mind later.