diff options
author | 2008-06-22 10:17:34 -0400 | |
---|---|---|
committer | 2008-06-22 10:17:34 -0400 | |
commit | d60f854fc35ce30fb698f3d8e87b88938001fdaf (patch) | |
tree | 993aecf3c64b1e472749ccc4cc3d9ffa6dd2ed3e /src | |
parent | f3ddf9922b90bdd45ca5b1c33c72ff316d5440eb (diff) |
FFI through cloconv
Diffstat (limited to 'src')
-rw-r--r-- | src/cjrize.sml | 3 | ||||
-rw-r--r-- | src/cloconv.sml | 11 | ||||
-rw-r--r-- | src/flat.sml | 3 | ||||
-rw-r--r-- | src/flat_print.sml | 9 | ||||
-rw-r--r-- | src/flat_util.sml | 10 |
5 files changed, 33 insertions, 3 deletions
diff --git a/src/cjrize.sml b/src/cjrize.sml index 48d1dae3..2647ad24 100644 --- a/src/cjrize.sml +++ b/src/cjrize.sml @@ -93,12 +93,15 @@ 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" 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.ECode n => ((L'.ECode n, loc), sm) | L.EApp (e1, e2) => let diff --git a/src/cloconv.sml b/src/cloconv.sml index 5c26312a..98f86e5b 100644 --- a/src/cloconv.sml +++ b/src/cloconv.sml @@ -69,7 +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" + | L.TFfi mx => (L'.TFfi mx, loc) structure Ds :> sig type t @@ -111,8 +111,13 @@ 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.EFfi mx => ((L'.EFfi mx, loc), D) + | L.EFfiApp (m, x, es) => + let + val (es, D) = ListUtil.foldlMap (ccExp env) D es + in + ((L'.EFfiApp (m, x, es), loc), D) + end | L.EApp (e1, e2) => let val (e1, D) = ccExp env (e1, D) diff --git a/src/flat.sml b/src/flat.sml index 55c7397a..e635bd1c 100644 --- a/src/flat.sml +++ b/src/flat.sml @@ -35,6 +35,7 @@ datatype typ' = | TCode of typ * typ | TRecord of (string * typ) list | 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/flat_print.sml b/src/flat_print.sml index 08008e9a..ccfceb2f 100644 --- a/src/flat_print.sml +++ b/src/flat_print.sml @@ -66,6 +66,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 @@ -83,6 +84,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 "))"] | ECode n => string ("code$" ^ Int.toString n) | EApp (e1, e2) => parenIf par (box [p_exp env e1, space, diff --git a/src/flat_util.sml b/src/flat_util.sml index 6bddd566..72020d44 100644 --- a/src/flat_util.sml +++ b/src/flat_util.sml @@ -61,6 +61,7 @@ fun compare ((t1, _), (t2, _)) = joinL compareFields (xts1, xts2) end | (TNamed n1, TNamed n2) => Int.compare (n1, n2) + | (TFfi (m1, x1), TFfi (m2, x2)) => join (String.compare (m1, m2), fn () => String.compare (x1, x2)) | (TTop, _) => LESS | (_, TTop) => GREATER @@ -74,6 +75,9 @@ fun compare ((t1, _), (t2, _)) = | (TRecord _, _) => LESS | (_, TRecord _) => GREATER + | (TNamed _, _) => LESS + | (_, TNamed _) => GREATER + and compareFields ((x1, t1), (x2, t2)) = join (String.compare (x1, x2), fn () => compare (t1, t2)) @@ -108,6 +112,7 @@ fun mapfold fc = xts, fn xts' => (TRecord xts', loc)) | TNamed _ => S.return2 cAll + | TFfi _ => S.return2 cAll in mft end @@ -152,6 +157,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)) | ECode _ => S.return2 eAll | EApp (e1, e2) => S.bind2 (mfe ctx e1, |