purs: merge evalAst into eval and add DEBUG-EVAL

See kanaka#592 for context.
asarhaddon · Aug 7, 2024 · c05d376 · c05d376
1 parent 3f6a40f
commit c05d376
Show file tree

Hide file tree

Showing 9 changed files with 347 additions and 388 deletions.
diff --git a/impls/purs/src/step2_eval.purs b/impls/purs/src/step2_eval.purs
@@ -15,7 +15,7 @@ import Effect.Exception (throw, try)
 import Reader (readStr)
 import Printer (printStr)
 import Readline (readLine)
-import Types (MalExpr(..), MalFn, toHashMap, toList, toVector)
+import Types (MalExpr(..), MalFn, toHashMap, toVector)
 
 
 -- MAIN
@@ -27,24 +27,22 @@ main = loop
 
 -- EVAL
 
-eval :: MalExpr -> Effect MalExpr
-eval ast@(MalList _ Nil) = pure ast
-eval (MalList _ ast)     = do
-  es <- traverse evalAst ast
+evalCallFn :: List MalExpr -> Effect MalExpr
+evalCallFn ast = do
+  es <- traverse eval ast
   case es of
     MalFunction {fn:f}: args -> f args
-    _                        -> pure $ toList es
-eval ast                 = evalAst ast
+    _                        -> throw $ "invalid function"
 
 
-evalAst :: MalExpr -> Effect MalExpr
-evalAst (MalSymbol s)      = case lookup s replEnv of
+eval :: MalExpr -> Effect MalExpr
+eval (MalSymbol s)      = case lookup s replEnv of
   Just f  -> pure f
   Nothing -> throw "invalid function"
-evalAst ast@(MalList _ _ ) = eval ast
-evalAst (MalVector _ es)   = toVector <$> (traverse eval es)
-evalAst (MalHashMap _ es)  = toHashMap <$> (traverse eval es)
-evalAst ast                = pure ast
+eval (MalList _ es@(_ : _)) = evalCallFn es
+eval (MalVector _ es)   = toVector <$> (traverse eval es)
+eval (MalHashMap _ es)  = toHashMap <$> (traverse eval es)
+eval ast                = pure ast
 
 
 

diff --git a/impls/purs/src/step3_env.purs b/impls/purs/src/step3_env.purs
@@ -29,34 +29,41 @@ main = do
 
 -- EVAL
 
-eval :: RefEnv -> MalExpr -> Effect MalExpr
-eval _ ast@(MalList _ Nil) = pure ast
-eval env (MalList _ ast)   = case ast of
-  MalSymbol "def!" : es -> evalDef env es
-  MalSymbol "let*" : es -> evalLet env es
-  _                     -> do
-    es <- traverse (evalAst env) ast
+evalCallFn :: RefEnv -> List MalExpr -> Effect MalExpr
+evalCallFn env ast = do
+    es <- traverse (eval env) ast
     case es of
       MalFunction {fn:f} : args -> f args
       _                         -> throw "invalid function"
-eval env ast               = evalAst env ast
 
 
-evalAst :: RefEnv -> MalExpr -> Effect MalExpr
-evalAst env (MalSymbol s)       = do
-  result <- Env.get env s
-  case result of
-    Just k  -> pure k
-    Nothing -> throw $ "'" <> s <> "'" <> " not found"
-evalAst env ast@(MalList _ _)   = eval env ast
-evalAst env (MalVector _ envs)  = toVector <$> traverse (eval env) envs
-evalAst env (MalHashMap _ envs) = toHashMap <$> traverse (eval env) envs
-evalAst _ ast                   = pure ast
+eval :: RefEnv -> MalExpr -> Effect MalExpr
+eval env ast = do
+  dbgeval <- Env.get env "DEBUG-EVAL"
+  case dbgeval of
+    Nothing                 -> pure unit
+    Just MalNil             -> pure unit
+    Just (MalBoolean false) -> pure unit
+    _                       -> do
+      image <- print ast
+      log ("EVAL: " <> image)
+  case ast of
+    MalSymbol s   -> do
+      result <- Env.get env s
+      case result of
+        Just k  -> pure k
+        Nothing -> throw $ "'" <> s <> "'" <> " not found"
+    MalList _ (MalSymbol "def!" : es)       -> evalDef env es
+    MalList _ (MalSymbol "let*" : es)       -> evalLet env es
+    MalList _ es@(_ : _)                    -> evalCallFn env es
+    MalVector _ es  -> toVector <$> traverse (eval env) es
+    MalHashMap _ es -> toHashMap <$> traverse (eval env) es
+    _               -> pure ast
 
 
 evalDef :: RefEnv -> List MalExpr -> Effect MalExpr
 evalDef env (MalSymbol v : e : Nil) = do
-  evd <- evalAst env e
+  evd <- eval env e
   Env.set env v evd
   pure evd
 evalDef _ _                         = throw "invalid def!"
@@ -66,18 +73,18 @@ evalLet :: RefEnv -> List MalExpr -> Effect MalExpr
 evalLet env (MalList _ ps : e : Nil)   = do
   letEnv <- Env.newEnv env
   letBind letEnv ps
-  evalAst letEnv e
+  eval letEnv e
 evalLet env (MalVector _ ps : e : Nil) = do
   letEnv <- Env.newEnv env
   letBind letEnv ps
-  evalAst letEnv e
+  eval letEnv e
 evalLet _ _                            = throw "invalid let*"
 
 
 letBind :: RefEnv -> List MalExpr -> Effect Unit
 letBind _ Nil                       = pure unit
 letBind env (MalSymbol ky : e : es) = do
-  Env.set env ky =<< evalAst env e
+  Env.set env ky =<< eval env e
   letBind env es
 letBind _ _                         = throw "invalid let*"
 
@@ -86,7 +93,7 @@ letBind _ _                         = throw "invalid let*"
 -- REPL
 
 rep :: RefEnv -> String -> Effect String
-rep env str = print =<< evalAst env =<< read str
+rep env str = print =<< eval env =<< read str
 
 
 loop :: RefEnv -> Effect Unit

diff --git a/impls/purs/src/step4_if_fn_do.purs b/impls/purs/src/step4_if_fn_do.purs
@@ -33,37 +33,44 @@ main = do
 
 -- EVAL
 
-eval :: RefEnv -> MalExpr -> Effect MalExpr
-eval _ ast@(MalList _ Nil) = pure ast
-eval env (MalList _ ast)   = case ast of
-  MalSymbol "def!" : es -> evalDef env es
-  MalSymbol "let*" : es -> evalLet env es
-  MalSymbol "if" : es   -> evalIf env es
-  MalSymbol "do" : es   -> evalDo env es
-  MalSymbol "fn*" : es  -> evalFnMatch env es
-  _                     -> do
-    es <- traverse (evalAst env) ast
+evalCallFn :: RefEnv -> List MalExpr -> Effect MalExpr
+evalCallFn env ast = do
+    es <- traverse (eval env) ast
     case es of
       MalFunction {fn:f} : args -> f args
       _                         -> throw "invalid function"
-eval env ast               = evalAst env ast
 
 
-evalAst :: RefEnv -> MalExpr -> Effect MalExpr
-evalAst env (MalSymbol s)     = do
-  result <- Env.get env s
-  case result of
-    Just k  -> pure k
-    Nothing -> throw $ "'" <> s <> "'" <> " not found"
-evalAst env ast@(MalList _ _)   = eval env ast
-evalAst env (MalVector _ envs)  = toVector <$> traverse (eval env) envs
-evalAst env (MalHashMap _ envs) = toHashMap <$> traverse (eval env) envs
-evalAst _ ast                 = pure ast
+eval :: RefEnv -> MalExpr -> Effect MalExpr
+eval env ast = do
+  dbgeval <- Env.get env "DEBUG-EVAL"
+  case dbgeval of
+    Nothing                 -> pure unit
+    Just MalNil             -> pure unit
+    Just (MalBoolean false) -> pure unit
+    _                       -> do
+      image <- print ast
+      log ("EVAL: " <> image)
+  case ast of
+    MalSymbol s   -> do
+      result <- Env.get env s
+      case result of
+        Just k  -> pure k
+        Nothing -> throw $ "'" <> s <> "'" <> " not found"
+    MalList _ (MalSymbol "def!" : es)       -> evalDef env es
+    MalList _ (MalSymbol "let*" : es)       -> evalLet env es
+    MalList _ (MalSymbol "if" : es)         -> evalIf env es
+    MalList _ (MalSymbol "do" : es)         -> evalDo env es
+    MalList _ (MalSymbol "fn*" : es)        -> evalFnMatch env es
+    MalList _ es@(_ : _)                    -> evalCallFn env es
+    MalVector _ es  -> toVector <$> traverse (eval env) es
+    MalHashMap _ es -> toHashMap <$> traverse (eval env) es
+    _               -> pure ast
 
 
 evalDef :: RefEnv -> List MalExpr -> Effect MalExpr
 evalDef env (MalSymbol v : e : Nil) = do
-  evd <- evalAst env e
+  evd <- eval env e
   Env.set env v evd
   pure evd
 evalDef _ _                         = throw "invalid def!"
@@ -73,41 +80,41 @@ evalLet :: RefEnv -> List MalExpr -> Effect MalExpr
 evalLet env (MalList _ ps : e : Nil)   = do
   letEnv <- Env.newEnv env
   letBind letEnv ps
-  evalAst letEnv e
+  eval letEnv e
 evalLet env (MalVector _ ps : e : Nil) = do
   letEnv <- Env.newEnv env
   letBind letEnv ps
-  evalAst letEnv e
+  eval letEnv e
 evalLet _ _                            = throw "invalid let*"
 
 
 
 letBind :: RefEnv -> List MalExpr -> Effect Unit
 letBind _ Nil                       = pure unit
 letBind env (MalSymbol ky : e : es) = do
-  Env.set env ky =<< evalAst env e
+  Env.set env ky =<< eval env e
   letBind env es
 letBind _ _                         = throw "invalid let*"
 
 
 evalIf :: RefEnv -> List MalExpr -> Effect MalExpr
 evalIf env (b:t:e:Nil) = do
-  cond <- evalAst env b
-  evalAst env case cond of
+  cond <- eval env b
+  eval env case cond of
     MalNil           -> e
     MalBoolean false -> e
     _                -> t
 evalIf env (b:t:Nil)   = do
-  cond <- evalAst env b
-  evalAst env case cond of
+  cond <- eval env b
+  eval env case cond of
     MalNil           -> MalNil
     MalBoolean false -> MalNil
     _                -> t
 evalIf _ _             = throw "invalid if"
 
 
 evalDo :: RefEnv -> List MalExpr -> Effect MalExpr
-evalDo env es = foldM (const $ evalAst env) MalNil es
+evalDo env es = foldM (const $ eval env) MalNil es
 
 
 evalFnMatch :: RefEnv -> List MalExpr -> Effect MalExpr
@@ -133,7 +140,7 @@ evalFn env params body = do
     fnEnv <- Env.newEnv env
     ok <- Env.sets fnEnv params' args
     if ok
-      then evalAst fnEnv body'
+      then eval fnEnv body'
       else throw "actual parameters do not match signature "
 
   unwrapSymbol :: MalExpr -> Effect String
@@ -145,7 +152,7 @@ evalFn env params body = do
 -- REPL
 
 rep :: RefEnv -> String -> Effect String
-rep env str = print =<< evalAst env =<< read str
+rep env str = print =<< eval env =<< read str
 
 
 loop :: RefEnv -> Effect Unit