mirror of
https://github.com/kanaka/mal.git
synced 2024-09-11 13:55:55 +03:00
PureScript: fix step2 without Env
This commit is contained in:
parent
d00e383dd4
commit
a33b150fad
@ -12,7 +12,6 @@ import Data.Tuple (Tuple(..))
|
|||||||
import Effect (Effect)
|
import Effect (Effect)
|
||||||
import Effect.Console (error, log)
|
import Effect.Console (error, log)
|
||||||
import Effect.Exception (throw, try)
|
import Effect.Exception (throw, try)
|
||||||
import Env as Env
|
|
||||||
import Reader (readStr)
|
import Reader (readStr)
|
||||||
import Printer (printStr)
|
import Printer (printStr)
|
||||||
import Readline (readLine)
|
import Readline (readLine)
|
||||||
@ -28,24 +27,24 @@ main = loop
|
|||||||
|
|
||||||
-- EVAL
|
-- EVAL
|
||||||
|
|
||||||
eval :: ReplEnv -> MalExpr -> Effect MalExpr
|
eval :: MalExpr -> Effect MalExpr
|
||||||
eval _ ast@(MalList _ Nil) = pure ast
|
eval ast@(MalList _ Nil) = pure ast
|
||||||
eval env (MalList _ ast) = do
|
eval (MalList _ ast) = do
|
||||||
es <- traverse (evalAst env) ast
|
es <- traverse evalAst ast
|
||||||
case es of
|
case es of
|
||||||
MalFunction {fn:f}: args -> f args
|
MalFunction {fn:f}: args -> f args
|
||||||
_ -> pure $ toList es
|
_ -> pure $ toList es
|
||||||
eval env ast = evalAst env ast
|
eval ast = evalAst ast
|
||||||
|
|
||||||
|
|
||||||
evalAst :: ReplEnv -> MalExpr -> Effect MalExpr
|
evalAst :: MalExpr -> Effect MalExpr
|
||||||
evalAst env (MalSymbol s) = case lookup s env of
|
evalAst (MalSymbol s) = case lookup s replEnv of
|
||||||
Just f -> pure f
|
Just f -> pure f
|
||||||
Nothing -> throw "invalid function"
|
Nothing -> throw "invalid function"
|
||||||
evalAst env ast@(MalList _ _ ) = eval env ast
|
evalAst ast@(MalList _ _ ) = eval ast
|
||||||
evalAst env (MalVector _ es) = toVector <$> (traverse (eval env) es)
|
evalAst (MalVector _ es) = toVector <$> (traverse eval es)
|
||||||
evalAst env (MalHashMap _ es) = toHashMap <$> (traverse (eval env) es)
|
evalAst (MalHashMap _ es) = toHashMap <$> (traverse eval es)
|
||||||
evalAst _ ast = pure ast
|
evalAst ast = pure ast
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@ -53,34 +52,25 @@ evalAst _ ast = pure ast
|
|||||||
|
|
||||||
type ReplEnv = Map String MalExpr
|
type ReplEnv = Map String MalExpr
|
||||||
|
|
||||||
|
replEnv :: ReplEnv
|
||||||
|
replEnv = Map.fromFoldable
|
||||||
|
[ (Tuple "+" (fn (+)))
|
||||||
|
, (Tuple "-" (fn (-)))
|
||||||
|
, (Tuple "*" (fn (*)))
|
||||||
|
, (Tuple "/" (fn (/)))
|
||||||
|
]
|
||||||
|
|
||||||
replEnv :: Effect ReplEnv
|
fn :: (Int -> Int -> Int) -> MalExpr
|
||||||
replEnv = do
|
fn op =
|
||||||
add <- fn (+)
|
MalFunction
|
||||||
sub <- fn (-)
|
{ fn : g op
|
||||||
mul <- fn (*)
|
, ast : MalNil
|
||||||
div <- fn (/)
|
, env : Nil
|
||||||
pure $ Map.fromFoldable
|
, params : Nil
|
||||||
[ Tuple "+" add
|
, macro : false
|
||||||
, Tuple "-" sub
|
, meta : MalNil
|
||||||
, Tuple "*" mul
|
}
|
||||||
, Tuple "/" div
|
|
||||||
]
|
|
||||||
|
|
||||||
|
|
||||||
fn :: (Int -> Int -> Int) -> Effect MalExpr
|
|
||||||
fn op = do
|
|
||||||
newEnv <- Env.newEnv Nil
|
|
||||||
pure $ MalFunction
|
|
||||||
{ fn : g op
|
|
||||||
, ast : MalNil
|
|
||||||
, env : newEnv
|
|
||||||
, params : Nil
|
|
||||||
, macro : false
|
|
||||||
, meta : MalNil
|
|
||||||
}
|
|
||||||
where
|
where
|
||||||
|
|
||||||
g :: (Int -> Int -> Int) -> MalFn
|
g :: (Int -> Int -> Int) -> MalFn
|
||||||
g op' ((MalInt n1) : (MalInt n2) : Nil) = pure $ MalInt $ op' n1 n2
|
g op' ((MalInt n1) : (MalInt n2) : Nil) = pure $ MalInt $ op' n1 n2
|
||||||
g _ _ = throw "invalid operator"
|
g _ _ = throw "invalid operator"
|
||||||
@ -91,8 +81,7 @@ fn op = do
|
|||||||
|
|
||||||
rep :: String -> Effect Unit
|
rep :: String -> Effect Unit
|
||||||
rep str = do
|
rep str = do
|
||||||
env <- replEnv
|
result <- try $ eval =<< read str
|
||||||
result <- try $ eval env =<< read str
|
|
||||||
case result of
|
case result of
|
||||||
Left err -> error $ show err
|
Left err -> error $ show err
|
||||||
Right exp -> print exp >>= log
|
Right exp -> print exp >>= log
|
||||||
@ -104,9 +93,7 @@ loop = do
|
|||||||
case line of
|
case line of
|
||||||
":q" -> pure unit
|
":q" -> pure unit
|
||||||
":Q" -> pure unit
|
":Q" -> pure unit
|
||||||
_ -> do
|
_ -> rep line *> loop
|
||||||
rep line
|
|
||||||
loop
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user