Mercurial > urweb
changeset 94:40d146f467c5
Monoizing cdata
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Thu, 03 Jul 2008 17:39:17 -0400 |
| parents | 94afff1ff7f6 |
| children | 274116d1a4cd |
| files | src/cloconv.sml src/mono.sml src/mono_print.sml src/mono_util.sml src/monoize.sml tests/cdata.lac |
| diffstat | 6 files changed, 26 insertions(+), 0 deletions(-) [+] |
line wrap: on
line diff
--- a/src/cloconv.sml Thu Jul 03 17:14:35 2008 -0400 +++ b/src/cloconv.sml Thu Jul 03 17:39:17 2008 -0400 @@ -185,6 +185,8 @@ ((L'.EField (e1, x), loc), D) end + | L.EStrcat _ => raise Fail "Cloconv EStrcat" + fun ccDecl ((d, loc), D) = case d of L.DVal (x, n, t, e) =>
--- a/src/mono.sml Thu Jul 03 17:14:35 2008 -0400 +++ b/src/mono.sml Thu Jul 03 17:39:17 2008 -0400 @@ -49,6 +49,9 @@ | ERecord of (string * exp * typ) list | EField of exp * string + | EStrcat of exp * exp + + withtype exp = exp' located datatype decl' =
--- a/src/mono_print.sml Thu Jul 03 17:14:35 2008 -0400 +++ b/src/mono_print.sml Thu Jul 03 17:39:17 2008 -0400 @@ -111,6 +111,13 @@ string ".", string x] + + | EStrcat (e1, e2) => box [p_exp' true env e1, + space, + string ".", + space, + p_exp' true env e2] + and p_exp env = p_exp' false env fun p_decl env ((d, _) : decl) =
--- a/src/mono_util.sml Thu Jul 03 17:14:35 2008 -0400 +++ b/src/mono_util.sml Thu Jul 03 17:39:17 2008 -0400 @@ -133,6 +133,13 @@ S.map2 (mfe ctx e, fn e' => (EField (e', x), loc)) + + | EStrcat (e1, e2) => + S.bind2 (mfe ctx e1, + fn e1' => + S.map2 (mfe ctx e2, + fn e2' => + (EStrcat (e1', e2'), loc))) in mfe end
--- a/src/monoize.sml Thu Jul 03 17:14:35 2008 -0400 +++ b/src/monoize.sml Thu Jul 03 17:39:17 2008 -0400 @@ -61,6 +61,8 @@ (L'.TRecord (map (fn (x, t) => (monoName env x, monoType env t)) xcs), loc) | L.TRecord _ => poly () + | L.CApp ((L.CFfi ("Basis", "xml"), _), _) => (L'.TFfi ("Basis", "string"), loc) + | L.CRel _ => poly () | L.CNamed n => (L'.TNamed n, loc) | L.CFfi mx => (L'.TFfi mx, loc) @@ -90,6 +92,10 @@ | L.ENamed n => (L'.ENamed n, loc) | L.EFfi mx => (L'.EFfi mx, loc) | L.EFfiApp (m, x, es) => (L'.EFfiApp (m, x, map (monoExp env) es), loc) + + | L.EApp ((L.ECApp ((L.EFfi ("Basis", "cdata"), _), + _), _), se) => monoExp env se + | 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)