Apt package installation querying of dispatcher

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

diff --git a/src/reduce.sml b/src/reduce.sml
index 17a8507..ab6dafa 100644 (file)
--- a/src/reduce.sml
+++ b/src/reduce.sml
@@ -14,7 +14,7 @@
  * You should have received a copy of the GNU General Public License
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
-*)
+ *)
 
 (* Evaluation of expressions until only externs are around *)
 
@@ -22,6 +22,8 @@ structure Reduce :> REDUCE = struct
 
 open Ast Print Env
 
+structure SM = StringMap
+
 fun freeIn x (b, _) =
     case b of
        EInt _ => false
@@ -38,6 +40,7 @@ fun 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'
 
 local
     val freshCount = ref 0
@@ -91,6 +94,26 @@ fun subst x e (bAll as (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)
+      | 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
@@ -119,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
@@ -127,6 +158,20 @@ fun reduceExp G (eAll as (e, loc)) =
       | 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