# HG changeset patch
# User Adam Chlipala <adamc@hcoop.net>
# Date 1214143943 14400
# Node ID 92361a008a10b02dbd0669e9e55d6a6ac20c040b
# Parent  d37518b67bd27e91114a8fb0e78464290f7eb09b
FFI through monoize

diff -r d37518b67bd2 -r 92361a008a10 src/cloconv.sml
--- a/src/cloconv.sml	Sun Jun 22 10:06:50 2008 -0400
+++ b/src/cloconv.sml	Sun Jun 22 10:12:23 2008 -0400
@@ -69,6 +69,7 @@
         L.TFun (t1, t2) => (L'.TFun (ccTyp t1, ccTyp t2), loc)
       | L.TRecord xts => (L'.TRecord (map (fn (x, t) => (x, ccTyp t)) xts), loc)
       | L.TNamed n => (L'.TNamed n, loc)
+      | L.TFfi _ => raise Fail "Cloconv TFfi"
 
 structure Ds :> sig
     type t
@@ -110,6 +111,8 @@
         L.EPrim p => ((L'.EPrim p, loc), D)
       | L.ERel n => ((L'.ERel n, loc), Ds.used (D, n))
       | L.ENamed n => ((L'.ENamed n, loc), D)
+      | L.EFfi _ => raise Fail "Cloconv EFfi"
+      | L.EFfiApp _ => raise Fail "Cloconv EFfiApp"
       | L.EApp (e1, e2) =>
         let
             val (e1, D) = ccExp env (e1, D)
diff -r d37518b67bd2 -r 92361a008a10 src/mono.sml
--- a/src/mono.sml	Sun Jun 22 10:06:50 2008 -0400
+++ b/src/mono.sml	Sun Jun 22 10:12:23 2008 -0400
@@ -33,6 +33,7 @@
          TFun of typ * typ
        | TRecord of (string * typ) list
        | TNamed of int
+       | TFfi of string * string
 
 withtype typ = typ' located
 
@@ -40,6 +41,8 @@
          EPrim of Prim.t
        | ERel of int
        | ENamed of int
+       | EFfi of string * string
+       | EFfiApp of string * string * exp list
        | EApp of exp * exp
        | EAbs of string * typ * typ * exp
 
diff -r d37518b67bd2 -r 92361a008a10 src/mono_print.sml
--- a/src/mono_print.sml	Sun Jun 22 10:06:50 2008 -0400
+++ b/src/mono_print.sml	Sun Jun 22 10:12:23 2008 -0400
@@ -58,6 +58,7 @@
             string (#1 (E.lookupTNamed env n) ^ "__" ^ Int.toString n)
         else
             string (#1 (E.lookupTNamed env n))
+      | TFfi (m, x) => box [string "FFI(", string m, string ".", string x, string ")"]
 
 and p_typ env = p_typ' false env
 
@@ -74,6 +75,14 @@
             string (#1 (E.lookupENamed env n) ^ "__" ^ Int.toString n)
         else
             string (#1 (E.lookupENamed env n))
+      | EFfi (m, x) => box [string "FFI(", string m, string ".", string x, string ")"]
+      | EFfiApp (m, x, es) => box [string "FFI(",
+                                   string m,
+                                   string ".",
+                                   string x,
+                                   string "(",
+                                   p_list (p_exp env) es,
+                                   string "))"]
       | EApp (e1, e2) => parenIf par (box [p_exp env e1,
                                            space,
                                            p_exp' true env e2])
diff -r d37518b67bd2 -r 92361a008a10 src/mono_util.sml
--- a/src/mono_util.sml	Sun Jun 22 10:06:50 2008 -0400
+++ b/src/mono_util.sml	Sun Jun 22 10:12:23 2008 -0400
@@ -54,6 +54,7 @@
                                          xts,
                      fn xts' => (TRecord xts', loc))
               | TNamed _ => S.return2 cAll
+              | TFfi _ => S.return2 cAll
     in
         mft
     end
@@ -98,6 +99,11 @@
                 EPrim _ => S.return2 eAll
               | ERel _ => S.return2 eAll
               | ENamed _ => S.return2 eAll
+              | EFfi _ => S.return2 eAll
+              | EFfiApp (m, x, es) =>
+                S.map2 (ListUtil.mapfold (fn e => mfe ctx e) es,
+                     fn es' =>
+                        (EFfiApp (m, x, es'), loc))
               | EApp (e1, e2) =>
                 S.bind2 (mfe ctx e1,
                       fn e1' =>
diff -r d37518b67bd2 -r 92361a008a10 src/monoize.sml
--- a/src/monoize.sml	Sun Jun 22 10:06:50 2008 -0400
+++ b/src/monoize.sml	Sun Jun 22 10:12:23 2008 -0400
@@ -63,7 +63,7 @@
 
           | L.CRel _ => poly ()
           | L.CNamed n => (L'.TNamed n, loc)
-          | L.CFfi _ => raise Fail "Monoize CFfi"
+          | L.CFfi mx => (L'.TFfi mx, loc)
           | L.CApp _ => poly ()
           | L.CAbs _ => poly ()
 
@@ -86,8 +86,8 @@
             L.EPrim p => (L'.EPrim p, loc)
           | L.ERel n => (L'.ERel n, loc)
           | L.ENamed n => (L'.ENamed n, loc)
-          | L.EFfi _ => raise Fail "Monoize EFfi"
-          | L.EFfiApp _ => raise Fail "Monoize EFfiApp"
+          | L.EFfi mx => (L'.EFfi mx, loc)
+          | L.EFfiApp (m, x, es) => (L'.EFfiApp (m, x, map (monoExp env) es), loc)
           | L.EApp (e1, e2) => (L'.EApp (monoExp env e1, monoExp env e2), loc)
           | L.EAbs (x, dom, ran, e) =>
             (L'.EAbs (x, monoType env dom, monoType env ran, monoExp (Env.pushERel env x dom) e), loc)