summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2008-06-22 10:21:38 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2008-06-22 10:21:38 -0400
commit3b6cb47aff3c43b36945c1558eb21d3c7661a9c4 (patch)
tree4570f1ce1befeaa15dd6b15de8768925b097c0eb /src
parentd60f854fc35ce30fb698f3d8e87b88938001fdaf (diff)
FFI through cjrize
Diffstat (limited to 'src')
-rw-r--r--src/cjr.sml3
-rw-r--r--src/cjr_print.sml9
-rw-r--r--src/cjrize.sml11
3 files changed, 20 insertions, 3 deletions
diff --git a/src/cjr.sml b/src/cjr.sml
index c0a2ea15..35dad087 100644
--- a/src/cjr.sml
+++ b/src/cjr.sml
@@ -35,6 +35,7 @@ datatype typ' =
| TCode of typ * typ
| TRecord of int
| TNamed of int
+ | TFfi of string * string
withtype typ = typ' located
@@ -42,6 +43,8 @@ datatype exp' =
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
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index c49d934e..0f924a93 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -63,6 +63,7 @@ fun p_typ' par env (t, loc) =
| 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 @@ fun p_exp' par env (e, _) =
| 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 "(",
diff --git a/src/cjrize.sml b/src/cjrize.sml
index 2647ad24..ef4abea2 100644
--- a/src/cjrize.sml
+++ b/src/cjrize.sml
@@ -93,15 +93,20 @@ fun cifyTyp ((t, loc), sm) =
((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