summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2008-06-22 10:12:23 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2008-06-22 10:12:23 -0400
commitf3ddf9922b90bdd45ca5b1c33c72ff316d5440eb (patch)
tree01bca0e1718350a2e4601c9e493cbddb02d45ba3
parent8f7e31d24652037510c5eac81f56e711a5212246 (diff)
FFI through monoize
-rw-r--r--src/cloconv.sml3
-rw-r--r--src/mono.sml3
-rw-r--r--src/mono_print.sml9
-rw-r--r--src/mono_util.sml6
-rw-r--r--src/monoize.sml6
5 files changed, 24 insertions, 3 deletions
diff --git a/src/cloconv.sml b/src/cloconv.sml
index 93563010..5c26312a 100644
--- a/src/cloconv.sml
+++ b/src/cloconv.sml
@@ -69,6 +69,7 @@ fun ccTyp (t, loc) =
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 @@ fun ccExp env ((e, loc), D) =
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 --git a/src/mono.sml b/src/mono.sml
index c94c3a46..6a5687ed 100644
--- a/src/mono.sml
+++ b/src/mono.sml
@@ -33,6 +33,7 @@ datatype typ' =
TFun of typ * typ
| TRecord of (string * typ) list
| TNamed of int
+ | TFfi of string * string
withtype typ = typ' located
@@ -40,6 +41,8 @@ datatype exp' =
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 --git a/src/mono_print.sml b/src/mono_print.sml
index 885b2d34..ff61e30d 100644
--- a/src/mono_print.sml
+++ b/src/mono_print.sml
@@ -58,6 +58,7 @@ fun p_typ' par env (t, _) =
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 @@ fun p_exp' par env (e, _) =
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 --git a/src/mono_util.sml b/src/mono_util.sml
index bbfd5842..7e4fe52f 100644
--- a/src/mono_util.sml
+++ b/src/mono_util.sml
@@ -54,6 +54,7 @@ fun mapfold fc =
xts,
fn xts' => (TRecord xts', loc))
| TNamed _ => S.return2 cAll
+ | TFfi _ => S.return2 cAll
in
mft
end
@@ -98,6 +99,11 @@ fun mapfoldB {typ = fc, exp = fe, bind} =
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 --git a/src/monoize.sml b/src/monoize.sml
index 1dbbf211..310abc6a 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -63,7 +63,7 @@ fun monoType env (all as (c, loc)) =
| 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 @@ fun monoExp env (all as (e, loc)) =
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)