0.2.0
Includes better error handling, additional tests, parsing and lexing fixes to match the desired behavior defined by the new tests, and a very basic REPL implementation.
This commit is contained in:
30
src/Eval.hs
30
src/Eval.hs
@ -6,31 +6,31 @@ import Research
|
||||
import qualified Data.Map as Map
|
||||
import Data.Map (Map)
|
||||
|
||||
evalSapling :: Map String T -> SaplingAST -> Map String T
|
||||
evalSapling env TLeaf = Map.insert "__result" Leaf env
|
||||
evalSapling env (TStem t) =
|
||||
evalSingle :: Map String T -> SaplingAST -> Map String T
|
||||
evalSingle env TLeaf = Map.insert "__result" Leaf env
|
||||
evalSingle env (TStem t) =
|
||||
let result = Stem (evalTreeCalculus env t)
|
||||
in Map.insert "__result" result env
|
||||
evalSapling env (TFork t1 t2) =
|
||||
evalSingle env (TFork t1 t2) =
|
||||
let result = Fork (evalTreeCalculus env t1) (evalTreeCalculus env t2)
|
||||
in Map.insert "__result" result env
|
||||
evalSapling env (SFunc name [] body) =
|
||||
evalSingle env (SFunc name [] body) =
|
||||
let value = evalTreeCalculus env body
|
||||
in Map.insert name value env
|
||||
evalSapling env (SVar name) =
|
||||
evalSingle env (SVar name) =
|
||||
case Map.lookup name env of
|
||||
Just value -> Map.insert "__result" value env
|
||||
Nothing -> error $ "Variable " ++ name ++ " not defined"
|
||||
evalSapling env ast = Map.insert "__result" (evalTreeCalculus env ast) env
|
||||
evalSingle env ast = Map.insert "__result" (evalTreeCalculus env ast) env
|
||||
|
||||
evalMulti :: Map String T -> [SaplingAST] -> Map String T
|
||||
evalMulti env [] = env
|
||||
evalMulti env [lastLine] =
|
||||
let updatedEnv = evalSapling env lastLine
|
||||
evalSapling :: Map String T -> [SaplingAST] -> Map String T
|
||||
evalSapling env [] = env
|
||||
evalSapling env [lastLine] =
|
||||
let updatedEnv = evalSingle env lastLine
|
||||
in Map.insert "__result" (result updatedEnv) updatedEnv
|
||||
evalMulti env (line:rest) =
|
||||
let updatedEnv = evalSapling env line
|
||||
in evalMulti updatedEnv rest
|
||||
evalSapling env (line:rest) =
|
||||
let updatedEnv = evalSingle env line
|
||||
in evalSapling updatedEnv rest
|
||||
|
||||
evalTreeCalculus :: Map.Map String T -> SaplingAST -> T
|
||||
evalTreeCalculus _ TLeaf = Leaf
|
||||
@ -51,7 +51,7 @@ evalTreeCalculus _ (SList elems) = toList (map (evalTreeCalculus Map.empty) elem
|
||||
evalTreeCalculus _ (SFunc name args body) =
|
||||
error $ "Unexpected function definition " ++ name ++ " in \
|
||||
\ evalTreeCalculus; functions should be evaluated to Tree Calculus \
|
||||
\ terms by evalSapling."
|
||||
\ terms by evalSingle."
|
||||
|
||||
result :: Map String T -> T
|
||||
result r = case (Map.lookup "__result" r) of
|
||||
|
Reference in New Issue
Block a user