kanaka/mal
1
1
Fork 0
mirror of https://github.com/kanaka/mal.git synced 2024-09-19 17:47:53 +03:00
Code Issues Projects Releases Wiki Activity

purs: merge evalAst into eval and add DEBUG-EVAL

Browse Source 
See #592 for context.
This commit is contained in:
Nicolas Boulenguez 2023-04-20 14:30:08 +02:00 committed by Joel Martin
parent 1354b3fe9c
commit c5788b3790
9 changed files with 347 additions and 388 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
impls/purs/src/step2_eval.purs
View File

@ -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

45
impls/purs/src/step3_env.purs
View File

@ -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
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"
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
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

63
impls/purs/src/step4_if_fn_do.purs
View File

@ -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
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"
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
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,11 +80,11 @@ 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*"
@ -85,21 +92,21 @@ 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
@ -107,7 +114,7 @@ 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

63
impls/purs/src/step5_tco.purs
View File

@ -43,32 +43,35 @@ main = do
-- EVAL
eval :: RefEnv -> MalExpr -> Eval 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
_ -> evalCallFn env ast
eval env ast = evalAst env ast
evalAst :: RefEnv -> MalExpr -> Eval MalExpr
evalAst env (MalSymbol s) = do
eval env ast = do
dbgeval <- liftEffect (Env.get env "DEBUG-EVAL")
liftEffect 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 <- liftEffect $ 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
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 -> Eval MalExpr
evalDef env (MalSymbol v : e : Nil) = do
evd <- evalAst env e
evd <- eval env e
liftEffect $ Env.set env v evd
pure evd
evalDef _ _ = throw "invalid def!"
@ -78,11 +81,11 @@ evalLet :: RefEnv -> List MalExpr -> Eval MalExpr
evalLet env (MalList _ ps : e : Nil) = do
letEnv <- liftEffect $ Env.newEnv env
letBind letEnv ps
evalAst letEnv e
eval letEnv e
evalLet env (MalVector _ ps : e : Nil) = do
letEnv <- liftEffect $ Env.newEnv env
letBind letEnv ps
evalAst letEnv e
eval letEnv e
evalLet _ _ = throw "invalid let*"
@ -90,7 +93,7 @@ evalLet _ _ = throw "invalid let*"
letBind :: RefEnv -> List MalExpr -> Eval Unit
letBind _ Nil = pure unit
letBind env (MalSymbol ky : e : es) = do
ex <- evalAst env e
ex <- eval env e
liftEffect $ Env.set env ky ex
letBind env es
letBind _ _ = throw "invalid let*"
@ -98,14 +101,14 @@ letBind _ _ = throw "invalid let*"
evalIf :: RefEnv -> List MalExpr -> Eval 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
@ -113,7 +116,7 @@ evalIf _ _ = throw "invalid if"
evalDo :: RefEnv -> List MalExpr -> Eval MalExpr
evalDo env es = foldM (const $ evalAst env) MalNil es
evalDo env es = foldM (const $ eval env) MalNil es
evalFnMatch :: RefEnv -> List MalExpr -> Eval MalExpr
@ -139,7 +142,7 @@ evalFn env params body = do
fnEnv <- Env.newEnv env
ok <- Env.sets fnEnv params' args
if ok
then runEval $ evalAst fnEnv body'
then runEval $ eval fnEnv body'
else throw "actual parameters do not match signature "
unwrapSymbol :: MalExpr -> Eval String
@ -157,7 +160,7 @@ rep_ env str = rep env str *> pure unit
rep :: RefEnv -> String -> Effect String
rep env str = do
ast <- read str
result <- runEval $ evalAst env ast
result <- runEval $ eval env ast
print result
@ -193,13 +196,13 @@ setFn env (Tuple sym f) = do
evalCallFn :: RefEnv -> List MalExpr -> Eval MalExpr
evalCallFn env ast = do
es <- traverse (evalAst env) ast
es <- traverse (eval env) ast
case es of
MalFunction {fn:f, ast:MalNil} : args -> liftEffect $ f args
MalFunction {ast:ast', params:params', env:env'} : args -> do
newEnv <- liftEffect $ Env.newEnv env'
_ <- liftEffect $ Env.sets newEnv params' args
evalAst newEnv ast'
eval newEnv ast'
_ -> throw "invalid function"

63
impls/purs/src/step6_file.purs
View File

@ -57,7 +57,7 @@ rep_ env str = rep env str *> pure unit
rep :: RefEnv -> String -> Effect String
rep env str = do
ast <- read str
result <- runEval $ evalAst env ast
result <- runEval $ eval env ast
print result
@ -97,32 +97,35 @@ setEval _ _ = throw "illegal call of eval"
-- EVAL
eval :: RefEnv -> MalExpr -> Eval 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
_ -> evalCallFn env ast
eval env ast = evalAst env ast
evalAst :: RefEnv -> MalExpr -> Eval MalExpr
evalAst env (MalSymbol s) = do
eval env ast = do
dbgeval <- liftEffect (Env.get env "DEBUG-EVAL")
liftEffect 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 <- liftEffect $ 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
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 -> Eval MalExpr
evalDef env (MalSymbol v : e : Nil) = do
evd <- evalAst env e
evd <- eval env e
liftEffect $ Env.set env v evd
pure evd
evalDef _ _ = throw "invalid def!"
@ -132,11 +135,11 @@ evalLet :: RefEnv -> List MalExpr -> Eval MalExpr
evalLet env (MalList _ ps : e : Nil) = do
letEnv <- liftEffect $ Env.newEnv env
letBind letEnv ps
evalAst letEnv e
eval letEnv e
evalLet env (MalVector _ ps : e : Nil) = do
letEnv <- liftEffect $ Env.newEnv env
letBind letEnv ps
evalAst letEnv e
eval letEnv e
evalLet _ _ = throw "invalid let*"
@ -144,7 +147,7 @@ evalLet _ _ = throw "invalid let*"
letBind :: RefEnv -> List MalExpr -> Eval Unit
letBind _ Nil = pure unit
letBind env (MalSymbol ky : e : es) = do
ex <- evalAst env e
ex <- eval env e
liftEffect $ Env.set env ky ex
letBind env es
letBind _ _ = throw "invalid let*"
@ -152,14 +155,14 @@ letBind _ _ = throw "invalid let*"
evalIf :: RefEnv -> List MalExpr -> Eval 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
@ -167,7 +170,7 @@ evalIf _ _ = throw "invalid if"
evalDo :: RefEnv -> List MalExpr -> Eval MalExpr
evalDo env es = foldM (const $ evalAst env) MalNil es
evalDo env es = foldM (const $ eval env) MalNil es
evalFnMatch :: RefEnv -> List MalExpr -> Eval MalExpr
@ -193,7 +196,7 @@ evalFn env params body = do
fnEnv <- Env.newEnv env
ok <- Env.sets fnEnv params' args
if ok
then runEval $ evalAst fnEnv body'
then runEval $ eval fnEnv body'
else throw "actual parameters do not match signature "
unwrapSymbol :: MalExpr -> Eval String
@ -206,13 +209,13 @@ evalFn env params body = do
evalCallFn :: RefEnv -> List MalExpr -> Eval MalExpr
evalCallFn env ast = do
es <- traverse (evalAst env) ast
es <- traverse (eval env) ast
case es of
MalFunction {fn:f, ast:MalNil} : args -> liftEffect $ f args
MalFunction {ast:ast', params:params', env:env'} : args -> do
newEnv <- liftEffect $ Env.newEnv env'
_ <- liftEffect $ Env.sets newEnv params' args
evalAst newEnv ast'
eval newEnv ast'
_ -> throw "invalid function"

75
impls/purs/src/step7_quote.purs
View File

@ -56,7 +56,7 @@ rep_ env str = rep env str *> pure unit
rep :: RefEnv -> String -> Effect String
rep env str = do
ast <- read str
result <- runEval $ evalAst env ast
result <- runEval $ eval env ast
print result
@ -96,30 +96,32 @@ setEval _ _ = throw "illegal call of eval"
-- EVAL
eval :: RefEnv -> MalExpr -> Eval 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
MalSymbol "quote" : es -> evalQuote env es
MalSymbol "quasiquote" : es -> evalQuasiquote env es
MalSymbol "quasiquoteexpand" : es -> evalQuasiquoteexpand es
_ -> evalCallFn env ast
eval env ast = evalAst env ast
evalAst :: RefEnv -> MalExpr -> Eval MalExpr
evalAst env (MalSymbol s) = do
eval env ast = do
dbgeval <- liftEffect (Env.get env "DEBUG-EVAL")
liftEffect 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 <- liftEffect $ 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
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 _ (MalSymbol "quote" : es) -> evalQuote env es
MalList _ (MalSymbol "quasiquote" : es) -> evalQuasiquote env es
MalList _ es@(_ : _) -> evalCallFn env es
MalVector _ es -> toVector <$> traverse (eval env) es
MalHashMap _ es -> toHashMap <$> traverse (eval env) es
_ -> pure ast
@ -127,7 +129,7 @@ evalAst _ ast = pure ast
evalDef :: RefEnv -> List MalExpr -> Eval MalExpr
evalDef env (MalSymbol v : e : Nil) = do
evd <- evalAst env e
evd <- eval env e
liftEffect $ Env.set env v evd
pure evd
evalDef _ _ = throw "invalid def!"
@ -140,18 +142,18 @@ evalLet :: RefEnv -> List MalExpr -> Eval MalExpr
evalLet env (MalList _ ps : e : Nil) = do
letEnv <- liftEffect $ Env.newEnv env
letBind letEnv ps
evalAst letEnv e
eval letEnv e
evalLet env (MalVector _ ps : e : Nil) = do
letEnv <- liftEffect $ Env.newEnv env
letBind letEnv ps
evalAst letEnv e
eval letEnv e
evalLet _ _ = throw "invalid let*"
letBind :: RefEnv -> List MalExpr -> Eval Unit
letBind _ Nil = pure unit
letBind env (MalSymbol ky : e : es) = do
ex <- evalAst env e
ex <- eval env e
liftEffect $ Env.set env ky ex
letBind env es
letBind _ _ = throw "invalid let*"
@ -162,14 +164,14 @@ letBind _ _ = throw "invalid let*"
evalIf :: RefEnv -> List MalExpr -> Eval 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
@ -180,7 +182,7 @@ evalIf _ _ = throw "invalid if"
-- Do
evalDo :: RefEnv -> List MalExpr -> Eval MalExpr
evalDo env es = foldM (const $ evalAst env) MalNil es
evalDo env es = foldM (const $ eval env) MalNil es
@ -209,7 +211,7 @@ evalFn env params body = do
fnEnv <- Env.newEnv env
ok <- Env.sets fnEnv params' args
if ok
then runEval $ evalAst fnEnv body'
then runEval $ eval fnEnv body'
else throw "actual parameters do not match signature "
unwrapSymbol :: MalExpr -> Eval String
@ -226,15 +228,10 @@ evalQuote _ _ = throw "invalid quote"
evalQuasiquote :: RefEnv -> List MalExpr -> Eval MalExpr
evalQuasiquote env (e:Nil) = evalAst env =<< quasiquote e
evalQuasiquote env (e:Nil) = eval env =<< quasiquote e
evalQuasiquote _ _ = throw "invalid quasiquote"
evalQuasiquoteexpand :: List MalExpr -> Eval MalExpr
evalQuasiquoteexpand (e:Nil) = quasiquote e
evalQuasiquoteexpand _ = throw "invalid quasiquote"
quasiquote :: MalExpr -> Eval MalExpr
quasiquote (MalList _ (MalSymbol "unquote" : x : Nil)) = pure x
quasiquote (MalList _ (MalSymbol "unquote" : _)) = throw "invalid unquote"
@ -260,13 +257,13 @@ qqIter elt acc = do
evalCallFn :: RefEnv -> List MalExpr -> Eval MalExpr
evalCallFn env ast = do
es <- traverse (evalAst env) ast
es <- traverse (eval env) ast
case es of
MalFunction {fn:f, ast:MalNil} : args -> liftEffect $ f args
MalFunction {ast:ast', params:params', env:env'} : args -> do
newEnv <- liftEffect $ Env.newEnv env'
_ <- liftEffect $ Env.sets newEnv params' args
evalAst newEnv ast'
eval newEnv ast'
_ -> throw "invalid function"

114
impls/purs/src/step8_macros.purs
View File

@ -57,7 +57,7 @@ rep_ env str = rep env str *> pure unit
rep :: RefEnv -> String -> Effect String
rep env str = do
ast <- read str
result <- runEval $ evalAst env ast
result <- runEval $ eval env ast
print result
@ -97,37 +97,33 @@ setEval _ _ = throw "illegal call of eval"
-- EVAL
eval :: RefEnv -> MalExpr -> Eval 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
MalSymbol "quote" : es -> evalQuote env es
MalSymbol "quasiquote" : es -> evalQuasiquote env es
MalSymbol "quasiquoteexpand" : es -> evalQuasiquoteexpand es
MalSymbol "defmacro!" : es -> evalDefmacro env es
MalSymbol "macroexpand" : es -> evalMacroexpand env es
_ -> evalCallFn env ast
eval env ast = evalAst env ast
evalAst :: RefEnv -> MalExpr -> Eval MalExpr
evalAst env ast = do
newAst <- macroexpand env ast
case newAst of
eval env ast = do
dbgeval <- liftEffect (Env.get env "DEBUG-EVAL")
liftEffect 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 <- liftEffect $ Env.get env s
case result of
Just k -> pure k
Nothing -> throw $ "'" <> s <> "'" <> " not found"
l@(MalList _ _ ) -> eval env l
MalVector _ es -> toVector <$> traverse (evalAst env) es
MalHashMap _ es -> toHashMap <$> traverse (evalAst env) es
_ -> pure newAst
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 _ (MalSymbol "quote" : es) -> evalQuote env es
MalList _ (MalSymbol "quasiquote" : es) -> evalQuasiquote env es
MalList _ (MalSymbol "defmacro!" : es) -> evalDefmacro env es
MalList _ (rawFunc : rawArgs) -> evalCallFn env rawFunc rawArgs
MalVector _ es -> toVector <$> traverse (eval env) es
MalHashMap _ es -> toHashMap <$> traverse (eval env) es
_ -> pure ast
@ -135,7 +131,7 @@ evalAst env ast = do
evalDef :: RefEnv -> List MalExpr -> Eval MalExpr
evalDef env (MalSymbol v : e : Nil) = do
evd <- evalAst env e
evd <- eval env e
liftEffect $ Env.set env v evd
pure evd
evalDef _ _ = throw "invalid def!"
@ -148,18 +144,18 @@ evalLet :: RefEnv -> List MalExpr -> Eval MalExpr
evalLet env (MalList _ ps : e : Nil) = do
letEnv <- liftEffect $ Env.newEnv env
letBind letEnv ps
evalAst letEnv e
eval letEnv e
evalLet env (MalVector _ ps : e : Nil) = do
letEnv <- liftEffect $ Env.newEnv env
letBind letEnv ps
evalAst letEnv e
eval letEnv e
evalLet _ _ = throw "invalid let*"
letBind :: RefEnv -> List MalExpr -> Eval Unit
letBind _ Nil = pure unit
letBind env (MalSymbol ky : e : es) = do
ex <- evalAst env e
ex <- eval env e
liftEffect $ Env.set env ky ex
letBind env es
letBind _ _ = throw "invalid let*"
@ -170,14 +166,14 @@ letBind _ _ = throw "invalid let*"
evalIf :: RefEnv -> List MalExpr -> Eval 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
@ -188,7 +184,7 @@ evalIf _ _ = throw "invalid if"
-- DO
evalDo :: RefEnv -> List MalExpr -> Eval MalExpr
evalDo env es = foldM (const $ evalAst env) MalNil es
evalDo env es = foldM (const $ eval env) MalNil es
@ -217,7 +213,7 @@ evalFn env params body = do
fnEnv <- Env.newEnv env
ok <- Env.sets fnEnv params' args
if ok
then runEval $ evalAst fnEnv body'
then runEval $ eval fnEnv body'
else throw "actual parameters do not match signature "
unwrapSymbol :: MalExpr -> Eval String
@ -234,15 +230,10 @@ evalQuote _ _ = throw "invalid quote"
evalQuasiquote :: RefEnv -> List MalExpr -> Eval MalExpr
evalQuasiquote env (e:Nil) = evalAst env =<< quasiquote e
evalQuasiquote env (e:Nil) = eval env =<< quasiquote e
evalQuasiquote _ _ = throw "invalid quasiquote"
evalQuasiquoteexpand :: List MalExpr -> Eval MalExpr
evalQuasiquoteexpand (e:Nil) = quasiquote e
evalQuasiquoteexpand _ = throw "invalid quasiquote"
quasiquote :: MalExpr -> Eval MalExpr
quasiquote (MalList _ (MalSymbol "unquote" : x : Nil)) = pure x
quasiquote (MalList _ (MalSymbol "unquote" : _)) = throw "invalid unquote"
@ -268,7 +259,7 @@ qqIter elt acc = do
evalDefmacro :: RefEnv -> List MalExpr -> Eval MalExpr
evalDefmacro env (MalSymbol a : b : Nil) = do
f <- evalAst env b
f <- eval env b
case f of
MalFunction fn@{macro:false} -> do
let m = MalFunction $ fn {macro = true}
@ -278,32 +269,23 @@ evalDefmacro env (MalSymbol a : b : Nil) = do
evalDefmacro _ _ = throw "invalid defmacro!"
evalMacroexpand :: RefEnv -> List MalExpr -> Eval MalExpr
evalMacroexpand env (a:Nil) = macroexpand env a
evalMacroexpand _ _ = throw "invalid macroexpand"
macroexpand :: RefEnv -> MalExpr -> Eval MalExpr
macroexpand env ast@(MalList _ (MalSymbol a : args)) = do
maybeMacro <- liftEffect $ Env.get env a
case maybeMacro of
Just (MalFunction {fn:f, macro:true}) -> macroexpand env =<< (liftEffect $ f args)
_ -> pure ast
macroexpand _ ast = pure ast
-- CALL FUNCTION
evalCallFn :: RefEnv -> List MalExpr -> Eval MalExpr
evalCallFn env ast = do
es <- traverse (evalAst env) ast
case es of
MalFunction {fn:f, ast:MalNil} : args -> liftEffect $ f args
MalFunction {ast:ast', params:params', env:env'} : args -> do
evalCallFn :: RefEnv -> MalExpr -> List MalExpr -> Eval MalExpr
evalCallFn env rawFunc rawArgs = do
func <- eval env rawFunc
case func of
MalFunction {fn:f, macro:true} -> do
newAst <- liftEffect $ f rawArgs
eval env newAst
MalFunction {fn:f, ast:MalNil} -> do
args <- traverse (eval env) rawArgs
liftEffect $ f args
MalFunction {ast:ast', params:params', env:env'} -> do
args <- traverse (eval env) rawArgs
newEnv <- liftEffect $ Env.newEnv env'
_ <- liftEffect $ Env.sets newEnv params' args
evalAst newEnv ast'
eval newEnv ast'
_ -> throw "invalid function"

123
impls/purs/src/step9_try.purs
View File

@ -59,7 +59,7 @@ rep_ env str = rep env str *> pure unit
rep :: RefEnv -> String -> Effect String
rep env str = do
ast <- read str
result <- runEval $ evalAst env ast
result <- runEval $ eval env ast
print result
@ -99,39 +99,34 @@ setEval _ _ = throw "illegal call of eval"
-- EVAL
eval :: RefEnv -> MalExpr -> Eval 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
MalSymbol "quote" : es -> evalQuote env es
MalSymbol "quasiquote" : es -> evalQuasiquote env es
MalSymbol "quasiquoteexpand" : es -> evalQuasiquoteexpand es
MalSymbol "defmacro!" : es -> evalDefmacro env es
MalSymbol "macroexpand" : es -> evalMacroexpand env es
MalSymbol "try*" : es -> liftEffect $ evalTry env es
_ -> evalCallFn env ast
eval env ast = evalAst env ast
evalAst :: RefEnv -> MalExpr -> Eval MalExpr
evalAst env ast = do
newAst <- macroexpand env ast
case newAst of
eval env ast = do
dbgeval <- liftEffect (Env.get env "DEBUG-EVAL")
liftEffect 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 <- liftEffect $ Env.get env s
case result of
Just k -> pure k
Nothing -> throw $ "'" <> s <> "'" <> " not found"
l@(MalList _ _ ) -> eval env l
MalVector _ es -> toVector <$> traverse (evalAst env) es
MalHashMap _ es -> toHashMap <$> traverse (evalAst env) es
_ -> pure newAst
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 _ (MalSymbol "quote" : es) -> evalQuote env es
MalList _ (MalSymbol "quasiquote" : es) -> evalQuasiquote env es
MalList _ (MalSymbol "defmacro!" : es) -> evalDefmacro env es
MalList _ (MalSymbol "try*" : es) -> liftEffect $ evalTry env es
MalList _ (rawFunc : rawArgs) -> evalCallFn env rawFunc rawArgs
MalVector _ es -> toVector <$> traverse (eval env) es
MalHashMap _ es -> toHashMap <$> traverse (eval env) es
_ -> pure ast
@ -139,7 +134,7 @@ evalAst env ast = do
evalDef :: RefEnv -> List MalExpr -> Eval MalExpr
evalDef env (MalSymbol v : e : Nil) = do
evd <- evalAst env e
evd <- eval env e
liftEffect $ Env.set env v evd
pure evd
evalDef _ _ = throw "invalid def!"
@ -152,18 +147,18 @@ evalLet :: RefEnv -> List MalExpr -> Eval MalExpr
evalLet env (MalList _ ps : e : Nil) = do
letEnv <- liftEffect $ Env.newEnv env
letBind letEnv ps
evalAst letEnv e
eval letEnv e
evalLet env (MalVector _ ps : e : Nil) = do
letEnv <- liftEffect $ Env.newEnv env
letBind letEnv ps
evalAst letEnv e
eval letEnv e
evalLet _ _ = throw "invalid let*"
letBind :: RefEnv -> List MalExpr -> Eval Unit
letBind _ Nil = pure unit
letBind env (MalSymbol ky : e : es) = do
ex <- evalAst env e
ex <- eval env e
liftEffect $ Env.set env ky ex
letBind env es
letBind _ _ = throw "invalid let*"
@ -174,14 +169,14 @@ letBind _ _ = throw "invalid let*"
evalIf :: RefEnv -> List MalExpr -> Eval 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
@ -192,7 +187,7 @@ evalIf _ _ = throw "invalid if"
-- Do
evalDo :: RefEnv -> List MalExpr -> Eval MalExpr
evalDo env es = foldM (const $ evalAst env) MalNil es
evalDo env es = foldM (const $ eval env) MalNil es
@ -221,7 +216,7 @@ evalFn env params body = do
fnEnv <- Env.newEnv env
ok <- Env.sets fnEnv params' args
if ok
then runEval $ evalAst fnEnv body'
then runEval $ eval fnEnv body'
else throw "actual parameters do not match signature "
unwrapSymbol :: MalExpr -> Eval String
@ -238,15 +233,10 @@ evalQuote _ _ = throw "invalid quote"
evalQuasiquote :: RefEnv -> List MalExpr -> Eval MalExpr
evalQuasiquote env (e:Nil) = evalAst env =<< quasiquote e
evalQuasiquote env (e:Nil) = eval env =<< quasiquote e
evalQuasiquote _ _ = throw "invalid quasiquote"
evalQuasiquoteexpand :: List MalExpr -> Eval MalExpr
evalQuasiquoteexpand (e:Nil) = quasiquote e
evalQuasiquoteexpand _ = throw "invalid quasiquote"
quasiquote :: MalExpr -> Eval MalExpr
quasiquote (MalList _ (MalSymbol "unquote" : x : Nil)) = pure x
quasiquote (MalList _ (MalSymbol "unquote" : _)) = throw "invalid unquote"
@ -272,7 +262,7 @@ qqIter elt acc = do
evalDefmacro :: RefEnv -> List MalExpr -> Eval MalExpr
evalDefmacro env (MalSymbol a : b : Nil) = do
f <- evalAst env b
f <- eval env b
case f of
MalFunction fn@{macro:false} -> do
let m = MalFunction $ fn {macro = true}
@ -282,32 +272,17 @@ evalDefmacro env (MalSymbol a : b : Nil) = do
evalDefmacro _ _ = throw "invalid defmacro!"
evalMacroexpand :: RefEnv -> List MalExpr -> Eval MalExpr
evalMacroexpand env (a:Nil) = macroexpand env a
evalMacroexpand _ _ = throw "invalid macroexpand"
macroexpand :: RefEnv -> MalExpr -> Eval MalExpr
macroexpand env ast@(MalList _ (MalSymbol a : args)) = do
maybeMacro <- liftEffect $ Env.get env a
case maybeMacro of
Just (MalFunction {fn:f, macro:true}) -> macroexpand env =<< (liftEffect $ f args)
_ -> pure ast
macroexpand _ ast = pure ast
-- Try
evalTry :: RefEnv -> List MalExpr -> Effect MalExpr
evalTry env (a:Nil) = runEval $ evalAst env a
evalTry env (a:Nil) = runEval $ eval env a
evalTry env (thw : MalList _ (MalSymbol "catch*" : MalSymbol e : b : Nil) : Nil) = do
res <- try $ runEval $ evalAst env thw
res <- try $ runEval $ eval env thw
case res of
Left err -> do
tryEnv <- Env.newEnv env
Env.set tryEnv e $ MalString $ Ex.message err -- FIXME:
runEval $ evalAst tryEnv b
runEval $ eval tryEnv b
Right v -> pure v
evalTry _ _ = Ex.throw "invalid try*"
@ -315,15 +290,21 @@ evalTry _ _ = Ex.throw "invalid try*"
-- CALL FUNCTION
evalCallFn :: RefEnv -> List MalExpr -> Eval MalExpr
evalCallFn env ast = do
es <- traverse (evalAst env) ast
case es of
MalFunction {fn:f, ast:MalNil} : args -> liftEffect $ f args
MalFunction {ast:ast', params:params', env:env'} : args -> do
evalCallFn :: RefEnv -> MalExpr -> List MalExpr -> Eval MalExpr
evalCallFn env rawFunc rawArgs = do
func <- eval env rawFunc
case func of
MalFunction {fn:f, macro:true} -> do
newAst <- liftEffect $ f rawArgs
eval env newAst
MalFunction {fn:f, ast:MalNil} -> do
args <- traverse (eval env) rawArgs
liftEffect $ f args
MalFunction {ast:ast', params:params', env:env'} -> do
args <- traverse (eval env) rawArgs
newEnv <- liftEffect $ Env.newEnv env'
_ <- liftEffect $ Env.sets newEnv params' args
evalAst newEnv ast'
eval newEnv ast'
_ -> throw "invalid function"

123
impls/purs/src/stepA_mal.purs
View File

@ -62,7 +62,7 @@ rep_ env str = rep env str *> pure unit
rep :: RefEnv -> String -> Effect String
rep env str = do
ast <- read str
result <- runEval $ evalAst env ast
result <- runEval $ eval env ast
print result
@ -102,39 +102,34 @@ setEval _ _ = throw "illegal call of eval"
-- EVAL
eval :: RefEnv -> MalExpr -> Eval 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
MalSymbol "quote" : es -> evalQuote env es
MalSymbol "quasiquote" : es -> evalQuasiquote env es
MalSymbol "quasiquoteexpand" : es -> evalQuasiquoteexpand es
MalSymbol "defmacro!" : es -> evalDefmacro env es
MalSymbol "macroexpand" : es -> evalMacroexpand env es
MalSymbol "try*" : es -> liftEffect $ evalTry env es
_ -> evalCallFn env ast
eval env ast = evalAst env ast
evalAst :: RefEnv -> MalExpr -> Eval MalExpr
evalAst env ast = do
newAst <- macroexpand env ast
case newAst of
eval env ast = do
dbgeval <- liftEffect (Env.get env "DEBUG-EVAL")
liftEffect 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 <- liftEffect $ Env.get env s
case result of
Just k -> pure k
Nothing -> throw $ "'" <> s <> "'" <> " not found"
l@(MalList _ _ ) -> eval env l
MalVector _ es -> toVector <$> traverse (evalAst env) es
MalHashMap _ es -> toHashMap <$> traverse (evalAst env) es
_ -> pure newAst
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 _ (MalSymbol "quote" : es) -> evalQuote env es
MalList _ (MalSymbol "quasiquote" : es) -> evalQuasiquote env es
MalList _ (MalSymbol "defmacro!" : es) -> evalDefmacro env es
MalList _ (MalSymbol "try*" : es) -> liftEffect $ evalTry env es
MalList _ (rawFunc : rawArgs) -> evalCallFn env rawFunc rawArgs
MalVector _ es -> toVector <$> traverse (eval env) es
MalHashMap _ es -> toHashMap <$> traverse (eval env) es
_ -> pure ast
@ -142,7 +137,7 @@ evalAst env ast = do
evalDef :: RefEnv -> List MalExpr -> Eval MalExpr
evalDef env (MalSymbol v : e : Nil) = do
evd <- evalAst env e
evd <- eval env e
liftEffect $ Env.set env v evd
pure evd
evalDef _ _ = throw "invalid def!"
@ -155,18 +150,18 @@ evalLet :: RefEnv -> List MalExpr -> Eval MalExpr
evalLet env (MalList _ ps : e : Nil) = do
letEnv <- liftEffect $ Env.newEnv env
letBind letEnv ps
evalAst letEnv e
eval letEnv e
evalLet env (MalVector _ ps : e : Nil) = do
letEnv <- liftEffect $ Env.newEnv env
letBind letEnv ps
evalAst letEnv e
eval letEnv e
evalLet _ _ = throw "invalid let*"
letBind :: RefEnv -> List MalExpr -> Eval Unit
letBind _ Nil = pure unit
letBind env (MalSymbol ky : e : es) = do
ex <- evalAst env e
ex <- eval env e
liftEffect $ Env.set env ky ex
letBind env es
letBind _ _ = throw "invalid let*"
@ -177,14 +172,14 @@ letBind _ _ = throw "invalid let*"
evalIf :: RefEnv -> List MalExpr -> Eval 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
@ -195,7 +190,7 @@ evalIf _ _ = throw "invalid if"
-- Do
evalDo :: RefEnv -> List MalExpr -> Eval MalExpr
evalDo env es = foldM (const $ evalAst env) MalNil es
evalDo env es = foldM (const $ eval env) MalNil es
@ -224,7 +219,7 @@ evalFn env params body = do
fnEnv <- Env.newEnv env
ok <- Env.sets fnEnv params' args
if ok
then runEval $ evalAst fnEnv body'
then runEval $ eval fnEnv body'
else throw "actual parameters do not match signature "
unwrapSymbol :: MalExpr -> Eval String
@ -241,15 +236,10 @@ evalQuote _ _ = throw "invalid quote"
evalQuasiquote :: RefEnv -> List MalExpr -> Eval MalExpr
evalQuasiquote env (e:Nil) = evalAst env =<< quasiquote e
evalQuasiquote env (e:Nil) = eval env =<< quasiquote e
evalQuasiquote _ _ = throw "invalid quasiquote"
evalQuasiquoteexpand :: List MalExpr -> Eval MalExpr
evalQuasiquoteexpand (e:Nil) = quasiquote e
evalQuasiquoteexpand _ = throw "invalid quasiquote"
quasiquote :: MalExpr -> Eval MalExpr
quasiquote (MalList _ (MalSymbol "unquote" : x : Nil)) = pure x
quasiquote (MalList _ (MalSymbol "unquote" : _)) = throw "invalid unquote"
@ -275,7 +265,7 @@ qqIter elt acc = do
evalDefmacro :: RefEnv -> List MalExpr -> Eval MalExpr
evalDefmacro env (MalSymbol a : b : Nil) = do
f <- evalAst env b
f <- eval env b
case f of
MalFunction fn@{macro:false} -> do
let m = MalFunction $ fn {macro = true}
@ -285,32 +275,17 @@ evalDefmacro env (MalSymbol a : b : Nil) = do
evalDefmacro _ _ = throw "invalid defmacro!"
evalMacroexpand :: RefEnv -> List MalExpr -> Eval MalExpr
evalMacroexpand env (a:Nil) = macroexpand env a
evalMacroexpand _ _ = throw "invalid macroexpand"
macroexpand :: RefEnv -> MalExpr -> Eval MalExpr
macroexpand env ast@(MalList _ (MalSymbol a : args)) = do
maybeMacro <- liftEffect $ Env.get env a
case maybeMacro of
Just (MalFunction {fn:f, macro:true}) -> macroexpand env =<< (liftEffect $ f args)
_ -> pure ast
macroexpand _ ast = pure ast
-- Try
evalTry :: RefEnv -> List MalExpr -> Effect MalExpr
evalTry env (a:Nil) = runEval $ evalAst env a
evalTry env (a:Nil) = runEval $ eval env a
evalTry env (thw : MalList _ (MalSymbol "catch*" : MalSymbol e : b : Nil) : Nil) = do
res <- try $ runEval $ evalAst env thw
res <- try $ runEval $ eval env thw
case res of
Left err -> do
tryEnv <- Env.newEnv env
Env.set tryEnv e $ MalString $ Ex.message err -- FIXME:
runEval $ evalAst tryEnv b
runEval $ eval tryEnv b
Right v -> pure v
evalTry _ _ = Ex.throw "invalid try*"
@ -318,15 +293,21 @@ evalTry _ _ = Ex.throw "invalid try*"
-- CALL FUNCTION
evalCallFn :: RefEnv -> List MalExpr -> Eval MalExpr
evalCallFn env ast = do
es <- traverse (evalAst env) ast
case es of
MalFunction {fn:f, ast:MalNil} : args -> liftEffect $ f args
MalFunction {ast:ast', params:params', env:env'} : args -> do
evalCallFn :: RefEnv -> MalExpr -> List MalExpr -> Eval MalExpr
evalCallFn env rawFunc rawArgs = do
func <- eval env rawFunc
case func of
MalFunction {fn:f, macro:true} -> do
newAst <- liftEffect $ f rawArgs
eval env newAst
MalFunction {fn:f, ast:MalNil} -> do
args <- traverse (eval env) rawArgs
liftEffect $ f args
MalFunction {ast:ast', params:params', env:env'} -> do
args <- traverse (eval env) rawArgs
newEnv <- liftEffect $ Env.newEnv env'
_ <- liftEffect $ Env.sets newEnv params' args
evalAst newEnv ast'
eval newEnv ast'
_ -> throw "invalid function"