X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/8cbb96323335d1a2b42a9daac94a9d538ab93536..826fb70b752d7e8879f505f3d4ff161d2bb0a4a8:/src/reduce.sml

diff --git a/src/reduce.sml b/src/reduce.sml
index 5d7a1b9..9e538d6 100644
--- a/src/reduce.sml
+++ b/src/reduce.sml
@@ -42,6 +42,8 @@ fun freeIn x (b, _) =
       | 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
@@ -106,6 +108,8 @@ fun subst x e (bAll as (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) =>
@@ -133,7 +137,12 @@ fun reduceExp G (eAll as (e, loc)) =
 	end
       | EVar x =>
 	(case lookupEquation G x of
-	     NONE => eAll
+	     NONE =>
+	     (case function x of
+		  NONE => eAll
+		| SOME f => case f [] of
+				NONE => eAll
+			      | SOME e' => reduceExp G e')
 	   | SOME e => reduceExp G e)
       | EApp (e1, e2) =>
 	let
@@ -174,4 +183,16 @@ fun reduceExp G (eAll as (e, loc)) =
 	    (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