HCoop
/
hcoop
/
domtool2.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
mailman: fix missing newline
[hcoop/domtool2.git]
/
src
/
eval.sml
diff --git
a/src/eval.sml
b/src/eval.sml
index
8789eac
..
898a4a2
100644
(file)
--- a/
src/eval.sml
+++ b/
src/eval.sml
@@
-24,10
+24,12
@@
open Ast
structure SM = StringMap
structure SM = StringMap
-fun lookup (
evs
, ev) =
+fun lookup (
(root, evs)
, ev) =
case SM.find (evs, ev) of
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) =
| SOME v => v
fun printEvs (name, evs) =
@@
-56,17
+58,22
@@
fun findPrimitive e =
(name, rev args)
end
(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)
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
| 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'))
in
(conjoin (new, new'),
conjoin (keep, new'))
@@
-76,9
+83,9
@@
fun exec' evs (eAll as (e, _)) =
end
| ELocal (e1, e2) =>
let
end
| ELocal (e1, e2) =>
let
- val evs' = exec' evs e1
+ val evs' = exec' evs
All
e1
in
in
- exec' (
conjoin (evs, evs'
)) e2
+ exec' (
root, (conjoin (evs, evs')
)) e2
end
| EWith (e1, e2) =>
let
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
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' evs
All
e2
in
cleanup ();
evs'
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"
in
case Env.action prim of
NONE => raise Fail "Unbound primitive action"
- | SOME action => action (
evs,
args)
+ | SOME action => action (
conjoin (root, evs), List.map (Reduce.reduceExp Env.empty)
args)
end
fun exec evs e =
end
fun exec evs e =
@@
-113,4
+120,6
@@
fun exec evs e =
Env.post ()
end
Env.post ()
end
+val exec' = fn evs as (root, evs') => fn e => conjoin (evs', exec' evs e)
+
end
end