HCoop
/
hcoop
/
domtool2.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
hcoop: remove mccarthy and navajos from domtool control
[hcoop/domtool2.git]
/
src
/
reduce.sml
diff --git
a/src/reduce.sml
b/src/reduce.sml
index
37c2a35
..
7996580
100644
(file)
--- a/
src/reduce.sml
+++ b/
src/reduce.sml
@@
-36,12
+36,14
@@
fun freeIn x (b, _) =
| ESkip => false
| ESet (_, e) => freeIn x e
| ESkip => false
| ESet (_, e) => freeIn x e
- | EGet (x', _, b') => x <> x' andalso freeIn x b'
+ | EGet (x', _,
_,
b') => x <> x' andalso freeIn x b'
| ESeq es => List.exists (freeIn x) es
| ELocal (e1, e2) => freeIn x e1 orelse freeIn x e2
| EWith (e1, e2) => freeIn x e1 orelse freeIn x e2
| EALam (x', _, b') => x <> x' andalso freeIn x b'
| ESeq es => List.exists (freeIn x) es
| ELocal (e1, e2) => freeIn x e1 orelse freeIn x e2
| EWith (e1, e2) => freeIn x e1 orelse freeIn x e2
| EALam (x', _, b') => x <> x' andalso freeIn x b'
+ | EIf (e1, e2, e3) => freeIn x e1 orelse freeIn x e2 orelse freeIn x e3
+
local
val freshCount = ref 0
in
local
val freshCount = ref 0
in
@@
-80,17
+82,17
@@
fun subst x e (bAll as (b, loc)) =
| ESkip => bAll
| ESet (v, b) => (ESet (v, subst x e b), loc)
| ESkip => bAll
| ESet (v, b) => (ESet (v, subst x e b), loc)
- | EGet (x', v, b') =>
+ | EGet (x',
topt,
v, b') =>
if x = x' then
bAll
else if freeIn x' e then
let
val x'' = freshVar ()
in
if x = x' then
bAll
else if freeIn x' e then
let
val x'' = freshVar ()
in
- (EGet (x'', v, subst x e (subst x' (EVar x'', loc) b')), loc)
+ (EGet (x'',
topt,
v, subst x e (subst x' (EVar x'', loc) b')), loc)
end
else
end
else
- (EGet (x', v, subst x e b'), loc)
+ (EGet (x',
topt,
v, subst x e b'), loc)
| ESeq es => (ESeq (map (subst x e) es), loc)
| ELocal (b1, b2) => (ELocal (subst x e b1, subst x e b2), loc)
| EWith (b1, b2) => (EWith (subst x e b1, subst x e b2), loc)
| ESeq es => (ESeq (map (subst x e) es), loc)
| ELocal (b1, b2) => (ELocal (subst x e b1, subst x e b2), loc)
| EWith (b1, b2) => (EWith (subst x e b1, subst x e b2), loc)
@@
-106,6
+108,17
@@
fun subst x e (bAll as (b, loc)) =
else
(EALam (x', p, subst x e b'), loc)
else
(EALam (x', p, subst x e b'), loc)
+ | EIf (b1, b2, b3) => (EIf (subst x e b1, subst x e b2, subst x e b3), loc)
+
+fun findPrim (e, _) =
+ case e of
+ EApp (f, x) =>
+ (case findPrim f of
+ NONE => NONE
+ | SOME (f, xs) => SOME (f, xs @ [x]))
+ | EVar x => SOME (x, [])
+ | _ => NONE
+
fun reduceExp G (eAll as (e, loc)) =
case e of
EInt _ => eAll
fun reduceExp G (eAll as (e, loc)) =
case e of
EInt _ => eAll
@@
-124,8
+137,13
@@
fun reduceExp G (eAll as (e, loc)) =
end
| EVar x =>
(case lookupEquation G x of
end
| EVar x =>
(case lookupEquation G x of
- NONE => eAll
- | SOME e => reduceExp G e)
+ NONE =>
+ (case function x of
+ NONE => eAll
+ | SOME f => case f [] of
+ NONE => eAll
+ | SOME e' => reduceExp G e')
+ | SOME (e, G') => reduceExp G' e)
| EApp (e1, e2) =>
let
val e1' = reduceExp G e1
| EApp (e1, e2) =>
let
val e1' = reduceExp G e1
@@
-133,12
+151,20
@@
fun reduceExp G (eAll as (e, loc)) =
in
case e1' of
(ELam (x, _, b), _) => reduceExp G (subst x e2' b)
in
case e1' of
(ELam (x, _, b), _) => reduceExp G (subst x e2' b)
- | _ => (EApp (e1', e2'), loc)
+ | _ =>
+ case findPrim eAll of
+ NONE => (EApp (e1', e2'), loc)
+ | SOME (f, args) =>
+ case function f of
+ NONE => (EApp (e1', e2'), loc)
+ | SOME f => case f (map (reduceExp G) args) of
+ NONE => (EApp (e1', e2'), loc)
+ | SOME e' => reduceExp G e'
end
| ESkip => eAll
| ESet (v, b) => (ESet (v, reduceExp G b), loc)
end
| ESkip => eAll
| ESet (v, b) => (ESet (v, reduceExp G b), loc)
- | EGet (x,
v, b) => (EGet (x
, v, reduceExp G b), loc)
+ | EGet (x,
topt, v, b) => (EGet (x, topt
, v, reduceExp G b), loc)
| ESeq es => (ESeq (map (reduceExp G) es), loc)
| ELocal (e1, e2) => (ELocal (reduceExp G e1, reduceExp G e2), loc)
| EWith (e1, e2) =>
| ESeq es => (ESeq (map (reduceExp G) es), loc)
| ELocal (e1, e2) => (ELocal (reduceExp G e1, reduceExp G e2), loc)
| EWith (e1, e2) =>
@@
-157,4
+183,16
@@
fun reduceExp G (eAll as (e, loc)) =
(EALam (x, p, reduceExp G' e), loc)
end
(EALam (x, p, reduceExp G' e), loc)
end
+ | EIf (e1, e2, e3) =>
+ let
+ val e1' = reduceExp G e1
+ fun e2' () = reduceExp G e2
+ fun e3' () = reduceExp G e3
+ in
+ case e1' of
+ (EVar "true", _) => e2' ()
+ | (EVar "false", _) => e3' ()
+ | _ => (EIf (e1', e2' (), e3' ()), loc)
+ end
+
end
end