open Ast Print Env
+structure SM = StringMap
+
fun freeIn x (b, _) =
case b of
EInt _ => false
| 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'
local
val freshCount = ref 0
| 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)
+ | EALam (x', p, b') =>
+ if x = x' then
+ bAll
+ else if freeIn x' e then
+ let
+ val x'' = freshVar ()
+ in
+ (EALam (x'', p, subst x e (subst x' (EVar x'', loc) b')), loc)
+ end
+ else
+ (EALam (x', p, subst x e b'), 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
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
| EGet (x, v, b) => (EGet (x, 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) => (EWith (reduceExp G e1, reduceExp G e2), loc)
+ | EWith (e1, e2) =>
+ let
+ val e1' = reduceExp G e1
+ val e2' = reduceExp G e2
+ in
+ case e1' of
+ (EALam (x, _, b), _) => reduceExp G (subst x e2' b)
+ | _ => (EWith (e1', e2'), loc)
+ end
+ | EALam (x, p, e) =>
+ let
+ val G' = bindVal G (x, (TAction (p, SM.empty, SM.empty), loc), NONE)
+ in
+ (EALam (x, p, reduceExp G' e), loc)
+ end
end