X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/e0b0abd209a1ecbd9266cfcf8735af171f96869b..90dd48df1de3ea116fe2f2c0ec0fe36c71e17e5c:/src/eval.sml

diff --git a/src/eval.sml b/src/eval.sml
index 232a8aa..6cbeca7 100644
--- a/src/eval.sml
+++ b/src/eval.sml
@@ -30,6 +30,11 @@ fun lookup (evs, ev) =
 			    ^ ev ^ " that type-checking has guaranteed")
       | SOME v => v
 
+fun printEvs (name, evs) =
+    (print ("Environment " ^ name ^ "\n");
+     SM.appi (fn (name, i) => Print.preface (name, Print.p_exp i)) evs;
+     print "\n")
+
 val conjoin : Env.env_vars * Env.env_vars -> Env.env_vars =
   SM.unionWith #2
 
@@ -51,58 +56,58 @@ fun findPrimitive e =
 	(name, rev args)
     end
 
-fun exec evs e =
-    let
-	fun exec' 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)
-	      | ESeq es =>
+fun exec' 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)
+      | ESeq es =>
+	let
+	    val (new, _) =
+		foldl (fn (e, (new, keep)) =>
+			  let
+			      val new' = exec' keep e
+			  in
+			      (conjoin (new, new'),
+			       conjoin (keep, new'))
+			  end) (SM.empty, evs) es
+	in
+	    new
+	end
+      | ELocal (e1, e2) =>
+	let
+	    val evs' = exec' evs e1
+	    val evs'' = exec' (conjoin (evs, evs')) e2
+	in
+	    conjoin (evs, evs'')
+	end
+      | EWith (e1, e2) =>
+	let
+	    val (prim, args) = findPrimitive e1
+	in
+	    case Env.container prim of
+		NONE => raise Fail "Unbound primitive container"
+	      | SOME (action, cleanup) =>
 		let
-		    val (new, _) =
-			foldl (fn (e, (new, keep)) =>
-				  let
-				      val new' = exec' keep e
-				  in
-				      (conjoin (new, new'),
-				       conjoin (keep, new'))
-				  end) (SM.empty, evs) es
+		    val evs' = action (evs, args)
+		    val evs'' = exec' evs e2
 		in
-		    new
-		end
-	      | ELocal (e1, e2) =>
-		let
-		    val evs' = exec' evs e1
-		    val evs'' = exec' (conjoin (evs, evs')) e2
-		in
-		    conjoin (evs, evs'')
-		end
-	      | EWith (e1, e2) =>
-		let
-		    val (prim, args) = findPrimitive e1
-		in
-		    case Env.container prim of
-			NONE => raise Fail "Unbound primitive container"
-		      | SOME (action, cleanup) =>
-			let
-			    val evs' = action (evs, args)
-			    val evs'' = exec' evs e2
-			in
-			    cleanup ();
-			    conjoin (conjoin (evs, evs'), evs'')
-			end
+		    cleanup ();
+		    evs'
 		end
+	end
 
-	      | _ =>
-		let
-		    val (prim, args) = findPrimitive eAll
-		in
-		    case Env.action prim of
-			NONE => raise Fail "Unbound primitive action"
-		      | SOME action => action (evs, args)
-		end
+      | _ =>
+	let
+	    val (prim, args) = findPrimitive eAll
+	in
+	    case Env.action prim of
+		NONE => raise Fail "Unbound primitive action"
+	      | SOME action => action (evs, args)
+	end
 
+fun exec evs e =
+    let
 	val _ = Env.pre ()
 	val evs' = exec' evs e
     in