diff options
| -rw-r--r-- | include/lacweb.h | 3 | ||||
| -rw-r--r-- | src/c/lacweb.c | 31 | ||||
| -rw-r--r-- | src/compiler.sml | 6 | ||||
| -rw-r--r-- | src/mono_opt.sml | 17 | ||||
| -rw-r--r-- | src/monoize.sml | 2 | ||||
| -rw-r--r-- | tests/cdataF.lac | 8 |
6 files changed, 64 insertions, 3 deletions
diff --git a/include/lacweb.h b/include/lacweb.h index e84e6bcd..4bd49769 100644 --- a/include/lacweb.h +++ b/include/lacweb.h @@ -13,6 +13,9 @@ int lw_send(lw_context, int sock); void lw_write(lw_context, const char*); +char *lw_Basis_htmlifyString(lw_Basis_string); +void lw_Basis_htmlifyString_w(lw_context, lw_Basis_string); + char *lw_Basis_attrifyInt(lw_Basis_int); char *lw_Basis_attrifyFloat(lw_Basis_float); char *lw_Basis_attrifyString(lw_Basis_string); diff --git a/src/c/lacweb.c b/src/c/lacweb.c index fef9ed4c..bccadbdc 100644 --- a/src/c/lacweb.c +++ b/src/c/lacweb.c @@ -72,6 +72,7 @@ void lw_write(lw_context ctx, const char* s) { lw_write_unsafe(ctx, s); } + char *lw_Basis_attrifyInt(lw_Basis_int n) { return "0"; } @@ -207,3 +208,33 @@ lw_Basis_float lw_unurlifyFloat(char **s) { lw_Basis_string lw_unurlifyString(char **s) { return ""; } + + +char *lw_Basis_htmlifyString(lw_Basis_string s) { + return ""; +} + +void lw_Basis_htmlifyString_w(lw_context ctx, lw_Basis_string s) { + lw_check(ctx, strlen(s) * 5); + + for (; *s; s++) { + char c = *s; + + switch (c) { + case '<': + lw_write_unsafe(ctx, "<"); + break; + case '&': + lw_write_unsafe(ctx, "&"); + break; + default: + if (isprint(c)) + lw_writec_unsafe(ctx, c); + else { + lw_write_unsafe(ctx, "&#"); + lw_Basis_attrifyInt_w_unsafe(ctx, c); + lw_writec_unsafe(ctx, ';'); + } + } + } +} diff --git a/src/compiler.sml b/src/compiler.sml index 86ca9416..1e8d84f0 100644 --- a/src/compiler.sml +++ b/src/compiler.sml @@ -51,7 +51,8 @@ fun parseLig filename = val () = TextIO.closeOut outf val () = (ErrorMsg.resetErrors (); - ErrorMsg.resetPositioning filename) + ErrorMsg.resetPositioning filename; + Lex.UserDeclarations.initialize ()) val file = TextIO.openIn fname fun get _ = TextIO.input file fun parseerror (s, p1, p2) = ErrorMsg.errorAt' (p1, p2) s @@ -79,7 +80,8 @@ fun testLig fname = fun parseLac filename = let val () = (ErrorMsg.resetErrors (); - ErrorMsg.resetPositioning filename) + ErrorMsg.resetPositioning filename; + Lex.UserDeclarations.initialize ()) val file = TextIO.openIn filename fun get _ = TextIO.input file fun parseerror (s, p1, p2) = ErrorMsg.errorAt' (p1, p2) s diff --git a/src/mono_opt.sml b/src/mono_opt.sml index aa2c5234..81e42b56 100644 --- a/src/mono_opt.sml +++ b/src/mono_opt.sml @@ -46,6 +46,7 @@ fun attrifyFloat n = Real.toString n val attrifyString = String.translate (fn #"\"" => """ + | #"&" => "&" | ch => if Char.isPrint ch then str ch else @@ -54,6 +55,15 @@ val attrifyString = String.translate (fn #"\"" => """ val urlifyInt = attrifyInt val urlifyFloat = attrifyFloat +val htmlifyString = String.translate (fn ch => case ch of + #"<" => "<" + | #"&" => "&" + | _ => + if Char.isPrint ch orelse Char.isSpace ch then + str ch + else + "&#" ^ Int.toString (ord ch) ^ ";") + fun hexIt ch = let val s = Int.fmt StringCvt.HEX (ord ch) @@ -122,6 +132,13 @@ fun exp e = ESeq ((optExp (EWrite e1, loc), loc), (optExp (EWrite e2, loc), loc)) + | EFfiApp ("Basis", "htmlifyString", [(EPrim (Prim.String s), _)]) => + EPrim (Prim.String (htmlifyString s)) + | EWrite (EFfiApp ("Basis", "htmlifyString", [(EPrim (Prim.String s), _)]), loc) => + EWrite (EPrim (Prim.String (htmlifyString s)), loc) + | EWrite (EFfiApp ("Basis", "htmlifyString", [e]), _) => + EFfiApp ("Basis", "htmlifyString_w", [e]) + | EFfiApp ("Basis", "attrifyInt", [(EPrim (Prim.Int n), _)]) => EPrim (Prim.String (attrifyInt n)) | EWrite (EFfiApp ("Basis", "attrifyInt", [(EPrim (Prim.Int n), _)]), loc) => diff --git a/src/monoize.sml b/src/monoize.sml index 5f9e5ccd..4c28fb48 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -139,7 +139,7 @@ fun monoExp env (all as (e, 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 + _), _), se) => (L'.EFfiApp ("Basis", "htmlifyString", [monoExp env se]), loc) | L.EApp ( (L.EApp ( (L.ECApp ( diff --git a/tests/cdataF.lac b/tests/cdataF.lac new file mode 100644 index 00000000..3f8da45b --- /dev/null +++ b/tests/cdataF.lac @@ -0,0 +1,8 @@ +val snippet = fn s => <body> + <h1>{cdata s}</h1> +</body> + +val main = fn () => <html><body> + {snippet "<Hi."} + {snippet "Bye."} +</body></html> |