X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/b096303256418167cb3d9f05e95ee13ef063dc20..254d5faaae330b43f04ad7f39fb4340457d78776:/src/eval.sml

diff --git a/src/eval.sml b/src/eval.sml
index 1fec487..898a4a2 100644
--- a/src/eval.sml
+++ b/src/eval.sml
@@ -24,10 +24,12 @@ open Ast
 
 structure SM = StringMap
 
-fun lookup (evs, ev) =
+fun lookup ((root, evs), ev) =
     case SM.find (evs, ev) of
-	NONE => raise Fail ("Couldn't find an environment variable "
-			    ^ ev ^ " that type-checking has guaranteed")
+	NONE => (case SM.find (root, ev) of
+		     NONE => raise Fail ("Couldn't find an environment variable "
+					 ^ ev ^ " that type-checking has guaranteed")
+		   | SOME v => v)
       | SOME v => v
 
 fun printEvs (name, evs) =
@@ -56,17 +58,22 @@ fun findPrimitive e =
 	(name, rev args)
     end
 
-fun exec' evs (eAll as (e, _)) =
+fun exec' (evsAll as (root, evs)) (eAll as (e, _)) =
     case e of
 	ESkip => SM.empty
       | ESet (ev, e) => SM.insert (SM.empty, ev, e)
-      | EGet (x, _, ev, e) => exec' evs (Reduce.subst x (lookup (evs, ev)) e)
+      | EGet (x, _, ev, e) =>
+	let
+	    val e' = Reduce.subst x (lookup (evsAll, ev)) e
+	in
+	    exec' evsAll (Reduce.reduceExp Env.empty e')
+	end
       | ESeq es =>
 	let
 	    val (new, _) =
 		foldl (fn (e, (new, keep)) =>
 			  let
-			      val new' = exec' keep e
+			      val new' = exec' (root, keep) e
 			  in
 			      (conjoin (new, new'),
 			       conjoin (keep, new'))
@@ -76,9 +83,9 @@ fun exec' evs (eAll as (e, _)) =
 	end
       | ELocal (e1, e2) =>
 	let
-	    val evs' = exec' evs e1
+	    val evs' = exec' evsAll e1
 	in
-	    exec' (conjoin (evs, evs')) e2
+	    exec' (root, (conjoin (evs, evs'))) e2
 	end
       | EWith (e1, e2) =>
 	let
@@ -88,8 +95,8 @@ fun exec' evs (eAll as (e, _)) =
 		NONE => raise Fail "Unbound primitive container"
 	      | SOME (action, cleanup) =>
 		let
-		    val evs' = action (evs, args)
-		    val evs'' = exec' evs e2
+		    val evs' = action (conjoin (root, evs), args)
+		    val evs'' = exec' evsAll e2
 		in
 		    cleanup ();
 		    evs'
@@ -102,7 +109,7 @@ fun exec' evs (eAll as (e, _)) =
 	in
 	    case Env.action prim of
 		NONE => raise Fail "Unbound primitive action"
-	      | SOME action => action (evs, List.map (Reduce.reduceExp Env.empty) args)
+	      | SOME action => action (conjoin (root, evs), List.map (Reduce.reduceExp Env.empty) args)
 	end
 
 fun exec evs e =
@@ -113,4 +120,6 @@ fun exec evs e =
 	Env.post ()
     end
 
+val exec' = fn evs as (root, evs')  => fn e => conjoin (evs', exec' evs e)
+
 end