feat: purescript step3

impls/purs/Makefile

@@ -7,3 +7,4 @@ src/step%:
 step0_repl.purs = Mal.Step0
 step1_read_print.purs = Mal.Step1
 step2_eval.purs = Mal.Step2
+step3_env.purs = Mal.Step3

impls/purs/spago.dhall

@@ -28,6 +28,7 @@ to generate this file without the comments in this block.
  , "psci-support"
  , "refs"
  , "strings"
+ , "transformers"
  , "tuples"
  ]
 , packages = ./packages.dhall

impls/purs/src/Env.purs

@@ -0,0 +1,46 @@
+module Env where
+
+import Prelude
+
+import Data.List (List(..), (:))
+import Data.Map (fromFoldable, insert, lookup)
+import Data.Maybe (Maybe(..))
+import Effect (Effect)
+import Effect.Console (error)
+import Effect.Ref as Ref
+import Types (Local, MalExpr, RefEnv, toList)
+
+
+
+-- Environment
+
+initEnv :: Local
+initEnv = fromFoldable Nil
+
+
+newEnv :: RefEnv -> Effect RefEnv
+newEnv re = flip (:) re <$> Ref.new initEnv
+
+
+
+-- VARIABLE
+
+get :: RefEnv -> String -> Effect (Maybe MalExpr)
+get Nil _ = pure Nothing
+get (ref:outer) ky = do
+ envs <- Ref.read ref
+ case lookup ky envs of
+ Nothing -> get outer ky
+ ex -> pure ex
+
+
+sets :: RefEnv -> List String -> List MalExpr -> Effect Boolean
+sets _ Nil Nil = pure true
+sets env ("&":k:Nil) exs = set env k (toList exs) *> pure true
+sets env (ky:kys) (ex:exs) = set env ky ex *> sets env kys exs
+sets _ _ _ = pure false
+
+
+set :: RefEnv -> String -> MalExpr -> Effect Unit
+set (re:_) ky ex = Ref.modify_ (insert ky ex) re
+set Nil _ _ = error "assertion failed in env_set"

impls/purs/src/step3_env.purs

@@ -0,0 +1,135 @@
+module Mal.Step3 where
+
+import Prelude
+
+import Control.Monad.Error.Class (try)
+import Data.Either (Either(..))
+import Data.List (List(..), (:))
+import Data.Maybe (Maybe(..))
+import Data.Traversable (traverse)
+import Effect (Effect)
+import Effect.Console (error, log)
+import Effect.Exception (throw)
+import Env as Env
+import Reader (readStr)
+import Printer (printStr)
+import Readline (readLine)
+import Types (MalExpr(..), MalFn, RefEnv, toHashMap, toVector)
+
+
+
+-- READ
+
+read :: String -> Either String MalExpr
+read = readStr
+
+
+
+-- 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
+ 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
+
+
+evalDef :: RefEnv -> List MalExpr -> Effect MalExpr
+evalDef env (MalSymbol v : e : Nil) = do
+ evd <- evalAst env e
+ Env.set env v evd
+ pure evd
+evalDef _ _ = throw "invalid def!"
+
+
+evalLet :: RefEnv -> List MalExpr -> Effect MalExpr
+evalLet env (MalList _ ps : e : Nil) = do
+ letEnv <- Env.newEnv env
+ letBind letEnv ps
+ evalAst letEnv e
+evalLet env (MalVector _ ps : e : Nil) = do
+ letEnv <- Env.newEnv env
+ letBind letEnv ps
+ evalAst 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
+ letBind env es
+letBind _ _ = throw "invalid let*"
+
+
+
+-- PRINT
+
+print :: MalExpr -> Effect String
+print = printStr
+
+
+
+-- REPL
+
+rep :: RefEnv -> String -> Effect String
+rep env str = case read str of
+ Left _ -> throw "EOF"
+ Right ast -> print =<< eval env ast
+
+
+loop :: RefEnv -> Effect Unit
+loop env = do
+ line <- readLine "user> "
+ case line of
+ ":q" -> pure unit
+ _ -> do
+ result <- try $ rep env line
+ case result of
+ Right exp -> log exp
+ Left err -> error $ show err
+ loop env
+
+
+setArithOp :: RefEnv -> Effect Unit
+setArithOp env = do
+ Env.set env "+" $ fn (+)
+ Env.set env "-" $ fn (-)
+ Env.set env "*" $ fn (*)
+ Env.set env "/" $ fn (/)
+
+
+fn :: (Int -> Int -> Int) -> MalExpr
+fn op = MalFunction $ { fn : g op, params:Nil, macro:false, meta:MalNil }
+ where
+ g :: (Int -> Int -> Int) -> MalFn
+ g op' ((MalInt n1) : (MalInt n2) : Nil) = pure $ MalInt $ op' n1 n2
+ g _ _ = throw "invalid operator"
+
+
+
+--
+
+main :: Effect Unit
+main = do
+ re <- Env.newEnv Nil
+ setArithOp re
+ loop re