5
\$\begingroup\$

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
\$\endgroup\$
2
\$\begingroup\$

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.

\$\endgroup\$
  • \$\begingroup\$ This is excellent. Thanks!! If you want to see the finished code it's here goo.gl/tS3MoF \$\endgroup\$ – Brendanator Mar 26 '14 at 19:45
  • \$\begingroup\$ 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" \$\endgroup\$ – Sean Perry Mar 26 '14 at 22:01
  • \$\begingroup\$ Sorry for the horrible formatting. \$\endgroup\$ – Sean Perry Mar 26 '14 at 22:01
  • \$\begingroup\$ 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. \$\endgroup\$ – Sean Perry Mar 26 '14 at 22:03

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.