Added some error handling
This commit is contained in:
parent
a02176ee18
commit
6abe90d7cc
|
@ -3,17 +3,17 @@ module Evaluator where
|
||||||
import Expression
|
import Expression
|
||||||
import Primitives
|
import Primitives
|
||||||
|
|
||||||
eval :: Expression -> Expression
|
eval :: Expression -> Either String Expression
|
||||||
eval n@(Number _) = n
|
eval n@(Number _) = Right n
|
||||||
eval s@(Symbol _) = s
|
eval s@(Symbol _) = Right s
|
||||||
eval (SExpr es) = apply $ SExpr (map eval es)
|
eval (SExpr es) = mapM eval es >>= apply . SExpr
|
||||||
|
|
||||||
apply :: Expression -> Expression
|
apply :: Expression -> Either String Expression
|
||||||
apply (SExpr (f:args)) = case f of
|
apply (SExpr (f:args)) = case f of
|
||||||
Symbol "+" -> pAdd args
|
Symbol "+" -> Right $ pAdd args
|
||||||
Symbol "-" -> pSub args
|
Symbol "-" -> Right $ pSub args
|
||||||
Symbol "*" -> pMul args
|
Symbol "*" -> Right $ pMul args
|
||||||
Symbol "/" -> pDiv args
|
Symbol "/" -> Right $ pDiv args
|
||||||
Symbol _ -> error "no primitive functions not supported"
|
Symbol _ -> Left "no primitive functions not supported (only +, -, * and /)"
|
||||||
_ -> error "object not applicable"
|
_ -> Left "object not applicable"
|
||||||
apply _ = error "Object not applicable"
|
apply _ = Left "object not applicable"
|
||||||
|
|
|
@ -16,6 +16,7 @@ main = runInputT defaultSettings repl
|
||||||
Left err -> do
|
Left err -> do
|
||||||
outputStrLn $ show err
|
outputStrLn $ show err
|
||||||
repl
|
repl
|
||||||
Right e -> do
|
Right e -> outputStrLn (case eval e of
|
||||||
outputStrLn . show $ eval e
|
Right out -> show out
|
||||||
|
Left err -> err)
|
||||||
repl
|
repl
|
||||||
|
|
Loading…
Reference in New Issue