# HG changeset patch # User Adam Chlipala # Date 1214144498 14400 # Node ID 4f641f8fddaa19980258a10d4a5ef9e44607324e # Parent 198172560b7368d9511721f94f75d7968fc310d8 FFI through cjrize diff -r 198172560b73 -r 4f641f8fddaa src/cjr.sml --- 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 diff -r 198172560b73 -r 4f641f8fddaa src/cjr_print.sml --- 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 "(", diff -r 198172560b73 -r 4f641f8fddaa src/cjrize.sml --- 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