yup

dcsommer · Dec 14, 2011 · 0af9815 · 0af9815
1 parent fb34a66
commit 0af9815
Show file tree

Hide file tree

Showing 5 changed files with 94 additions and 28 deletions.
diff --git a/sample.mgds b/sample.mgds
@@ -20,5 +20,5 @@ odd(n) {
 }
 
 main() {
-  return even(9);
+  return fib(100);
 }
diff --git a/src/Debugger.hs b/src/Debugger.hs
@@ -23,7 +23,8 @@ debugLoop :: Program -> IO ()
 debugLoop program = do
   putStrLn $ "Welcome to the MGDS Historical Debugger. " ++ helpHint
   debugLoop2 program
-
+
+debugLoop2 :: Program -> IO ()
 debugLoop2 program = do
   putStr "> "
   hFlush stdout
@@ -33,7 +34,8 @@ debugLoop2 program = do
     case inputWords of
       (cmd:args) -> case cmd of
         "help"  -> showHelp
-        "run"   -> putStrLn $ show $ run program
+        "run"   -> putStrLn $ show ret
+                    where (ret, map) = run program
         "p"     -> putStrLn $ show program
         _       -> unknown
       _          -> unknown

diff --git a/src/Hindsight.hs b/src/Hindsight.hs
@@ -0,0 +1,9 @@
+module Hindsight where
+
+import MGDS
+
+data CallTree = CallTree Function [Integer] [CallTree]              
+                deriving Show
+
+type CallTrace = [CallTree]
+
diff --git a/src/Interpreter.hs b/src/Interpreter.hs
@@ -5,6 +5,8 @@ module Interpreter(run) where
 
 import MGDS
 import Data.IORef
+import Hindsight
+import Data.Array
 
 -- types
 type Env  = [(String, Integer)]
@@ -17,14 +19,46 @@ getFunc :: FEnv -> String -> Function
 getFunc fenv fname = head $ filter (\f -> (getName f) == fname) fenv
 
 -- run a program
-run :: Program -> Integer
-run (Program fenv) = eval (getBody (last fenv)) [] fenv
+run :: Program -> (Integer, Array Integer [CallTrace])
+run (Program fenv) = (val, undefined)
+    where main = last fenv
+          (val, calls) = evalBody (getBody main) [] fenv
+          tree = CallTree main [] calls
+
+fenvToNode :: FEnv -> CallTree -> [(String, [CallTrace])]
+fenvToNode fenv tree = map (\f -> (getName f, funcToNode tree f)) fenv
+
+funcToNode :: CallTree -> Function -> [CallTrace]
+funcToNode tree@(CallTree nodeFunc _ subs) f =
+    traces ++ (if f == nodeFunc
+               then [[tree]]
+               else [])
+    where traces' = foldl (++) [] (map (\t -> funcToNode t f) subs)
+          traces  = map (\t -> t ++ [tree]) traces'
+
+-- eval a list of statementsn
+evalBody :: [Statement] -> Env -> FEnv -> (Integer, [CallTree])
+evalBody [Return _ exp] env fenv = eval exp env fenv
+evalBody (s:ss)         env fenv = (val, calls ++ calls')
+    where (env', calls) = evalAssignment s env fenv
+          (val, calls') = evalBody ss env' fenv
+
+evalAssignment :: Statement -> Env -> FEnv -> (Env, [CallTree])
+evalAssignment (Assignment _ var exp) env fenv = (modifyEnv env var val, calls)
+    where (val, calls) = eval exp env fenv
+
+modifyEnv :: Env -> String -> Integer -> Env
+modifyEnv [] var val = [(var, val)]
+modifyEnv ((var', val'):bs) var val = if var == var'
+                                      then (var, val):bs                  
+                                      else (var', val'):(modifyEnv bs var val)
+
 
 -- eval an expression
-eval :: Expression -> Env -> FEnv -> Integer
+eval :: Expression -> Env -> FEnv -> (Integer, [CallTree])
 
-eval (Constant _ x) _ _ = x
-eval (Var _ s) env _ = getVar env s    
+eval (Constant _ x) _ _ = (x, [])
+eval (Var _ s) env _ = (getVar env s, [])
 
 eval (Add      _ e1 e2) env fenv = intFunc (+) e1 e2 env fenv
 eval (Subtract _ e1 e2) env fenv = intFunc (-) e1 e2 env fenv
@@ -35,39 +69,57 @@ eval (Equals     _ e1 e2) env fenv = boolFunc (==) e1 e2 env fenv
 eval (LogicalAnd _ e1 e2) env fenv = boolFunc (&&) e1 e2 env fenv
 eval (LogicalOr  _ e1 e2) env fenv = boolFunc (||) e1 e2 env fenv
 
-eval (Greater    _ e1 e2) env fenv = boolToInt $ intFunc (> ) e1 e2 env fenv
-eval (Less       _ e1 e2) env fenv = boolToInt $ intFunc (< ) e1 e2 env fenv
+eval (Greater    _ e1 e2) env fenv = (boolToInt val, calls)
+    where (val, calls) = intFunc (> ) e1 e2 env fenv
+
+eval (Less       _ e1 e2) env fenv = (boolToInt val, calls)
+    where (val, calls) = intFunc (< ) e1 e2 env fenv
 
-eval (Not _ e) env fenv = boolToInt $ (eval e env fenv) == 0
+eval (Not _ e) env fenv = (boolToInt (val == 0), calls)
+    where (val, calls) = eval e env fenv
 
-eval (If _ cond e1 e2) env fenv = if (eval cond env fenv) /= 0
-                                  then (eval e1 env fenv)
-                                  else (eval e2 env fenv)
+eval (If _ cond e1 e2) env fenv = if condVal /= 0
+                                  then (thenVal, condCalls ++ thenCalls)
+                                  else (elseVal, condCalls ++ elseCalls)
+    where (condVal, condCalls) = eval cond env fenv
+          (thenVal, thenCalls) = eval e1 env fenv
+          (elseVal, elseCalls) = eval e2 env fenv
 
 eval (FunctionCall _ fname es) env fenv =
-    let vals = map (\e -> eval e env fenv) es
+    let (vals, calls) = evalExpressions es env fenv
         f = getFunc fenv fname
-        exp = getBody f
-        env' = (zip (getParams f) vals) in
-    eval exp env' fenv
+        body = getBody f
+        env' = zip (getParams f) vals        
+        (ret, calls') = evalBody body env' fenv in
+    (ret, calls ++ [CallTree f vals calls'])
 
 -- helper eval functions
+evalExpressions :: [Expression] -> Env -> FEnv -> ([Integer], [CallTree])
+evalExpressions [] _ _ = ([], [])
+evalExpressions (e:es) env fenv = (val:vals, calls ++ calls')
+    where 
+      (val, calls) = eval e env fenv
+      (vals, calls') = evalExpressions es env fenv
+
 boolToInt :: Bool -> Integer
 boolToInt False = 0
 boolToInt True = 1
 
 intFunc :: (Integer -> Integer -> a) ->
-           Expression -> Expression -> Env -> FEnv -> a
-intFunc op e1 e2 env fenv = op (eval e1 env fenv)
-                               (eval e2 env fenv)
+           Expression -> Expression -> Env -> FEnv -> (a, [CallTree])
+intFunc op e1 e2 env fenv = (op v1 v2, calls1 ++ calls2)
+    where (v1, calls1) = eval e1 env fenv
+          (v2, calls2) = eval e2 env fenv
 
 boolFunc :: (Bool -> Bool -> Bool) ->
-            Expression -> Expression -> Env -> FEnv -> Integer
-boolFunc op e1 e2 env fenv =   
-  if op (v1 /= 0) (v2 /= 0)
-  then 1
-  else 0
-       where v1 = eval e1 env fenv
-             v2 = eval e2 env fenv
+            Expression -> Expression ->
+            Env -> FEnv -> (Integer, [CallTree])
+boolFunc op e1 e2 env fenv =
+  (if op (v1 /= 0) (v2 /= 0)
+   then 1
+   else 0,
+   calls1 ++ calls2)
+       where (v1, calls1) = eval e1 env fenv
+             (v2, calls2) = eval e2 env fenv
 
 
diff --git a/src/MGDS.hs b/src/MGDS.hs
@@ -40,6 +40,9 @@ data Function = Function {
   getParams :: [String],
   getBody :: [Statement]
 } deriving Show
+
+instance Eq Function where
+    x == y = (getName x) == (getName y)
 
 
 -- A program is simply a list of functions, one of which must be named