0.1.0 base collection of features

Implemented evaluation of tree calculus terms alongside referentially
transparent variable identifiers. Implemented evaluation of defined
functions into tree calculus.

src/Eval.hs

@@ -3,8 +3,62 @@ module Eval where
 import Parser
 import Research
 
-evalSapling :: SaplingAST -> T
-evalSapling TLeaf = Leaf
-evalSapling (TStem t) = Stem (evalSapling t)
-evalSapling (TFork t1 t2) = Fork (evalSapling t1) (evalSapling t2)
-evalSapling _ = error "Evaluation currently only supported for Tree Calculus terms."
+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) =
+    let result = Stem (evalTreeCalculus env t)
+    in Map.insert "__result" result env
+evalSapling env (TFork t1 t2) =
+    let result = Fork (evalTreeCalculus env t1) (evalTreeCalculus env t2)
+    in Map.insert "__result" result env
+evalSapling env (SFunc name [] body) =
+    let value = evalTreeCalculus env body
+    in Map.insert name value env
+evalSapling 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
+
+evalMulti :: Map String T -> [SaplingAST] -> Map String T
+evalMulti env [] = env
+evalMulti env [lastLine] =
+    let updatedEnv = evalSapling env lastLine
+    in Map.insert "__result" (result updatedEnv) updatedEnv
+evalMulti env (line:rest) =
+    let updatedEnv = evalSapling env line
+    in evalMulti updatedEnv rest
+
+evalTreeCalculus :: Map.Map String T -> SaplingAST -> T
+evalTreeCalculus _ TLeaf = Leaf
+evalTreeCalculus env (TStem t) = Stem (evalTreeCalculus env t)
+evalTreeCalculus env (TFork t1 t2) = Fork (evalTreeCalculus env t1) (evalTreeCalculus env t2)
+evalTreeCalculus env (SApp base []) = evalTreeCalculus env base
+evalTreeCalculus env (SApp base args) =
+    let func = evalTreeCalculus env base
+        argVals = map (evalTreeCalculus env) args
+    in foldl apply func argVals
+evalTreeCalculus env (SVar name) =
+    case Map.lookup name env of
+      Just value -> value 
+      Nothing -> error $ "Variable " ++ name ++ " not defined"
+evalTreeCalculus _ (SStr str) = toString str
+evalTreeCalculus _ (SInt num) = toNumber num
+evalTreeCalculus _ (SList elems) = toList (map (evalTreeCalculus Map.empty) elems)
+evalTreeCalculus _ (SFunc name args body) =
+    error $ "Unexpected function definition " ++ name ++ " in \ 
+           \ evalTreeCalculus; functions should be evaluated to Tree Calculus \
+           \ terms by evalSapling."
+
+result :: Map String T -> T
+result r = case (Map.lookup "__result" r) of
+  Just a  -> a
+  Nothing -> error "No __result field found in provided environment"
+
+toAST :: T -> SaplingAST
+toAST Leaf       = TLeaf
+toAST (Stem a)   = TStem (toAST a)
+toAST (Fork a b) = TFork (toAST a) (toAST b)