Add external functions called during reduction

diff --git a/src/domain.sml b/src/domain.sml
index 85dcd67..8020ee4 100644 (file)
--- a/src/domain.sml
+++ b/src/domain.sml
@@ -223,8 +223,11 @@ datatype master =
         ExternalMaster of string
        | InternalMaster of string
 
-val ip = fn (EApp ((EVar "ip_of_node", _), e), _) => Option.map nodeIp (Env.string e)
-         | e => Env.string e
+val ip = Env.string
+
+val _ = Env.registerFunction ("ip_of_node",
+                             fn [(EString node, _)] => SOME (EString (nodeIp node), dl)
+                              | _ => NONE)
 
 val master = fn (EApp ((EVar "externalMaster", _), e), _) => Option.map ExternalMaster (ip e)
              | (EApp ((EVar "internalMaster", _), e), _) => Option.map InternalMaster (Env.string e)

diff --git a/src/env.sig b/src/env.sig
index 31e6691..023813a 100644 (file)
--- a/src/env.sig
+++ b/src/env.sig
@@ -82,6 +82,9 @@ signature ENV = sig
 
     val containerV_one : string -> string * 'a arg -> (env_vars * 'a -> unit) * (unit -> unit) -> unit
 
+    val registerFunction : string * (Ast.exp list -> Ast.exp option) -> unit
+    val function : string -> (Ast.exp list -> Ast.exp option) option
+
     type env
     val empty : env
 

diff --git a/src/env.sml b/src/env.sml
index 1a93a38..f87278f 100644 (file)
--- a/src/env.sml
+++ b/src/env.sml
@@ -41,6 +41,11 @@ fun registerContainer (name, befor, after) =
     containers := SM.insert (!containers, name, (befor, after))
 fun container name = SM.find (!containers, name)
 
+val functions : (exp list -> exp option) SM.map ref = ref SM.empty
+fun registerFunction (name, f) =
+    functions := SM.insert (!functions, name, f)
+fun function name = SM.find (!functions, name)
+
 local
     val pr = ref (fn () => ())
 in

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