diff options
author | Adam Chlipala <adamc@hcoop.net> | 2008-06-22 10:21:38 -0400 |
---|---|---|
committer | Adam Chlipala <adamc@hcoop.net> | 2008-06-22 10:21:38 -0400 |
commit | 3b6cb47aff3c43b36945c1558eb21d3c7661a9c4 (patch) | |
tree | 4570f1ce1befeaa15dd6b15de8768925b097c0eb /src | |
parent | d60f854fc35ce30fb698f3d8e87b88938001fdaf (diff) |
FFI through cjrize
Diffstat (limited to 'src')
-rw-r--r-- | src/cjr.sml | 3 | ||||
-rw-r--r-- | src/cjr_print.sml | 9 | ||||
-rw-r--r-- | src/cjrize.sml | 11 |
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 |