Mercurial > urweb
changeset 51:92361a008a10
FFI through monoize
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Sun, 22 Jun 2008 10:12:23 -0400 |
| parents | d37518b67bd2 |
| children | 198172560b73 |
| files | src/cloconv.sml src/mono.sml src/mono_print.sml src/mono_util.sml src/monoize.sml |
| diffstat | 5 files changed, 24 insertions(+), 3 deletions(-) [+] |
line wrap: on
line diff
--- a/src/cloconv.sml Sun Jun 22 10:06:50 2008 -0400 +++ b/src/cloconv.sml Sun Jun 22 10:12:23 2008 -0400 @@ -69,6 +69,7 @@ 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 @@ 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)
--- a/src/mono.sml Sun Jun 22 10:06:50 2008 -0400 +++ b/src/mono.sml Sun Jun 22 10:12:23 2008 -0400 @@ -33,6 +33,7 @@ TFun of typ * typ | TRecord of (string * typ) list | TNamed of int + | TFfi of string * string withtype typ = typ' located @@ -40,6 +41,8 @@ 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
--- a/src/mono_print.sml Sun Jun 22 10:06:50 2008 -0400 +++ b/src/mono_print.sml Sun Jun 22 10:12:23 2008 -0400 @@ -58,6 +58,7 @@ 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 @@ 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])
--- a/src/mono_util.sml Sun Jun 22 10:06:50 2008 -0400 +++ b/src/mono_util.sml Sun Jun 22 10:12:23 2008 -0400 @@ -54,6 +54,7 @@ xts, fn xts' => (TRecord xts', loc)) | TNamed _ => S.return2 cAll + | TFfi _ => S.return2 cAll in mft end @@ -98,6 +99,11 @@ 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' =>
--- a/src/monoize.sml Sun Jun 22 10:06:50 2008 -0400 +++ b/src/monoize.sml Sun Jun 22 10:12:23 2008 -0400 @@ -63,7 +63,7 @@ | 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 @@ 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)