changeset 53:4f641f8fddaa

FFI through cjrize
author Adam Chlipala <adamc@hcoop.net>
date Sun, 22 Jun 2008 10:21:38 -0400
parents 198172560b73
children a6e185c7c428
files src/cjr.sml src/cjr_print.sml src/cjrize.sml
diffstat 3 files changed, 20 insertions(+), 3 deletions(-) [+]
line wrap: on
line diff
--- a/src/cjr.sml	Sun Jun 22 10:17:34 2008 -0400
+++ b/src/cjr.sml	Sun Jun 22 10:21:38 2008 -0400
@@ -35,6 +35,7 @@
        | TCode of typ * typ
        | TRecord of int
        | TNamed of int
+       | TFfi of string * string
 
 withtype typ = typ' located
 
@@ -42,6 +43,8 @@
          EPrim of Prim.t
        | ERel of int
        | ENamed of int
+       | EFfi of string * string
+       | EFfiApp of string * string * exp list
        | ECode of int
        | EApp of exp * exp
 
--- a/src/cjr_print.sml	Sun Jun 22 10:17:34 2008 -0400
+++ b/src/cjr_print.sml	Sun Jun 22 10:21:38 2008 -0400
@@ -63,6 +63,7 @@
       | TNamed n =>
         (string ("__lwt_" ^ #1 (E.lookupTNamed env n) ^ "_" ^ Int.toString n)
          handle CjrEnv.UnboundNamed _ => string ("__lwt_UNBOUND__" ^ Int.toString n))
+      | TFfi (m, x) => box [string "lw_", string m, string "_", string x]
 
 and p_typ env = p_typ' false env
 
@@ -76,6 +77,14 @@
       | ENamed n =>
         (string ("__lwn_" ^ #1 (E.lookupENamed env n) ^ "_" ^ Int.toString n)
          handle CjrEnv.UnboundNamed _ => string ("__lwn_UNBOUND_" ^ Int.toString n))
+      | EFfi (m, x) => box [string "lw_", string m, string "_", string x]
+      | EFfiApp (m, x, es) => box [string "lw_",
+                                   string m,
+                                   string "_",
+                                   string x,
+                                   string "(",
+                                   p_list (p_exp env) es,
+                                   string ")"]
       | ECode n => string ("__lwc_" ^ Int.toString n)
       | EApp (e1, e2) => parenIf par (box [p_exp' true env e1,
                                            string "(",
--- a/src/cjrize.sml	Sun Jun 22 10:17:34 2008 -0400
+++ b/src/cjrize.sml	Sun Jun 22 10:21:38 2008 -0400
@@ -93,15 +93,20 @@
             ((L'.TRecord si, loc), sm)
         end
       | L.TNamed n => ((L'.TNamed n, loc), sm)
-      | L.TFfi _ => raise Fail "Cjrize TFfi"
+      | L.TFfi mx => ((L'.TFfi mx, loc), sm)
 
 fun cifyExp ((e, loc), sm) =
     case e of
         L.EPrim p => ((L'.EPrim p, loc), sm)
       | L.ERel n => ((L'.ERel n, loc), sm)
       | L.ENamed n => ((L'.ENamed n, loc), sm)
-      | L.EFfi _ => raise Fail "Cjrize EFfi"
-      | L.EFfiApp _ => raise Fail "Cjrize EFfiApp"
+      | L.EFfi mx => ((L'.EFfi mx, loc), sm)
+      | L.EFfiApp (m, x, es) =>
+        let
+            val (es, sm) = ListUtil.foldlMap cifyExp sm es
+        in
+            ((L'.EFfiApp (m, x, es), loc), sm)
+        end
       | L.ECode n => ((L'.ECode n, loc), sm)
       | L.EApp (e1, e2) =>
         let