about summary refs log tree commit diff
path: root/src/Eval.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Eval.hs')
-rw-r--r--src/Eval.hs58
1 files changed, 43 insertions, 15 deletions
diff --git a/src/Eval.hs b/src/Eval.hs
index 9047469..c454843 100644
--- a/src/Eval.hs
+++ b/src/Eval.hs
@@ -1,11 +1,13 @@
+{-# LANGUAGE TupleSections #-}
 module Eval
-  ()
+  (runProgram)
   where
 import Syntax
 import Typecheck ()
 
 import Control.Monad.State.Lazy
 import Control.Monad.Except
+import Control.Monad.Reader
 data Value = VInt Int
             | VRecord  [(Idnt,Value)]
             | VVariant Idnt Value
@@ -17,8 +19,11 @@ type Variables = [(Idnt,Value)]
 type Heap = (Int,[(Int,Value)])
 
 data ProgramState= ProgramState Variables Heap
+  deriving (Show)
+
+type EvalMonad = ReaderT [(Idnt,FuncDecl)] (ExceptT String (State ProgramState))
+--type EvalMonad = ExceptT String (State ProgramState)
 
-type EvalMonad = ExceptT String (State ProgramState)
 
 assertInt :: Value -> EvalMonad Int
 assertInt (VInt i) = return i
@@ -163,10 +168,10 @@ runCom (Save var expr) = do
     Just x -> return x
   put $ ProgramState vars (heapCnt,heap')
   get
-runCom (SMatch e cases) = do
+runCom c@(SMatch e cases) = do
   v <- evalExpr e
   (label,value) <- assertVar v
-  case lookup label (map (\(a,b,c)-> (a,(b,c)) )cases) of
+  case lookup label (map (\(a,b,c)-> (a,(b,c)) ) cases) of
     Just (bind,com) -> do
       st@(ProgramState vars heap) <- get
       put $ ProgramState ((bind,value):vars) heap
@@ -176,15 +181,38 @@ runCom (SMatch e cases) = do
       put $ ProgramState vars' heap
       get
     Nothing -> throwError $ "Unsupported label"++ show label ++ "in case" ++ show c
-runCom (FunctionCall var fname arugments) = undefined --TODO
-
-  
-  
-  
-  
-  
-  
-
-  
-
+runCom (FunctionCall var fname arguments) = do
+   funcs <- ask
+   case lookup fname funcs of
+     Nothing -> throwError "no such function defined"
+     Just (Func _ args locals body ret) ->do
+       (ProgramState vars heap) <- get
+       vargs <- mapM evalExpr arguments -- evaluate arguments
+       --evaluate local variables in new environment
+       put $ ProgramState (zip (map fst args) vargs) heap
+       vlocals <- mapM (\(var,expr) -> (var,) <$> evalExpr expr) locals
+       --evaluate function body and return in newer environment
+       (ProgramState vars' heap') <- get
+       put $ ProgramState (vlocals++vars') heap'
+       runCom body
+       vret <- evalExpr ret
+       --restore old local variables with new heap
+       (ProgramState _ newheap) <- get
+       put (ProgramState vars newheap)
+       get
+       
+       
+       
+       
+       
+       
 
+runProgram :: Program -> (Either String ProgramState,ProgramState)
+runProgram (Program decls locals com) =
+   let dec = map ( \d@(Func n _ _ _ _)-> (n,d) ) decls in
+   runState ( runExceptT ( runReaderT (do
+            env <- mapM (\(var,expr) -> (var,) <$> evalExpr expr) locals
+            put (ProgramState env (0,[]))
+            runCom com
+        ) dec) )(ProgramState [] (0,[]))
+  --runState ( runExceptT  (runReaderT (_) decls)) (ProgramState [] [])