Adding cond

app/Main.hs

@@ -4,9 +4,9 @@ import System.Console.Haskeline
     ( defaultSettings, getInputLine, outputStrLn, runInputT, InputT )
 import BasicParser
 import LispParser
-import Expressions
 import Evaluator
 import LispEnv
+import Expressions
 
 main :: IO ()
 main = runInputT defaultSettings (loop defaultEnv)
@@ -25,7 +25,8 @@ main = runInputT defaultSettings (loop defaultEnv)
             case parse pStatement input of
                  (Just res, []) ->
                      case eval res env of
-                          (Right (str, env)) -> outputStrLn (show str) >> return env
+                          (Right (ANothing, env)) -> return env
+                          (Right (at, env)) -> outputStrLn (show at) >> return env
                           (Left err) -> outputStrLn err >> return env
                  (_, lo) -> outputStrLn ("**Error: Invalid syntax near: " ++ lo ++ "**")
                             >> return env

src/Evaluator.hs

@@ -54,6 +54,8 @@ showType v@(ACons _ _)   = "(Cons " ++ show v ++ ")"
 showType v@AProcedure {} = "(Procedure " ++ show v ++ ")"
 showType v@ABuiltin {}   = "(Builtin " ++ show v ++ ")"
 showType ATrue           = "(True #t)"
+showType AFalse          = "(False #f)"
+showType ANothing        = "(Nothing)"
 
 setupLocalVars :: [String] -> [Statement] -> LispEnv -> Either String LispEnv
 setupLocalVars (n:names) (v:values) env = do

src/Expressions.hs

@@ -10,12 +10,16 @@ data Atom =
     AQuote Atom |
     AProcedure String [String] SExpr |
     ABuiltin String ([Statement] -> LispEnv -> Either String (Atom, LispEnv)) |
-    ATrue
+    ATrue |
+    AFalse |
+    ANothing
 
 newtype SExpr = SExpr [Statement]
 
 instance Show Atom where
     show ATrue = "#t"
+    show ANothing = ""
+    show AFalse = "#f"
     show (AInt int) = show int
     show (ASymbol symb) = symb
     show (AString str) = "\"" ++ str ++ "\""

src/LispEnv.hs

@@ -9,7 +9,8 @@ defaultEnv = [
         ("car", ABuiltin "car" evalCar),
         ("cdr", ABuiltin "cdr" evalCdr),
         ("eq?", ABuiltin "eq?" evalEq),
-        ("atom?", ABuiltin "atom?" evalAtom)
+        ("atom?", ABuiltin "atom?" evalAtom),
+        ("cond", ABuiltin "cond" evalCond)
     ]
 
 evalCons :: [Statement] -> LispEnv -> Either String (Atom, LispEnv)
@@ -42,18 +43,19 @@ evalCdr _ _ = Left "**Error: incorect argument count in cdr**"
 
 _fromBool :: Bool -> Atom
 _fromBool True  = ATrue
-_fromBool False = ANil
+_fromBool False = AFalse
 
 evalEq :: [Statement] -> LispEnv -> Either String (Atom, LispEnv)
 evalEq [Atom (AInt f), Atom (AInt s)] env = Right (_fromBool (f == s), env)
 evalEq [Atom (ASymbol f), Atom (ASymbol s)] env = Right (_fromBool (f == s), env)
-evalEq [Atom (AString f), Atom (AString s)] env = Right (ANil, env) -- TODO Should do a reference equal
+evalEq [Atom (AString f), Atom (AString s)] env = Right (AFalse, env) -- TODO Should do a reference equal
 evalEq [Atom (AFloat f), Atom (AFloat s)] env = Right (_fromBool(f == s), env)
-evalEq [Atom (ACons _ _), _] env = Right (ANil, env)
+evalEq [Atom (ACons _ _), _] env = Right (AFalse, env)
 evalEq [Atom ANil, Atom ANil] env = Right (ATrue, env)
 evalEq [Atom (AProcedure f _ _), Atom (AProcedure s _ _)] env = Right (_fromBool (f == s), env)
 evalEq [Atom (ABuiltin f _), Atom (ABuiltin s _)] env = Right (_fromBool (f == s), env)
 evalEq [Atom ATrue, Atom ATrue] env = Right (ATrue, env)
+evalEq [Atom AFalse, Atom AFalse] env = Right (ATrue, env)
 evalEq [Expr exp, other] env = do
     (first, nEnv) <- evalS exp env
     evalEq [Atom first, other] nEnv
@@ -65,10 +67,19 @@ evalEq [other, Atom (AQuote quoted)] env = evalEq [Atom quoted, other] env
 evalEq _ _ = Left "**Error: Invalid arguments in eq?**"
 
 evalAtom :: [Statement] -> LispEnv -> Either String (Atom, LispEnv)
-evalAtom [Atom (ACons _ _)] env = Right (ANil, env)
+evalAtom [Atom (ACons _ _)] env = Right (AFalse, env)
 evalAtom [Atom (AQuote quoted)] env = evalAtom [Atom quoted] env
 evalAtom [Expr expr] env = do
     (atm, nEnv) <- evalS expr env
     evalAtom [Atom atm] nEnv
 evalAtom [Atom _] env = Right (ATrue, env)
-evalAtom _ _ = Left "**Error: Invalid arguments in atom?**"
+evalAtom _ _ = Left "**Error: Invalid arguments in atom?**"
+
+evalCond :: [Statement] -> LispEnv -> Either String (Atom, LispEnv)
+evalCond (Expr (SExpr [cond, value]):xs) env = do
+    (res, nEnv) <- eval cond env
+    case res of
+         AFalse -> evalCond xs nEnv
+         _ -> eval value nEnv
+evalCond [] env = Right (ANothing, env)
+evalCond _ _ = Left "**Error: Invalid syntax for cond.**"

src/LispParser.hs

@@ -9,6 +9,7 @@ _pAtom :: Parser Atom
 _pAtom = AInt <$> pInt
      <|> AFloat <$> pFloat
      <|> ATrue <$ pString "#t"
+     <|> AFalse <$ pString "#f"
      <|> pCharIf (== '"') *> (AString <$> pUntil (== '"')) <* pCharIf (== '"')
      <|> ANil <$ pString "nil"
      <|> ASymbol <$> pToken