* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
-*)
+ *)
(* Execution of Domtool programs reduced to primitive actions *)
^ 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
(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
+ in
+ exec' (conjoin (evs, evs')) e2
+ 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
- ()
+ Env.post ()
end
end