# HG changeset patch # User Adam Chlipala # Date 1215121157 14400 # Node ID 40d146f467c50652e5e1ac9795f9c79aa0152fb8 # Parent 94afff1ff7f6429bdd3f2480f861bfa954338373 Monoizing cdata diff -r 94afff1ff7f6 -r 40d146f467c5 src/cloconv.sml --- 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) => diff -r 94afff1ff7f6 -r 40d146f467c5 src/mono.sml --- 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' = diff -r 94afff1ff7f6 -r 40d146f467c5 src/mono_print.sml --- 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) = diff -r 94afff1ff7f6 -r 40d146f467c5 src/mono_util.sml --- 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 diff -r 94afff1ff7f6 -r 40d146f467c5 src/monoize.sml --- 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) diff -r 94afff1ff7f6 -r 40d146f467c5 tests/cdata.lac --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/cdata.lac Thu Jul 03 17:39:17 2008 -0400 @@ -0,0 +1,1 @@ +val main : {} -> xml[Html] = fn () =>