diff options
| -rw-r--r-- | src/cloconv.sml | 2 | ||||
| -rw-r--r-- | src/mono.sml | 3 | ||||
| -rw-r--r-- | src/mono_print.sml | 7 | ||||
| -rw-r--r-- | src/mono_util.sml | 7 | ||||
| -rw-r--r-- | src/monoize.sml | 6 | ||||
| -rw-r--r-- | tests/cdata.lac | 1 |
6 files changed, 26 insertions, 0 deletions
diff --git a/src/cloconv.sml b/src/cloconv.sml index b403b659..bf877d28 100644 --- a/src/cloconv.sml +++ b/src/cloconv.sml @@ -185,6 +185,8 @@ fun ccExp env ((e, loc), D) = ((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 --git a/src/mono.sml b/src/mono.sml index 6a5687ed..39de583c 100644 --- a/src/mono.sml +++ b/src/mono.sml @@ -49,6 +49,9 @@ datatype exp' = | ERecord of (string * exp * typ) list | EField of exp * string + | EStrcat of exp * exp + + withtype exp = exp' located datatype decl' = diff --git a/src/mono_print.sml b/src/mono_print.sml index ff61e30d..c0847019 100644 --- a/src/mono_print.sml +++ b/src/mono_print.sml @@ -111,6 +111,13 @@ fun p_exp' par env (e, _) = 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 --git a/src/mono_util.sml b/src/mono_util.sml index 7e4fe52f..5309244a 100644 --- a/src/mono_util.sml +++ b/src/mono_util.sml @@ -133,6 +133,13 @@ fun mapfoldB {typ = fc, exp = fe, bind} = 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 --git a/src/monoize.sml b/src/monoize.sml index 335b93e6..7d9c1fab 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -61,6 +61,8 @@ fun monoType env (all as (c, loc)) = (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 @@ fun monoExp env (all as (e, loc)) = | 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 --git a/tests/cdata.lac b/tests/cdata.lac new file mode 100644 index 00000000..1822df5a --- /dev/null +++ b/tests/cdata.lac @@ -0,0 +1 @@ +val main : {} -> xml[Html] = fn () => <html></html> |