Merge eval and evalAST in purescript implementation

impls/purs/packages.dhall

@@ -99,6 +99,7 @@ in upstream
 -------------------------------
 -}
 let upstream =
- https://github.com/purescript/package-sets/releases/download/psc-0.14.2-20210713/packages.dhall sha256:654c3148cb995f642c73b4508d987d9896e2ad3ea1d325a1e826c034c0d3cd7b
+ https://github.com/purescript/package-sets/releases/download/psc-0.15.8-20230420/packages.dhall
+ sha256:01f6ef030637be27a334e8f0977d563f9699543f596d60e8fb067e4f60d2e571
 
 in upstream

impls/purs/spago.dhall

@@ -31,7 +31,6 @@ to generate this file without the comments in this block.
  , "ordered-collections"
  , "parsing"
  , "prelude"
- , "psci-support"
  , "refs"
  , "strings"
  , "tailrec"

impls/purs/src/Reader.purs

@@ -10,11 +10,12 @@ import Data.List (List(..), many, (:))
 import Data.Maybe (Maybe(..), fromMaybe)
 import Effect (Effect)
 import Effect.Exception (throw)
+import Parsing (Parser, fail, runParser)
+import Parsing.Combinators (endBy, skipMany, skipMany1, try)
+import Parsing.String (char, string)
+import Parsing.String.Basic (noneOf, oneOf)
+import Parsing.Token (digit, letter)
 import Printer (keyValuePairs)
-import Text.Parsing.Parser (Parser, fail, runParser)
-import Text.Parsing.Parser.Combinators (endBy, skipMany, skipMany1, try)
-import Text.Parsing.Parser.String (char, noneOf, oneOf, string)
-import Text.Parsing.Parser.Token (digit, letter)
 import Types (MalExpr(..), charListToString, listToMap, toHashMap, toList, toVector)
 
 

impls/purs/src/Readline.js

@@ -1,8 +1,8 @@
 "use strict";
 
-var readlineSync = require('readline-sync')
+import readlineSync from 'readline-sync'
 
-exports.readLine = function (x) {
+export const readLine = function (x) {
  return function () {
  const result = readlineSync.question(x);
 
@@ -14,4 +14,4 @@ exports.readLine = function (x) {
 }
 
 
-exports.argv = process.argv;
+export const argv = process.argv;

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
 
 
 

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

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