init.d script for domtool-slave

[hcoop/domtool2.git] / src / reduce.sml

diff --git a/src/reduce.sml b/src/reduce.sml
index 37c2a35..ab6dafa 100644 (file)
--- 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