X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/6bb366c5a60247419dce5cbce4a5c034fa2f1e5c..75585a67831244a20e460b7336d440d4cabe3b41:/src/reduce.sml

diff --git a/src/reduce.sml b/src/reduce.sml
index 37c2a35..ab6dafa 100644
--- a/src/reduce.sml
+++ b/src/reduce.sml
@@ -106,6 +106,15 @@ fun subst x e (bAll as (b, loc)) =
 	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
 	EInt _ => eAll
@@ -133,7 +142,15 @@ fun reduceExp G (eAll as (e, loc)) =
 	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