Mercurial > urweb
changeset 2048:4d64af730e35
Differentiate between HTML and normal string literals
| author | Adam Chlipala <adam@chlipala.net> |
|---|---|
| date | Fri, 01 Aug 2014 15:44:17 -0400 |
| parents | 6be31671911b |
| children | 459ccbf8cd08 |
| files | src/cjr_print.sml src/cjrize.sml src/iflow.sml src/jscomp.sml src/mono_opt.sml src/mono_reduce.sml src/monoize.sml src/pathcheck.sml src/prepare.sml src/prim.sig src/prim.sml src/shake.sml src/sql.sml src/urweb.grm |
| diffstat | 14 files changed, 516 insertions(+), 535 deletions(-) [+] |
line wrap: on
line diff
--- a/src/cjr_print.sml Fri Aug 01 11:43:44 2014 -0400 +++ b/src/cjr_print.sml Fri Aug 01 15:44:17 2014 -0400 @@ -203,10 +203,10 @@ Prim.p_t_GCC (Prim.Int n), string ")"] | PPrim (Prim.String s) => box [string ("!strcmp(" ^ disc), - string ",", - space, - Prim.p_t_GCC (Prim.String s), - string ")"] + string ",", + space, + Prim.p_t_GCC (Prim.String s), + string ")"] | PPrim (Prim.Char ch) => box [string ("(" ^ disc), space, string "==", @@ -503,16 +503,16 @@ | ECase (e, [((PNone _, _), - (EPrim (Prim.String "NULL"), _)), + (EPrim (Prim.String (_, "NULL")), _)), ((PSome (_, (PVar _, _)), _), (EFfiApp (m, x, [((ERel 0, _), _)]), _))], {disc = t, ...}) => map (fn (x, y) => (x, Nullable y)) (getPargs (EFfiApp (m, x, [(e, t)]), #2 e)) | ECase (e, [((PCon (_, PConFfi {mod = "Basis", con = "True", ...}, _), _), - (EPrim (Prim.String "TRUE"), _)), + (EPrim (Prim.String (_, "TRUE")), _)), ((PCon (_, PConFfi {mod = "Basis", con = "False", ...}, _), _), - (EPrim (Prim.String "FALSE"), _))], + (EPrim (Prim.String (_, "FALSE")), _))], _) => [(e, Bool)] | _ => raise Fail "CjrPrint: getPargs" @@ -2218,7 +2218,7 @@ NONE => #nextval (Settings.currentDbms ()) {loc = loc, seqE = p_exp' false false env seq, seqName = case #1 seq of - EPrim (Prim.String s) => SOME s + EPrim (Prim.String (_, s)) => SOME s | _ => NONE} | SOME {id, query} => #nextvalPrepared (Settings.currentDbms ()) {loc = loc, id = id,
--- a/src/cjrize.sml Fri Aug 01 11:43:44 2014 -0400 +++ b/src/cjrize.sml Fri Aug 01 15:44:17 2014 -0400 @@ -242,7 +242,7 @@ let fun fail msg = (ErrorMsg.errorAt loc msg; - ((L'.EPrim (Prim.String ""), loc), sm)) + ((L'.EPrim (Prim.String (Prim.Normal, "")), loc), sm)) in case e of L.EPrim p => ((L'.EPrim p, loc), sm) @@ -632,7 +632,7 @@ fun flatten e = case #1 e of L.ERecord [] => [] - | L.ERecord [(x, (L.EPrim (Prim.String v), _), _)] => [(x, v)] + | L.ERecord [(x, (L.EPrim (Prim.String (_, v)), _), _)] => [(x, v)] | L.EStrcat (e1, e2) => flatten e1 @ flatten e2 | _ => (ErrorMsg.errorAt loc "Constraint has not been fully determined"; Print.prefaces "Undetermined constraint" @@ -640,7 +640,7 @@ []) val pe = case #1 pe of - L.EPrim (Prim.String s) => s + L.EPrim (Prim.String (_, s)) => s | _ => (ErrorMsg.errorAt loc "Primary key has not been fully determined"; Print.prefaces "Undetermined constraint" [("e", MonoPrint.p_exp MonoEnv.empty pe)]; @@ -662,7 +662,7 @@ fun flatten e = case #1 e of L.ERecord [] => [] - | L.ERecord [(x, (L.EPrim (Prim.String v), _), _)] => [(x, v)] + | L.ERecord [(x, (L.EPrim (Prim.String (_, v)), _), _)] => [(x, v)] | L.EStrcat (e1, e2) => flatten e1 @ flatten e2 | _ => (ErrorMsg.errorAt loc "Constraint has not been fully determined"; Print.prefaces "Undetermined constraint" @@ -670,7 +670,7 @@ []) val e = case #1 e of - L.EPrim (Prim.String s) => s + L.EPrim (Prim.String (_, s)) => s | _ => (ErrorMsg.errorAt loc "VIEW query has not been fully determined"; Print.prefaces "Undetermined VIEW query" [("e", MonoPrint.p_exp MonoEnv.empty e)];
--- a/src/iflow.sml Fri Aug 01 11:43:44 2014 -0400 +++ b/src/iflow.sml Fri Aug 01 15:44:17 2014 -0400 @@ -1446,7 +1446,7 @@ case es of [_, (cname, _), _, _, _] => (case #1 cname of - EPrim (Prim.String cname) => + EPrim (Prim.String (_, cname)) => St.havocCookie cname | _ => ()) | _ => () @@ -1637,7 +1637,7 @@ | Update (tab, _, _) => (cs, SS.add (ts, tab))) | EFfiApp ("Basis", "set_cookie", - [_, ((EPrim (Prim.String cname), _), _), + [_, ((EPrim (Prim.String (_, cname)), _), _), _, _, _]) => (SS.add (cs, cname), ts) | _ => st} @@ -1765,7 +1765,7 @@ handle Cc.Contradiction => ()) end) - | ENextval (EPrim (Prim.String seq), _) => + | ENextval (EPrim (Prim.String (_, seq)), _) => let val nv = St.nextVar () in @@ -1775,7 +1775,7 @@ | ENextval _ => default () | ESetval _ => default () - | EUnurlify ((EFfiApp ("Basis", "get_cookie", [((EPrim (Prim.String cname), _), _)]), _), _, _) => + | EUnurlify ((EFfiApp ("Basis", "get_cookie", [((EPrim (Prim.String (_, cname)), _), _)]), _), _, _) => let val e = Var (St.nextVar ()) val e' = Func (Other ("cookie/" ^ cname), []) @@ -1843,9 +1843,9 @@ (e', fn e' => (EFfiApp (m, f, [(e', t)]), #2 e)) | ECase (e', ps as [((PCon (_, PConFfi {mod = "Basis", con = "True", ...}, NONE), _), - (EPrim (Prim.String "TRUE"), _)), + (EPrim (Prim.String (_, "TRUE")), _)), ((PCon (_, PConFfi {mod = "Basis", con = "False", ...}, NONE), _), - (EPrim (Prim.String "FALSE"), _))], q) => + (EPrim (Prim.String (_, "FALSE")), _))], q) => (e', fn e' => (ECase (e', ps, q), #2 e)) | _ => (e, fn x => x) in @@ -1907,7 +1907,7 @@ let val ks = case #1 pk of - EPrim (Prim.String s) => + EPrim (Prim.String (_, s)) => (case String.tokens (fn ch => ch = #"," orelse ch = #" ") s of [] => [] | pk => [pk]) @@ -1974,7 +1974,7 @@ | EFfi _ => e | EFfiApp (m, f, es) => (case (m, f, es) of - ("Basis", "set_cookie", [_, ((EPrim (Prim.String cname), _), _), _, _, _]) => + ("Basis", "set_cookie", [_, ((EPrim (Prim.String (_, cname)), _), _), _, _, _]) => cookies := SS.add (!cookies, cname) | _ => (); (EFfiApp (m, f, map (fn (e, t) => (doExp env e, t)) es), loc)) @@ -2150,7 +2150,7 @@ | _ => raise Fail "Iflow: No New or Old in mayUpdate policy") e | PolSequence e => (case #1 e of - EPrim (Prim.String seq) => + EPrim (Prim.String (_, seq)) => let val p = AReln (Sql (String.extract (seq, 3, NONE)), [Lvar 0]) val outs = [Lvar 0]
--- a/src/jscomp.sml Fri Aug 01 11:43:44 2014 -0400 +++ b/src/jscomp.sml Fri Aug 01 15:44:17 2014 -0400 @@ -55,7 +55,7 @@ fun strcat loc es = case es of - [] => (EPrim (Prim.String ""), loc) + [] => (EPrim (Prim.String (Prim.Normal, "")), loc) | [x] => x | x :: es' => (EStrcat (x, strcat loc es'), loc) @@ -81,7 +81,7 @@ | (_, state) => state) (IM.empty, IM.empty) (#1 file) - fun str loc s = (EPrim (Prim.String s), loc) + fun str loc s = (EPrim (Prim.String (Prim.Normal, s)), loc) fun isNullable (t, _) = case t of @@ -149,7 +149,7 @@ val (e', st) = quoteExp loc t ((ERel 0, loc), st) in (case #1 e' of - EPrim (Prim.String "ERROR") => raise Fail "UHOH" + EPrim (Prim.String (_, "ERROR")) => raise Fail "UHOH" | _ => (ECase (e, [((PNone t, loc), @@ -450,7 +450,7 @@ 3) in case p of - Prim.String s => + Prim.String (_, s) => str ("\"" ^ String.translate jsChar s ^ "\"") | Prim.Char ch => str ("\"" ^ jsChar ch ^ "\"") | _ => str (Prim.toString p) @@ -519,7 +519,7 @@ fun deStrcat level (all as (e, loc)) = case e of - EPrim (Prim.String s) => jsifyStringMulti (level, s) + EPrim (Prim.String (_, s)) => jsifyStringMulti (level, s) | EStrcat (e1, e2) => deStrcat level e1 ^ deStrcat level e2 | EFfiApp ("Basis", "jsifyString", [(e, _)]) => "\"" ^ deStrcat (level + 1) e ^ "\"" | _ => (ErrorMsg.errorAt loc "Unexpected non-constant JavaScript code"; @@ -1021,10 +1021,10 @@ case #1 e of EPrim p => (case p of - Prim.String s => if inString {needle = "<script", haystack = s} then - foundJavaScript := true - else - () + Prim.String (_, s) => if inString {needle = "<script", haystack = s} then + foundJavaScript := true + else + () | _ => (); (e, st)) | ERel _ => (e, st)
--- a/src/mono_opt.sml Fri Aug 01 11:43:44 2014 -0400 +++ b/src/mono_opt.sml Fri Aug 01 15:44:17 2014 -0400 @@ -145,7 +145,7 @@ fun exp e = case e of - EPrim (Prim.String s) => + EPrim (Prim.String (Prim.Html, s)) => if CharVector.exists Char.isSpace s then let val (_, chs) = @@ -160,14 +160,14 @@ end) (false, []) s in - EPrim (Prim.String (String.implode (rev chs))) + EPrim (Prim.String (Prim.Html, String.implode (rev chs))) end else e | EFfiApp ("Basis", "strcat", [(e1, _), (e2, _)]) => exp (EStrcat (e1, e2)) - - | EStrcat ((EPrim (Prim.String s1), loc), (EPrim (Prim.String s2), _)) => + + | EStrcat ((EPrim (Prim.String (Prim.Html, s1)), loc), (EPrim (Prim.String (Prim.Html, s2)), _)) => let val s = if size s1 > 0 andalso size s2 > 0 @@ -177,10 +177,13 @@ else s1 ^ s2 in - EPrim (Prim.String s) + EPrim (Prim.String (Prim.Html, s)) end + + | EStrcat ((EPrim (Prim.String (_, s1)), loc), (EPrim (Prim.String (_, s2)), _)) => + EPrim (Prim.String (Prim.Normal, s1 ^ s2)) - | EStrcat ((EPrim (Prim.String s1), loc), (EStrcat ((EPrim (Prim.String s2), _), rest), _)) => + | EStrcat ((EPrim (Prim.String (Prim.Html, s1)), loc), (EStrcat ((EPrim (Prim.String (Prim.Html, s2)), _), rest), _)) => let val s = if size s1 > 0 andalso size s2 > 0 @@ -190,9 +193,12 @@ else s1 ^ s2 in - EStrcat ((EPrim (Prim.String s), loc), rest) + EStrcat ((EPrim (Prim.String (Prim.Html, s)), loc), rest) end + | EStrcat ((EPrim (Prim.String (_, s1)), loc), (EStrcat ((EPrim (Prim.String (_, s2)), _), rest), _)) => + EStrcat ((EPrim (Prim.String (Prim.Normal, s1 ^ s2)), loc), rest) + | EStrcat ((EStrcat (e1, e2), loc), e3) => optExp (EStrcat (e1, (EStrcat (e2, e3), loc)), loc) @@ -200,27 +206,27 @@ ESeq ((optExp (EWrite e1, loc), loc), (optExp (EWrite e2, loc), loc)) - | ESeq ((EWrite (EPrim (Prim.String s1), _), loc), - (EWrite (EPrim (Prim.String s2), _), _)) => - EWrite (EPrim (Prim.String (s1 ^ s2)), loc) - | ESeq ((EWrite (EPrim (Prim.String s1), _), loc), - (ESeq ((EWrite (EPrim (Prim.String s2), _), _), + | ESeq ((EWrite (EPrim (Prim.String (_, s1)), _), loc), + (EWrite (EPrim (Prim.String (_, s2)), _), _)) => + EWrite (EPrim (Prim.String (Prim.Normal, s1 ^ s2)), loc) + | ESeq ((EWrite (EPrim (Prim.String (_, s1)), _), loc), + (ESeq ((EWrite (EPrim (Prim.String (_, s2)), _), _), e), _)) => - ESeq ((EWrite (EPrim (Prim.String (s1 ^ s2)), loc), loc), + ESeq ((EWrite (EPrim (Prim.String (Prim.Normal, s1 ^ s2)), loc), loc), e) | EFfiApp ("Basis", "htmlifySpecialChar", [((EPrim (Prim.Char ch), _), _)]) => - EPrim (Prim.String (htmlifySpecialChar ch)) + EPrim (Prim.String (Prim.Html, htmlifySpecialChar ch)) | EWrite (EFfiApp ("Basis", "htmlifySpecialChar", [e]), _) => EFfiApp ("Basis", "htmlifySpecialChar_w", [e]) | EFfiApp ("Basis", "htmlifyString", [((EFfiApp ("Basis", "intToString", [((EPrim (Prim.Int n), _), _)]), _), _)]) => - EPrim (Prim.String (htmlifyInt n)) + EPrim (Prim.String (Prim.Html, htmlifyInt n)) | EFfiApp ("Basis", "htmlifyString", [((EFfiApp ("Basis", "intToString", es), _), _)]) => EFfiApp ("Basis", "htmlifyInt", es) | EFfiApp ("Basis", "htmlifyString", [((EApp ((EFfi ("Basis", "intToString"), _), (EPrim (Prim.Int n), _)), _), _)]) => - EPrim (Prim.String (htmlifyInt n)) + EPrim (Prim.String (Prim.Html, htmlifyInt n)) | EFfiApp ("Basis", "htmlifyString", [((EApp ((EFfi ("Basis", "intToString"), _), e), loc), _)]) => EFfiApp ("Basis", "htmlifyInt", [(e, (TFfi ("Basis", "int"), loc))]) @@ -228,12 +234,12 @@ EFfiApp ("Basis", "htmlifyInt_w", [e]) | EFfiApp ("Basis", "htmlifyString", [((EFfiApp ("Basis", "floatToString", [((EPrim (Prim.Float n), _), _)]), _), _)]) => - EPrim (Prim.String (htmlifyFloat n)) + EPrim (Prim.String (Prim.Html, htmlifyFloat n)) | EFfiApp ("Basis", "htmlifyString", [((EFfiApp ("Basis", "floatToString", es), _), _)]) => EFfiApp ("Basis", "htmlifyFloat", es) | EFfiApp ("Basis", "htmlifyString", [((EApp ((EFfi ("Basis", "floatToString"), _), (EPrim (Prim.Float n), _)), _), _)]) => - EPrim (Prim.String (htmlifyFloat n)) + EPrim (Prim.String (Prim.Html, htmlifyFloat n)) | EFfiApp ("Basis", "htmlifyString", [((EApp ((EFfi ("Basis", "floatToString"), _), e), loc), _)]) => EFfiApp ("Basis", "htmlifyFloat", [(e, (TFfi ("Basis", "float"), loc))]) @@ -242,18 +248,18 @@ | EFfiApp ("Basis", "htmlifyString", [((EFfiApp ("Basis", "boolToString", [((ECon (Enum, PConFfi {con = "True", ...}, NONE), _), _)]), _), _)]) => - EPrim (Prim.String "True") + EPrim (Prim.String (Prim.Html, "True")) | EFfiApp ("Basis", "htmlifyString", [((EFfiApp ("Basis", "boolToString", [((ECon (Enum, PConFfi {con = "False", ...}, NONE), _), _)]), _), _)]) => - EPrim (Prim.String "False") + EPrim (Prim.String (Prim.Html, "False")) | EFfiApp ("Basis", "htmlifyString", [((EFfiApp ("Basis", "boolToString", es), _), _)]) => EFfiApp ("Basis", "htmlifyBool", es) | EFfiApp ("Basis", "htmlifyString", [((EApp ((EFfi ("Basis", "boolToString"), _), (ECon (Enum, PConFfi {con = "True", ...}, NONE), _)), _), _)]) => - EPrim (Prim.String "True") + EPrim (Prim.String (Prim.Html, "True")) | EFfiApp ("Basis", "htmlifyString", [((EApp ((EFfi ("Basis", "boolToString"), _), (ECon (Enum, PConFfi {con = "False", ...}, NONE), _)), _), _)]) => - EPrim (Prim.String "False") + EPrim (Prim.String (Prim.Html, "False")) | EFfiApp ("Basis", "htmlifyString", [((EApp ((EFfi ("Basis", "boolToString"), _), e), loc), _)]) => EFfiApp ("Basis", "htmlifyBool", [(e, (TFfi ("Basis", "bool"), loc))]) @@ -267,106 +273,106 @@ | EWrite (EFfiApp ("Basis", "htmlifyTime", [e]), _) => EFfiApp ("Basis", "htmlifyTime_w", [e]) - | 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) + | EFfiApp ("Basis", "htmlifyString", [((EPrim (Prim.String (_, s)), _), _)]) => + EPrim (Prim.String (Prim.Html, htmlifyString s)) + | EWrite (EFfiApp ("Basis", "htmlifyString", [((EPrim (Prim.String (_, s)), _), _)]), loc) => + EWrite (EPrim (Prim.String (Prim.Html, htmlifyString s)), loc) | EWrite (EFfiApp ("Basis", "htmlifyString", [e]), _) => EFfiApp ("Basis", "htmlifyString_w", [e]) - | EFfiApp ("Basis", "htmlifyString_w", [((EPrim (Prim.String s), loc), _)]) => - EWrite (EPrim (Prim.String (htmlifyString s)), loc) + | EFfiApp ("Basis", "htmlifyString_w", [((EPrim (Prim.String (_, s)), loc), _)]) => + EWrite (EPrim (Prim.String (Prim.Html, htmlifyString s)), loc) | EWrite (EFfiApp ("Basis", "htmlifySource", [e]), _) => EFfiApp ("Basis", "htmlifySource_w", [e]) | EFfiApp ("Basis", "attrifyInt", [((EPrim (Prim.Int n), _), _)]) => - EPrim (Prim.String (attrifyInt n)) + EPrim (Prim.String (Prim.Html, attrifyInt n)) | EWrite (EFfiApp ("Basis", "attrifyInt", [((EPrim (Prim.Int n), _), _)]), loc) => - EWrite (EPrim (Prim.String (attrifyInt n)), loc) + EWrite (EPrim (Prim.String (Prim.Html, attrifyInt n)), loc) | EWrite (EFfiApp ("Basis", "attrifyInt", [e]), _) => EFfiApp ("Basis", "attrifyInt_w", [e]) | EFfiApp ("Basis", "attrifyFloat", [((EPrim (Prim.Float n), _), _)]) => - EPrim (Prim.String (attrifyFloat n)) + EPrim (Prim.String (Prim.Html, attrifyFloat n)) | EWrite (EFfiApp ("Basis", "attrifyFloat", [((EPrim (Prim.Float n), _), _)]), loc) => - EWrite (EPrim (Prim.String (attrifyFloat n)), loc) + EWrite (EPrim (Prim.String (Prim.Html, attrifyFloat n)), loc) | EWrite (EFfiApp ("Basis", "attrifyFloat", [e]), _) => EFfiApp ("Basis", "attrifyFloat_w", [e]) - | EFfiApp ("Basis", "attrifyString", [((EPrim (Prim.String s), _), _)]) => - EPrim (Prim.String (attrifyString s)) - | EWrite (EFfiApp ("Basis", "attrifyString", [((EPrim (Prim.String s), _), _)]), loc) => - EWrite (EPrim (Prim.String (attrifyString s)), loc) + | EFfiApp ("Basis", "attrifyString", [((EPrim (Prim.String (_, s)), _), _)]) => + EPrim (Prim.String (Prim.Html, attrifyString s)) + | EWrite (EFfiApp ("Basis", "attrifyString", [((EPrim (Prim.String (_, s)), _), _)]), loc) => + EWrite (EPrim (Prim.String (Prim.Html, attrifyString s)), loc) | EWrite (EFfiApp ("Basis", "attrifyString", [e]), _) => EFfiApp ("Basis", "attrifyString_w", [e]) | EFfiApp ("Basis", "attrifyChar", [((EPrim (Prim.Char s), _), _)]) => - EPrim (Prim.String (attrifyChar s)) + EPrim (Prim.String (Prim.Html, attrifyChar s)) | EWrite (EFfiApp ("Basis", "attrifyChar", [((EPrim (Prim.Char s), _), _)]), loc) => - EWrite (EPrim (Prim.String (attrifyChar s)), loc) + EWrite (EPrim (Prim.String (Prim.Html, attrifyChar s)), loc) | EWrite (EFfiApp ("Basis", "attrifyChar", [e]), _) => EFfiApp ("Basis", "attrifyChar_w", [e]) - | EFfiApp ("Basis", "attrifyCss_class", [((EPrim (Prim.String s), _), _)]) => - EPrim (Prim.String s) - | EWrite (EFfiApp ("Basis", "attrifyCss_class", [((EPrim (Prim.String s), _), _)]), loc) => - EWrite (EPrim (Prim.String s), loc) + | EFfiApp ("Basis", "attrifyCss_class", [((EPrim (Prim.String (_, s)), _), _)]) => + EPrim (Prim.String (Prim.Html, s)) + | EWrite (EFfiApp ("Basis", "attrifyCss_class", [((EPrim (Prim.String (_, s)), _), _)]), loc) => + EWrite (EPrim (Prim.String (Prim.Html, s)), loc) | EWrite (EFfiApp ("Basis", "attrifyCss_class", [e]), _) => EFfiApp ("Basis", "attrifyString_w", [e]) | EFfiApp ("Basis", "urlifyInt", [((EPrim (Prim.Int n), _), _)]) => - EPrim (Prim.String (urlifyInt n)) + EPrim (Prim.String (Prim.Normal, urlifyInt n)) | EWrite (EFfiApp ("Basis", "urlifyInt", [((EPrim (Prim.Int n), _), _)]), loc) => - EWrite (EPrim (Prim.String (urlifyInt n)), loc) + EWrite (EPrim (Prim.String (Prim.Normal, urlifyInt n)), loc) | EWrite (EFfiApp ("Basis", "urlifyInt", [e]), _) => EFfiApp ("Basis", "urlifyInt_w", [e]) | EFfiApp ("Basis", "urlifyFloat", [((EPrim (Prim.Float n), _), _)]) => - EPrim (Prim.String (urlifyFloat n)) + EPrim (Prim.String (Prim.Normal, urlifyFloat n)) | EWrite (EFfiApp ("Basis", "urlifyFloat", [((EPrim (Prim.Float n), _), _)]), loc) => - EWrite (EPrim (Prim.String (urlifyFloat n)), loc) + EWrite (EPrim (Prim.String (Prim.Normal, urlifyFloat n)), loc) | EWrite (EFfiApp ("Basis", "urlifyFloat", [e]), _) => EFfiApp ("Basis", "urlifyFloat_w", [e]) - | EFfiApp ("Basis", "urlifyString", [((EPrim (Prim.String s), _), _)]) => - EPrim (Prim.String (urlifyString s)) - | EWrite (EFfiApp ("Basis", "urlifyString", [((EPrim (Prim.String s), _), _)]), loc) => - EWrite (EPrim (Prim.String (urlifyString s)), loc) + | EFfiApp ("Basis", "urlifyString", [((EPrim (Prim.String (_, s)), _), _)]) => + EPrim (Prim.String (Prim.Normal, urlifyString s)) + | EWrite (EFfiApp ("Basis", "urlifyString", [((EPrim (Prim.String (Prim.Normal, s)), _), _)]), loc) => + EWrite (EPrim (Prim.String (Prim.Normal, urlifyString s)), loc) | EWrite (EFfiApp ("Basis", "urlifyString", [e]), _) => EFfiApp ("Basis", "urlifyString_w", [e]) | EFfiApp ("Basis", "urlifyBool", [((ECon (Enum, PConFfi {con = "True", ...}, NONE), _), _)]) => - EPrim (Prim.String "1") + EPrim (Prim.String (Prim.Normal, "1")) | EFfiApp ("Basis", "urlifyBool", [((ECon (Enum, PConFfi {con = "False", ...}, NONE), _), _)]) => - EPrim (Prim.String "0") + EPrim (Prim.String (Prim.Normal, "0")) | EWrite (EFfiApp ("Basis", "urlifyBool", [((ECon (Enum, PConFfi {con = "True", ...}, NONE), _), _)]), loc) => - EWrite (EPrim (Prim.String "1"), loc) + EWrite (EPrim (Prim.String (Prim.Normal, "1")), loc) | EWrite (EFfiApp ("Basis", "urlifyBool", [((ECon (Enum, PConFfi {con = "False", ...}, NONE), _), _)]), loc) => - EWrite (EPrim (Prim.String "0"), loc) + EWrite (EPrim (Prim.String (Prim.Normal, "0")), loc) | EWrite (EFfiApp ("Basis", "urlifyBool", [e]), _) => EFfiApp ("Basis", "urlifyBool_w", [e]) | EFfiApp ("Basis", "sqlifyInt", [((EPrim (Prim.Int n), _), _)]) => - EPrim (Prim.String (sqlifyInt n)) + EPrim (Prim.String (Prim.Normal, sqlifyInt n)) | EFfiApp ("Basis", "sqlifyIntN", [((ENone _, _), _)]) => - EPrim (Prim.String "NULL") + EPrim (Prim.String (Prim.Normal, "NULL")) | EFfiApp ("Basis", "sqlifyIntN", [((ESome (_, (EPrim (Prim.Int n), _)), _), _)]) => - EPrim (Prim.String (sqlifyInt n)) + EPrim (Prim.String (Prim.Normal, sqlifyInt n)) | EFfiApp ("Basis", "sqlifyFloat", [((EPrim (Prim.Float n), _), _)]) => - EPrim (Prim.String (sqlifyFloat n)) + EPrim (Prim.String (Prim.Normal, sqlifyFloat n)) | EFfiApp ("Basis", "sqlifyBool", [(b as (_, loc), _)]) => optExp (ECase (b, [((PCon (Enum, PConFfi {mod = "Basis", datatyp = "bool", con = "True", arg = NONE}, NONE), loc), - (EPrim (Prim.String (#trueString (Settings.currentDbms ()))), loc)), + (EPrim (Prim.String (Prim.Normal, #trueString (Settings.currentDbms ()))), loc)), ((PCon (Enum, PConFfi {mod = "Basis", datatyp = "bool", con = "False", arg = NONE}, NONE), loc), - (EPrim (Prim.String (#falseString (Settings.currentDbms ()))), loc))], + (EPrim (Prim.String (Prim.Normal, #falseString (Settings.currentDbms ()))), loc))], {disc = (TFfi ("Basis", "bool"), loc), result = (TFfi ("Basis", "string"), loc)}), loc) - | EFfiApp ("Basis", "sqlifyString", [((EPrim (Prim.String n), _), _)]) => - EPrim (Prim.String (sqlifyString n)) + | EFfiApp ("Basis", "sqlifyString", [((EPrim (Prim.String (_, n)), _), _)]) => + EPrim (Prim.String (Prim.Normal, sqlifyString n)) | EFfiApp ("Basis", "sqlifyChar", [((EPrim (Prim.Char n), _), _)]) => - EPrim (Prim.String (sqlifyChar n)) + EPrim (Prim.String (Prim.Normal, sqlifyChar n)) | EWrite (ECase (discE, pes, {disc, ...}), loc) => optExp (ECase (discE, @@ -388,11 +394,11 @@ end | EWrite (EQuery {exps, tables, state, query, - initial = (EPrim (Prim.String ""), _), - body = (EStrcat ((EPrim (Prim.String s), _), + initial = (EPrim (Prim.String (k, "")), _), + body = (EStrcat ((EPrim (Prim.String (_, s)), _), (EStrcat ((ERel 0, _), e'), _)), _)}, loc) => - if CharVector.all Char.isSpace s then + if (case k of Prim.Normal => s = "" | Prim.Html => CharVector.all Char.isSpace s) then EQuery {exps = exps, tables = tables, query = query, state = (TRecord [], loc), initial = (ERecord [], loc), @@ -401,7 +407,7 @@ e | EWrite (EQuery {exps, tables, state, query, - initial = (EPrim (Prim.String ""), _), + initial = (EPrim (Prim.String (_, "")), _), body}, loc) => let fun passLets (depth, (e', _), lets) = @@ -439,94 +445,94 @@ | EWrite (ELet (x, t, e1, e2), loc) => optExp (ELet (x, t, e1, (EWrite e2, loc)), loc) - | EWrite (EPrim (Prim.String ""), loc) => + | EWrite (EPrim (Prim.String (_, "")), loc) => ERecord [] | ESignalBind ((ESignalReturn e1, loc), e2) => optExp (EApp (e2, e1), loc) - | EFfiApp ("Basis", "blessData", [((se as EPrim (Prim.String s), loc), _)]) => + | EFfiApp ("Basis", "blessData", [((se as EPrim (Prim.String (_, s)), loc), _)]) => (if checkData s then () else ErrorMsg.errorAt loc ("Invalid HTML5 data-* attribute " ^ s); se) - | EFfiApp ("Basis", "bless", [((se as EPrim (Prim.String s), loc), _)]) => + | EFfiApp ("Basis", "bless", [((se as EPrim (Prim.String (_, s)), loc), _)]) => (if checkUrl s then () else ErrorMsg.errorAt loc ("Invalid URL " ^ s ^ " passed to 'bless'"); se) - | EFfiApp ("Basis", "checkUrl", [((se as EPrim (Prim.String s), loc), _)]) => + | EFfiApp ("Basis", "checkUrl", [((se as EPrim (Prim.String (_, s)), loc), _)]) => (if checkUrl s then ESome ((TFfi ("Basis", "string"), loc), (se, loc)) else ENone (TFfi ("Basis", "string"), loc)) - | EFfiApp ("Basis", "blessMime", [((se as EPrim (Prim.String s), loc), _)]) => + | EFfiApp ("Basis", "blessMime", [((se as EPrim (Prim.String (_, s)), loc), _)]) => (if Settings.checkMime s then () else ErrorMsg.errorAt loc ("Invalid string " ^ s ^ " passed to 'blessMime'"); se) - | EFfiApp ("Basis", "checkMime", [((se as EPrim (Prim.String s), loc), _)]) => + | EFfiApp ("Basis", "checkMime", [((se as EPrim (Prim.String (_, s)), loc), _)]) => (if Settings.checkMime s then ESome ((TFfi ("Basis", "string"), loc), (se, loc)) else ENone (TFfi ("Basis", "string"), loc)) - | EFfiApp ("Basis", "atom", [((se as EPrim (Prim.String s), loc), _)]) => + | EFfiApp ("Basis", "atom", [((se as EPrim (Prim.String (_, s)), loc), _)]) => (if checkAtom s then () else ErrorMsg.errorAt loc ("Invalid string " ^ s ^ " passed to 'atom'"); se) - | EFfiApp ("Basis", "css_url", [((se as EPrim (Prim.String s), loc), _)]) => + | EFfiApp ("Basis", "css_url", [((se as EPrim (Prim.String (_, s)), loc), _)]) => (if checkCssUrl s then () else ErrorMsg.errorAt loc ("Invalid URL " ^ s ^ " passed to 'css_url'"); se) - | EFfiApp ("Basis", "property", [((se as EPrim (Prim.String s), loc), _)]) => + | EFfiApp ("Basis", "property", [((se as EPrim (Prim.String (_, s)), loc), _)]) => (if checkProperty s then () else ErrorMsg.errorAt loc ("Invalid string " ^ s ^ " passed to 'property'"); se) - | EFfiApp ("Basis", "blessRequestHeader", [((se as EPrim (Prim.String s), loc), _)]) => + | EFfiApp ("Basis", "blessRequestHeader", [((se as EPrim (Prim.String (_, s)), loc), _)]) => (if Settings.checkRequestHeader s then () else ErrorMsg.errorAt loc ("Invalid string " ^ s ^ " passed to 'blessRequestHeader'"); se) - | EFfiApp ("Basis", "checkRequestHeader", [((se as EPrim (Prim.String s), loc), _)]) => + | EFfiApp ("Basis", "checkRequestHeader", [((se as EPrim (Prim.String (_, s)), loc), _)]) => (if Settings.checkRequestHeader s then ESome ((TFfi ("Basis", "string"), loc), (se, loc)) else ENone (TFfi ("Basis", "string"), loc)) - | EFfiApp ("Basis", "blessResponseHeader", [((se as EPrim (Prim.String s), loc), _)]) => + | EFfiApp ("Basis", "blessResponseHeader", [((se as EPrim (Prim.String (_, s)), loc), _)]) => (if Settings.checkResponseHeader s then () else ErrorMsg.errorAt loc ("Invalid string " ^ s ^ " passed to 'blessResponseHeader'"); se) - | EFfiApp ("Basis", "checkResponseHeader", [((se as EPrim (Prim.String s), loc), _)]) => + | EFfiApp ("Basis", "checkResponseHeader", [((se as EPrim (Prim.String (_, s)), loc), _)]) => (if Settings.checkResponseHeader s then ESome ((TFfi ("Basis", "string"), loc), (se, loc)) else ENone (TFfi ("Basis", "string"), loc)) - | EFfiApp ("Basis", "blessEnvVar", [((se as EPrim (Prim.String s), loc), _)]) => + | EFfiApp ("Basis", "blessEnvVar", [((se as EPrim (Prim.String (_, s)), loc), _)]) => (if Settings.checkEnvVar s then () else ErrorMsg.errorAt loc ("Invalid string " ^ s ^ " passed to 'blessEnvVar'"); se) - | EFfiApp ("Basis", "checkEnvVar", [((se as EPrim (Prim.String s), loc), _)]) => + | EFfiApp ("Basis", "checkEnvVar", [((se as EPrim (Prim.String (_, s)), loc), _)]) => (if Settings.checkEnvVar s then ESome ((TFfi ("Basis", "string"), loc), (se, loc)) else ENone (TFfi ("Basis", "string"), loc)) - | EFfiApp ("Basis", "checkString", [((EPrim (Prim.String s), loc), _)]) => + | EFfiApp ("Basis", "checkString", [((EPrim (Prim.String (_, s)), loc), _)]) => let fun uwify (cs, acc) = case cs of @@ -551,10 +557,10 @@ #"_" :: cs => uwify (cs, ["uw_"]) | cs => uwify (cs, []) in - EPrim (Prim.String s) + EPrim (Prim.String (Prim.Normal, s)) end - | EFfiApp ("Basis", "viewify", [((EPrim (Prim.String s), loc), _)]) => + | EFfiApp ("Basis", "viewify", [((EPrim (Prim.String (_, s)), loc), _)]) => let fun uwify (cs, acc) = case cs of @@ -576,11 +582,11 @@ val s = uwify (String.explode s, []) in - EPrim (Prim.String s) + EPrim (Prim.String (Prim.Normal, s)) end - | EFfiApp ("Basis", "unAs", [((EPrim (Prim.String s), _), _)]) => - EPrim (Prim.String (unAs s)) + | EFfiApp ("Basis", "unAs", [((EPrim (Prim.String (_, s)), _), _)]) => + EPrim (Prim.String (Prim.Normal, unAs s)) | EFfiApp ("Basis", "unAs", [(e', _)]) => let fun parts (e as (_, loc)) = @@ -589,7 +595,7 @@ (case (parts s1, parts s2) of (SOME p1, SOME p2) => SOME (p1 @ p2) | _ => NONE) - | EPrim (Prim.String s) => SOME [(EPrim (Prim.String (unAs s)), loc)] + | EPrim (Prim.String (_, s)) => SOME [(EPrim (Prim.String (Prim.Normal, unAs s)), loc)] | EFfiApp ("Basis", f, [_]) => if String.isPrefix "sqlify" f then SOME [e] @@ -607,7 +613,7 @@ end | EFfiApp ("Basis", "str1", [((EPrim (Prim.Char ch), _), _)]) => - EPrim (Prim.String (str ch)) + EPrim (Prim.String (Prim.Normal, str ch)) | EFfiApp ("Basis", "attrifyString", [((EFfiApp ("Basis", "str1", [e]), _), _)]) => EFfiApp ("Basis", "attrifyChar", [e]) | EFfiApp ("Basis", "attrifyString_w", [((EFfiApp ("Basis", "str1", [e]), _), _)]) =>
--- a/src/mono_reduce.sml Fri Aug 01 11:43:44 2014 -0400 +++ b/src/mono_reduce.sml Fri Aug 01 15:44:17 2014 -0400 @@ -190,13 +190,13 @@ (PWild, _) => Yes env | (PVar (x, t), _) => Yes ((x, t, e) :: env) - | (PPrim (Prim.String s), EStrcat ((EPrim (Prim.String s'), _), _)) => + | (PPrim (Prim.String (_, s)), EStrcat ((EPrim (Prim.String (_, s')), _), _)) => if String.isPrefix s' s then Maybe else No - | (PPrim (Prim.String s), EStrcat (_, (EPrim (Prim.String s'), _))) => + | (PPrim (Prim.String (_, s)), EStrcat (_, (EPrim (Prim.String (_, s')), _))) => if String.isSuffix s' s then Maybe else @@ -756,8 +756,10 @@ | ELet (x, t, e', b) => doLet (x, t, e', b) - | EStrcat ((EPrim (Prim.String s1), _), (EPrim (Prim.String s2), _)) => - EPrim (Prim.String (s1 ^ s2)) + | EStrcat ((EPrim (Prim.String (k1, s1)), _), (EPrim (Prim.String (k2, s2)), _)) => + EPrim (Prim.String ((case (k1, k2) of + (Prim.Html, Prim.Html) => Prim.Html + | _ => Prim.Normal), s1 ^ s2)) | ESignalBind ((ESignalReturn e1, loc), e2) => #1 (reduceExp env (EApp (e2, e1), loc))
--- a/src/monoize.sml Fri Aug 01 11:43:44 2014 -0400 +++ b/src/monoize.sml Fri Aug 01 15:44:17 2014 -0400 @@ -515,7 +515,7 @@ let val (_, _, _, s) = Env.lookupENamed env fnam in - ((L'.EPrim (Prim.String (Settings.getUrlPrefix () ^ s)), loc), fm) + ((L'.EPrim (Prim.String (Prim.Normal, Settings.getUrlPrefix () ^ s)), loc), fm) end | L'.EClosure (fnam, args) => let @@ -531,21 +531,21 @@ in attrify (args, ft, (L'.EStrcat (e, - (L'.EStrcat ((L'.EPrim (Prim.String "/"), loc), + (L'.EStrcat ((L'.EPrim (Prim.String (Prim.Normal, "/")), loc), arg'), loc)), loc), fm) end | _ => (E.errorAt loc "Type mismatch encoding attribute"; (e, fm)) in - attrify (args, ft, (L'.EPrim (Prim.String (Settings.getUrlPrefix () ^ s)), loc), fm) + attrify (args, ft, (L'.EPrim (Prim.String (Prim.Normal, Settings.getUrlPrefix () ^ s)), loc), fm) end | _ => case t of - L'.TFfi ("Basis", "unit") => ((L'.EPrim (Prim.String ""), loc), fm) + L'.TFfi ("Basis", "unit") => ((L'.EPrim (Prim.String (Prim.Normal, "")), loc), fm) | L'.TFfi (m, x) => ((L'.EFfiApp (m, fk2s fk ^ "ify" ^ capitalize x, [(e, tAll)]), loc), fm) - | L'.TRecord [] => ((L'.EPrim (Prim.String ""), loc), fm) + | L'.TRecord [] => ((L'.EPrim (Prim.String (Prim.Normal, "")), loc), fm) | L'.TRecord ((x, t) :: xts) => let val (se, fm) = fooify fm ((L'.EField (e, x), loc), t) @@ -555,7 +555,7 @@ val (se', fm) = fooify fm ((L'.EField (e, x), loc), t) in ((L'.EStrcat (se, - (L'.EStrcat ((L'.EPrim (Prim.String "/"), loc), + (L'.EStrcat ((L'.EPrim (Prim.String (Prim.Normal, "/")), loc), se'), loc)), loc), fm) end) (se, fm) xts @@ -585,14 +585,14 @@ case to of NONE => (((L'.PCon (dk, L'.PConVar n, NONE), loc), - (L'.EPrim (Prim.String x), loc)), + (L'.EPrim (Prim.String (Prim.Normal, x)), loc)), fm) | SOME t => let val (arg, fm) = fooify fm ((L'.ERel 0, loc), t) in (((L'.PCon (dk, L'.PConVar n, SOME (L'.PVar ("a", t), loc)), loc), - (L'.EStrcat ((L'.EPrim (Prim.String (x ^ "/")), loc), + (L'.EStrcat ((L'.EPrim (Prim.String (Prim.Normal, x ^ "/")), loc), arg), loc)), fm) end) @@ -626,10 +626,10 @@ in ((L'.ECase (e, [((L'.PNone t, loc), - (L'.EPrim (Prim.String "None"), loc)), + (L'.EPrim (Prim.String (Prim.Normal, "None")), loc)), ((L'.PSome (t, (L'.PVar ("x", t), loc)), loc), - (L'.EStrcat ((L'.EPrim (Prim.String "Some/"), loc), + (L'.EStrcat ((L'.EPrim (Prim.String (Prim.Normal, "Some/")), loc), body), loc))], {disc = tAll, result = (L'.TFfi ("Basis", "string"), loc)}), loc), @@ -644,9 +644,9 @@ val (arg, fm) = fooify fm ((L'.ERel 0, loc), rt) val branches = [((L'.PNone rt, loc), - (L'.EPrim (Prim.String "Nil"), loc)), + (L'.EPrim (Prim.String (Prim.Normal, "Nil")), loc)), ((L'.PSome (rt, (L'.PVar ("a", rt), loc)), loc), - (L'.EStrcat ((L'.EPrim (Prim.String "Cons/"), loc), + (L'.EStrcat ((L'.EPrim (Prim.String (Prim.Normal, "Cons/")), loc), arg), loc))] val dom = tAll @@ -742,7 +742,7 @@ fun strcat loc es = case es of - [] => (L'.EPrim (Prim.String ""), loc) + [] => (L'.EPrim (Prim.String (Prim.Normal, "")), loc) | [e] => e | _ => let @@ -757,7 +757,7 @@ fun strcatComma loc es = case es of - [] => (L'.EPrim (Prim.String ""), loc) + [] => (L'.EPrim (Prim.String (Prim.Normal, "")), loc) | [e] => e | _ => let @@ -766,11 +766,11 @@ in foldr (fn (e, e') => case (e, e') of - ((L'.EPrim (Prim.String ""), _), _) => e' - | (_, (L'.EPrim (Prim.String ""), _)) => e + ((L'.EPrim (Prim.String (_, "")), _), _) => e' + | (_, (L'.EPrim (Prim.String (_, "")), _)) => e | _ => (L'.EStrcat (e, - (L'.EStrcat ((L'.EPrim (Prim.String ", "), loc), e'), loc)), loc)) + (L'.EStrcat ((L'.EPrim (Prim.String (Prim.Normal, ", ")), loc), e'), loc)), loc)) e1 es end @@ -788,7 +788,8 @@ let val strcat = strcat loc val strcatComma = strcatComma loc - fun str s = (L'.EPrim (Prim.String s), loc) + fun str s = (L'.EPrim (Prim.String (Prim.Normal, s)), loc) + fun strH s = (L'.EPrim (Prim.String (Prim.Html, s)), loc) fun poly () = (E.errorAt loc "Unsupported expression"; @@ -1564,9 +1565,7 @@ ((L'.EAbs ("c", s, (L'.TFun (rt, (L'.TFun (un, un), loc)), loc), (L'.EAbs ("r", rt, (L'.TFun (un, un), loc), (L'.EAbs ("_", un, un, - (L'.EFfiApp ("Basis", "set_cookie", [((L'.EPrim (Prim.String - (Settings.getUrlPrefix ())), - loc), s), + (L'.EFfiApp ("Basis", "set_cookie", [(str (Settings.getUrlPrefix ()), s), ((L'.ERel 2, loc), s), (e, s), (fd "Expires", (L'.TOption (L'.TFfi ("Basis", "time"), loc), loc)), @@ -1583,9 +1582,7 @@ ((L'.EAbs ("c", s, (L'.TFun (un, un), loc), (L'.EAbs ("_", un, un, (L'.EFfiApp ("Basis", "clear_cookie", - [((L'.EPrim (Prim.String - (Settings.getUrlPrefix ())), - loc), s), + [(str (Settings.getUrlPrefix ()), s), ((L'.ERel 1, loc), s)]), loc)), loc)), loc), fm) @@ -1612,8 +1609,7 @@ end | L.ECApp ((L.EFfi ("Basis", "no_primary_key"), _), _) => - ((L'.EPrim (Prim.String ""), loc), - fm) + (str "", fm) | L.ECApp ( (L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "primary_key"), _), _), _), t), _), nm), _), @@ -1623,16 +1619,16 @@ val witnesses = (L'.TRecord (map (fn (nm, _) => (monoName env nm, (L'.TRecord [], loc))) unique), loc) in ((L'.EAbs ("_", witnesses, (L'.TFfi ("Basis", "string"), loc), - (L'.EPrim (Prim.String - (String.concatWith ", " - (map (fn (x, _) => - Settings.mangleSql (monoNameLc env x) - ^ (if #textKeysNeedLengths (Settings.currentDbms ()) - andalso isBlobby t then - "(767)" - else - "")) unique))), - loc)), loc), + (str + (String.concatWith ", " + (map (fn (x, _) => + Settings.mangleSql (monoNameLc env x) + ^ (if #textKeysNeedLengths (Settings.currentDbms ()) + andalso isBlobby t then + "(767)" + else + "")) unique)))), + loc), fm) end @@ -1668,15 +1664,15 @@ let val unique = (nm, t) :: unique in - ((L'.EPrim (Prim.String ("UNIQUE (" - ^ String.concatWith ", " - (map (fn (x, t) => Settings.mangleSql (monoNameLc env x) - ^ (if #textKeysNeedLengths (Settings.currentDbms ()) - andalso isBlobby t then - "(767)" - else - "")) unique) - ^ ")")), loc), + (str ("UNIQUE (" + ^ String.concatWith ", " + (map (fn (x, t) => Settings.mangleSql (monoNameLc env x) + ^ (if #textKeysNeedLengths (Settings.currentDbms ()) + andalso isBlobby t then + "(767)" + else + "")) unique) + ^ ")"), fm) end @@ -1690,7 +1686,7 @@ | L.EFfi ("Basis", "mat_nil") => let val string = (L'.TFfi ("Basis", "string"), loc) - val stringE = (L'.EPrim (Prim.String ""), loc) + val stringE = str "" in ((L'.ERecord [("1", stringE, string), ("2", stringE, string)], loc), fm) @@ -1715,21 +1711,20 @@ ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFun (mat, mat), loc), (L'.EAbs ("m", mat, mat, (L'.ECase ((L'.EField ((L'.ERel 0, loc), "1"), loc), - [((L'.PPrim (Prim.String ""), loc), - (L'.ERecord [("1", (L'.EPrim (Prim.String (Settings.mangleSql (lowercaseFirst nm1))), - loc), string), - ("2", (L'.EPrim (Prim.String (Settings.mangleSql (lowercaseFirst nm2))), - loc), string)], loc)), + [((L'.PPrim (Prim.String (Prim.Normal, "")), loc), + (L'.ERecord [("1", str (Settings.mangleSql (lowercaseFirst nm1)), + string), + ("2", str (Settings.mangleSql (lowercaseFirst nm2)), + string)], loc)), ((L'.PWild, loc), (L'.ERecord [("1", (L'.EStrcat ( - (L'.EPrim (Prim.String (Settings.mangleSql (lowercaseFirst nm1) - ^ ", ")), - loc), + str (Settings.mangleSql (lowercaseFirst nm1) + ^ ", "), (L'.EField ((L'.ERel 0, loc), "1"), loc)), loc), string), ("2", (L'.EStrcat ( - (L'.EPrim (Prim.String (Settings.mangleSql (lowercaseFirst nm2) - ^ ", ")), loc), + str (Settings.mangleSql (lowercaseFirst nm2) + ^ ", "), (L'.EField ((L'.ERel 0, loc), "2"), loc)), loc), string)], loc))], @@ -1738,10 +1733,10 @@ fm) end - | L.ECApp ((L.EFfi ("Basis", "restrict"), _), _) => ((L'.EPrim (Prim.String "RESTRICT"), loc), fm) - | L.ECApp ((L.EFfi ("Basis", "cascade"), _), _) => ((L'.EPrim (Prim.String "CASCADE"), loc), fm) - | L.ECApp ((L.EFfi ("Basis", "no_action"), _), _) => ((L'.EPrim (Prim.String "NO ACTION"), loc), fm) - | L.ECApp ((L.EFfi ("Basis", "set_null"), _), _) => ((L'.EPrim (Prim.String "SET NULL"), loc), fm) + | L.ECApp ((L.EFfi ("Basis", "restrict"), _), _) => (str "RESTRICT", fm) + | L.ECApp ((L.EFfi ("Basis", "cascade"), _), _) => (str "CASCADE", fm) + | L.ECApp ((L.EFfi ("Basis", "no_action"), _), _) => (str "NO ACTION", fm) + | L.ECApp ((L.EFfi ("Basis", "set_null"), _), _) => (str "SET NULL", fm) | L.ECApp ( (L.ECApp ( @@ -1773,10 +1768,10 @@ fun prop (fd, kw) = (L'.ECase ((L'.EField ((L'.ERel 0, loc), fd), loc), - [((L'.PPrim (Prim.String "NO ACTION"), loc), - (L'.EPrim (Prim.String ""), loc)), + [((L'.PPrim (Prim.String (Prim.Normal, "NO ACTION")), loc), + str ""), ((L'.PWild, loc), - strcat [(L'.EPrim (Prim.String (" ON " ^ kw ^ " ")), loc), + strcat [str (" ON " ^ kw ^ " "), (L'.EField ((L'.ERel 0, loc), fd), loc)])], {disc = string, result = string}), loc) @@ -1784,13 +1779,13 @@ ((L'.EAbs ("m", mat, (L'.TFun (string, (L'.TFun (recd, string), loc)), loc), (L'.EAbs ("tab", string, (L'.TFun (recd, string), loc), (L'.EAbs ("pr", recd, string, - strcat [(L'.EPrim (Prim.String "FOREIGN KEY ("), loc), + strcat [str "FOREIGN KEY (", (L'.EField ((L'.ERel 2, loc), "1"), loc), - (L'.EPrim (Prim.String ") REFERENCES "), loc), + str ") REFERENCES ", (L'.ERel 1, loc), - (L'.EPrim (Prim.String " ("), loc), + str " (", (L'.EField ((L'.ERel 2, loc), "2"), loc), - (L'.EPrim (Prim.String ")"), loc), + str ")", prop ("OnDelete", "DELETE"), prop ("OnUpdate", "UPDATE")]), loc)), loc)), loc), fm) @@ -1823,7 +1818,7 @@ val string = (L'.TFfi ("Basis", "string"), loc) in ((L'.EAbs ("e", string, string, - (L'.EStrcat ((L'.EPrim (Prim.String "CHECK "), loc), + (L'.EStrcat (str "CHECK ", (L'.EFfiApp ("Basis", "checkString", [((L'.ERel 0, loc), string)]), loc)), loc)), loc), fm) @@ -1852,19 +1847,18 @@ val s = (L'.TFfi ("Basis", "string"), loc) val fields = map (fn (x, _) => (x, s)) fields val rt = (L'.TRecord fields, loc) - fun sc s = (L'.EPrim (Prim.String s), loc) in ((L'.EAbs ("tab", s, (L'.TFun (rt, s), loc), (L'.EAbs ("fs", rt, s, - strcat [sc "INSERT INTO ", + strcat [str "INSERT INTO ", (L'.ERel 1, loc), - sc " (", - strcatComma (map (fn (x, _) => sc (Settings.mangleSql x)) fields), - sc ") VALUES (", + str " (", + strcatComma (map (fn (x, _) => str (Settings.mangleSql x)) fields), + str ") VALUES (", strcatComma (map (fn (x, _) => (L'.EField ((L'.ERel 0, loc), x), loc)) fields), - sc ")"]), loc)), loc), + str ")"]), loc)), loc), fm) end | _ => poly ()) @@ -1876,31 +1870,30 @@ val s = (L'.TFfi ("Basis", "string"), loc) val changed = map (fn (x, _) => (x, s)) changed val rt = (L'.TRecord changed, loc) - fun sc s = (L'.EPrim (Prim.String s), loc) in ((L'.EAbs ("fs", rt, (L'.TFun (s, (L'.TFun (s, s), loc)), loc), (L'.EAbs ("tab", s, (L'.TFun (s, s), loc), (L'.EAbs ("e", s, s, if #supportsUpdateAs (Settings.currentDbms ()) then - strcat [sc "UPDATE ", + strcat [str "UPDATE ", (L'.ERel 1, loc), - sc " AS T_T SET ", + str " AS T_T SET ", strcatComma (map (fn (x, _) => - strcat [sc (Settings.mangleSql x + strcat [str (Settings.mangleSql x ^ " = "), (L'.EField ((L'.ERel 2, loc), x), loc)]) changed), - sc " WHERE ", + str " WHERE ", (L'.ERel 0, loc)] else - strcat [sc "UPDATE ", + strcat [str "UPDATE ", (L'.ERel 1, loc), - sc " SET ", + str " SET ", strcatComma (map (fn (x, _) => - strcat [sc (Settings.mangleSql x + strcat [str (Settings.mangleSql x ^ " = "), (L'.EFfiApp ("Basis", "unAs", [((L'.EField @@ -1909,7 +1902,7 @@ x), loc), s)]), loc)]) changed), - sc " WHERE ", + str " WHERE ", (L'.EFfiApp ("Basis", "unAs", [((L'.ERel 0, loc), s)]), loc)]), loc)), loc)), loc), fm) @@ -1919,19 +1912,18 @@ | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "delete"), _), _), _), _) => let val s = (L'.TFfi ("Basis", "string"), loc) - fun sc s = (L'.EPrim (Prim.String s), loc) in ((L'.EAbs ("tab", s, (L'.TFun (s, s), loc), (L'.EAbs ("e", s, s, if #supportsDeleteAs (Settings.currentDbms ()) then - strcat [sc "DELETE FROM ", + strcat [str "DELETE FROM ", (L'.ERel 1, loc), - sc " AS T_T WHERE ", + str " AS T_T WHERE ", (L'.ERel 0, loc)] else - strcat [sc "DELETE FROM ", + strcat [str "DELETE FROM ", (L'.ERel 1, loc), - sc " WHERE ", + str " WHERE ", (L'.EFfiApp ("Basis", "unAs", [((L'.ERel 0, loc), s)]), loc)]), loc)), loc), fm) end @@ -1991,7 +1983,6 @@ | L.ECApp ((L.ECApp ((L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_query"), _), _), _), _), _), _), _), _), _), _) => let - fun sc s = (L'.EPrim (Prim.String s), loc) val s = (L'.TFfi ("Basis", "string"), loc) fun gf s = (L'.EField ((L'.ERel 0, loc), s), loc) in @@ -2000,9 +1991,9 @@ s, strcat [gf "Rows", (L'.ECase (gf "OrderBy", - [((L'.PPrim (Prim.String ""), loc), sc ""), + [((L'.PPrim (Prim.String (Prim.Normal, "")), loc), str ""), ((L'.PWild, loc), - strcat [sc " ORDER BY ", + strcat [str " ORDER BY ", gf "OrderBy"])], {disc = s, result = s}), loc), gf "Limit", @@ -2025,7 +2016,6 @@ sexps), _), _) => let - fun sc s = (L'.EPrim (Prim.String s), loc) val s = (L'.TFfi ("Basis", "string"), loc) val b = (L'.TFfi ("Basis", "bool"), loc) val un = (L'.TRecord [], loc) @@ -2072,7 +2062,7 @@ ("SelectExps", (L'.TRecord (map (fn (x, _) => (x, s)) sexps), loc))], loc), s, - strcat [sc "SELECT ", + strcat [str "SELECT ", (L'.ECase (gf "Distinct", [((L'.PCon (L'.Enum, L'.PConFfi {mod = "Basis", @@ -2080,41 +2070,41 @@ con = "True", arg = NONE}, NONE), loc), - (L'.EPrim (Prim.String "DISTINCT "), loc)), + str "DISTINCT "), ((L'.PCon (L'.Enum, L'.PConFfi {mod = "Basis", datatyp = "bool", con = "False", arg = NONE}, NONE), loc), - (L'.EPrim (Prim.String ""), loc))], + str "")], {disc = b, result = s}), loc), strcatComma (map (fn (x, t) => strcat [ (L'.EField (gf "SelectExps", x), loc), - sc (" AS " ^ Settings.mangleSql x) + str (" AS " ^ Settings.mangleSql x) ]) sexps @ map (fn (x, xts) => strcatComma (map (fn (x', _) => - sc ("T_" ^ x + str ("T_" ^ x ^ "." ^ Settings.mangleSql x')) xts)) stables), (L'.ECase (gf "From", - [((L'.PPrim (Prim.String ""), loc), - sc ""), + [((L'.PPrim (Prim.String (Prim.Normal, "")), loc), + str ""), ((L'.PVar ("x", s), loc), - strcat [sc " FROM ", + strcat [str " FROM ", (L'.ERel 0, loc)])], {disc = s, result = s}), loc), (L'.ECase (gf "Where", - [((L'.PPrim (Prim.String (#trueString (Settings.currentDbms ()))), + [((L'.PPrim (Prim.String (Prim.Normal, #trueString (Settings.currentDbms ()))), loc), - sc ""), + str ""), ((L'.PWild, loc), - strcat [sc " WHERE ", gf "Where"])], + strcat [str " WHERE ", gf "Where"])], {disc = s, result = s}), loc), @@ -2125,14 +2115,14 @@ List.all (fn (x, _) => List.exists (fn (x', _) => x' = x) xts') xts) tables then - sc "" + str "" else strcat [ - sc " GROUP BY ", + str " GROUP BY ", strcatComma (map (fn (x, xts) => strcatComma (map (fn (x', _) => - sc ("T_" ^ x + str ("T_" ^ x ^ "." ^ Settings.mangleSql x')) xts)) grouped) @@ -2140,10 +2130,10 @@ (L'.ECase (gf "Having", [((L'.PPrim (Prim.String - (#trueString (Settings.currentDbms ()))), loc), - sc ""), + (Prim.Normal, #trueString (Settings.currentDbms ()))), loc), + str ""), ((L'.PWild, loc), - strcat [sc " HAVING ", gf "Having"])], + strcat [str " HAVING ", gf "Having"])], {disc = s, result = s}), loc) ]), loc), @@ -2234,7 +2224,7 @@ s, (L'.ECase ((L'.ERel 0, loc), [((L'.PNone t, loc), - (L'.EPrim (Prim.String "NULL"), loc)), + str "NULL"), ((L'.PSome (t, (L'.PVar ("y", t), loc)), loc), (L'.EApp ((L'.ERel 2, loc), (L'.ERel 0, loc)), loc))], {disc = (L'.TOption t, loc), @@ -2270,7 +2260,7 @@ ((L'.ERecord [], loc), fm) | L.ECApp ((L.EFfi ("Basis", "sql_from_nil"), _), _) => - ((L'.EPrim (Prim.String ""), loc), fm) + (str "", fm) | L.ECApp ((L.EApp ((L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_from_table"), _), _), _), _), _), _), _), _), _), (L.CName name, _)) => @@ -2279,7 +2269,7 @@ in ((L'.EAbs ("tab", s, s, strcat [(L'.ERel 0, loc), - (L'.EPrim (Prim.String (" AS T_" ^ name)), loc)]), loc), + str (" AS T_" ^ name)]), loc), fm) end | L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_from_query"), _), _), @@ -2287,12 +2277,11 @@ (L.CName name, _)) => let val s = (L'.TFfi ("Basis", "string"), loc) - fun sc s = (L'.EPrim (Prim.String s), loc) in ((L'.EAbs ("q", s, s, - strcat [sc "(", + strcat [str "(", (L'.ERel 0, loc), - sc (") AS T_" ^ name)]), loc), + str (") AS T_" ^ name)]), loc), fm) end | L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_from_comma"), _), _), _), _), _), _) => @@ -2303,13 +2292,13 @@ (L'.EAbs ("tab2", s, s, (L'.ECase ((L'.ERecord [("1", (L'.ERel 1, loc), s), ("2", (L'.ERel 0, loc), s)], loc), - [((L'.PRecord [("1", (L'.PPrim (Prim.String ""), loc), s)], loc), + [((L'.PRecord [("1", (L'.PPrim (Prim.String (Prim.Normal, "")), loc), s)], loc), (L'.ERel 0, loc)), - ((L'.PRecord [("2", (L'.PPrim (Prim.String ""), loc), s)], loc), + ((L'.PRecord [("2", (L'.PPrim (Prim.String (Prim.Normal, "")), loc), s)], loc), (L'.ERel 1, loc)), ((L'.PWild, loc), strcat [(L'.ERel 1, loc), - (L'.EPrim (Prim.String ", "), loc), + str ", ", (L'.ERel 0, loc)])], {disc = (L'.TRecord [("1", s), ("2", s)], loc), result = s}), loc)), loc)), loc), @@ -2324,24 +2313,24 @@ (L'.EAbs ("on", s, s, (L'.ECase ((L'.ERecord [("1", (L'.ERel 2, loc), s), ("2", (L'.ERel 1, loc), s)], loc), - [((L'.PRecord [("1", (L'.PPrim (Prim.String ""), loc), s)], loc), + [((L'.PRecord [("1", (L'.PPrim (Prim.String (Prim.Normal, "")), loc), s)], loc), (L'.ERel 1, loc)), - ((L'.PRecord [("2", (L'.PPrim (Prim.String ""), loc), s)], loc), + ((L'.PRecord [("2", (L'.PPrim (Prim.String (Prim.Normal, "")), loc), s)], loc), (L'.ERel 2, loc)), ((L'.PWild, loc), strcat ((if #nestedRelops (Settings.currentDbms ()) then - [(L'.EPrim (Prim.String "("), loc)] + [str "("] else []) @ [(L'.ERel 2, loc), - (L'.EPrim (Prim.String " JOIN "), loc), + str " JOIN ", (L'.ERel 1, loc), - (L'.EPrim (Prim.String " ON "), loc), + str " ON ", (L'.ERel 0, loc)] @ (if #nestedRelops (Settings.currentDbms ()) then - [(L'.EPrim (Prim.String ")"), loc)] + [str ")"] else [])))], {disc = (L'.TRecord [("1", s), ("2", s)], loc), @@ -2360,27 +2349,26 @@ (L'.EAbs ("on", s, s, (L'.ECase ((L'.ERecord [("1", (L'.ERel 2, loc), s), ("2", (L'.ERel 1, loc), s)], loc), - [((L'.PRecord [("1", (L'.PPrim (Prim.String ""), + [((L'.PRecord [("1", (L'.PPrim (Prim.String (Prim.Normal, "")), loc), s)], loc), (L'.ERel 1, loc)), - ((L'.PRecord [("2", (L'.PPrim (Prim.String ""), + ((L'.PRecord [("2", (L'.PPrim (Prim.String (Prim.Normal, "")), loc), s)], loc), (L'.ERel 2, loc)), ((L'.PWild, loc), strcat ((if #nestedRelops (Settings.currentDbms ()) then - [(L'.EPrim (Prim.String "("), loc)] + [str "("] else []) @ [(L'.ERel 2, loc), - (L'.EPrim (Prim.String " LEFT JOIN "), - loc), + str " LEFT JOIN ", (L'.ERel 1, loc), - (L'.EPrim (Prim.String " ON "), loc), + str " ON ", (L'.ERel 0, loc)] @ (if #nestedRelops (Settings.currentDbms ()) then - [(L'.EPrim (Prim.String ")"), loc)] + [str ")"] else [])))], {disc = (L'.TRecord [("1", s), ("2", s)], loc), @@ -2399,27 +2387,26 @@ (L'.EAbs ("on", s, s, (L'.ECase ((L'.ERecord [("1", (L'.ERel 2, loc), s), ("2", (L'.ERel 1, loc), s)], loc), - [((L'.PRecord [("1", (L'.PPrim (Prim.String ""), + [((L'.PRecord [("1", (L'.PPrim (Prim.String (Prim.Normal, "")), loc), s)], loc), (L'.ERel 1, loc)), - ((L'.PRecord [("2", (L'.PPrim (Prim.String ""), + ((L'.PRecord [("2", (L'.PPrim (Prim.String (Prim.Normal, "")), loc), s)], loc), (L'.ERel 2, loc)), ((L'.PWild, loc), strcat ((if #nestedRelops (Settings.currentDbms ()) then - [(L'.EPrim (Prim.String "("), loc)] + [str "("] else []) @ [(L'.ERel 2, loc), - (L'.EPrim (Prim.String " RIGHT JOIN "), - loc), + str " RIGHT JOIN ", (L'.ERel 1, loc), - (L'.EPrim (Prim.String " ON "), loc), + str " ON ", (L'.ERel 0, loc)] @ (if #nestedRelops (Settings.currentDbms ()) then - [(L'.EPrim (Prim.String ")"), loc)] + [str ")"] else [])))], {disc = (L'.TRecord [("1", s), ("2", s)], loc), @@ -2438,27 +2425,26 @@ (L'.EAbs ("on", s, s, (L'.ECase ((L'.ERecord [("1", (L'.ERel 2, loc), s), ("2", (L'.ERel 1, loc), s)], loc), - [((L'.PRecord [("1", (L'.PPrim (Prim.String ""), + [((L'.PRecord [("1", (L'.PPrim (Prim.String (Prim.Normal, "")), loc), s)], loc), (L'.ERel 1, loc)), - ((L'.PRecord [("2", (L'.PPrim (Prim.String ""), + ((L'.PRecord [("2", (L'.PPrim (Prim.String (Prim.Normal, "")), loc), s)], loc), (L'.ERel 2, loc)), ((L'.PWild, loc), strcat ((if #nestedRelops (Settings.currentDbms ()) then - [(L'.EPrim (Prim.String "("), loc)] + [str "("] else []) @ [(L'.ERel 2, loc), - (L'.EPrim (Prim.String " FULL JOIN "), - loc), + str " FULL JOIN ", (L'.ERel 1, loc), - (L'.EPrim (Prim.String " ON "), loc), + str " ON ", (L'.ERel 0, loc)] @ (if #nestedRelops (Settings.currentDbms ()) then - [(L'.EPrim (Prim.String ")"), loc)] + [str ")"] else [])))], {disc = (L'.TRecord [("1", s), ("2", s)], loc), @@ -2467,9 +2453,9 @@ end | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_order_by_Nil"), _), _), _), _) => - ((L'.EPrim (Prim.String ""), loc), fm) + (str "", fm) | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_order_by_random"), _), _), _), _) => - ((L'.EPrim (Prim.String (#randomFunction (Settings.currentDbms ()) ^ "()")), loc), fm) + (str (#randomFunction (Settings.currentDbms ()) ^ "()"), fm) | L.ECApp ( (L.ECApp ( (L.ECApp ( @@ -2481,81 +2467,80 @@ _) => let val s = (L'.TFfi ("Basis", "string"), loc) - fun sc s = (L'.EPrim (Prim.String s), loc) in ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFun (s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc)), loc), (L'.EAbs ("e1", s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc), (L'.EAbs ("d", s, (L'.TFun (s, s), loc), (L'.EAbs ("e2", s, s, (L'.ECase ((L'.ERel 0, loc), - [((L'.PPrim (Prim.String ""), loc), + [((L'.PPrim (Prim.String (Prim.Normal, "")), loc), strcat [(L'.ERel 2, loc), (L'.ERel 1, loc)]), ((L'.PWild, loc), strcat [(L'.ERel 2, loc), (L'.ERel 1, loc), - sc ", ", + str ", ", (L'.ERel 0, loc)])], {disc = s, result = s}), loc)), loc)), loc)), loc)), loc), fm) end | L.EFfi ("Basis", "sql_no_limit") => - ((L'.EPrim (Prim.String ""), loc), fm) + (str "", fm) | L.EFfiApp ("Basis", "sql_limit", [(e, t)]) => let val (e, fm) = monoExp (env, st, fm) e in (strcat [ - (L'.EPrim (Prim.String " LIMIT "), loc), + str " LIMIT ", (L'.EFfiApp ("Basis", "sqlifyInt", [(e, monoType env t)]), loc) ], fm) end | L.EFfi ("Basis", "sql_no_offset") => - ((L'.EPrim (Prim.String ""), loc), fm) + (str "", fm) | L.EFfiApp ("Basis", "sql_offset", [(e, t)]) => let val (e, fm) = monoExp (env, st, fm) e in (strcat [ - (L'.EPrim (Prim.String " OFFSET "), loc), + str " OFFSET ", (L'.EFfiApp ("Basis", "sqlifyInt", [(e, monoType env t)]), loc) ], fm) end | L.ECApp ((L.EFfi ("Basis", "sql_eq"), _), _) => - ((L'.EPrim (Prim.String "="), loc), fm) + (str "=", fm) | L.ECApp ((L.EFfi ("Basis", "sql_ne"), _), _) => - ((L'.EPrim (Prim.String "<>"), loc), fm) + (str "<>", fm) | L.ECApp ((L.EFfi ("Basis", "sql_lt"), _), _) => - ((L'.EPrim (Prim.String "<"), loc), fm) + (str "<", fm) | L.ECApp ((L.EFfi ("Basis", "sql_le"), _), _) => - ((L'.EPrim (Prim.String "<="), loc), fm) + (str "<=", fm) | L.ECApp ((L.EFfi ("Basis", "sql_gt"), _), _) => - ((L'.EPrim (Prim.String ">"), loc), fm) + (str ">", fm) | L.ECApp ((L.EFfi ("Basis", "sql_ge"), _), _) => - ((L'.EPrim (Prim.String ">="), loc), fm) + (str ">=", fm) | L.ECApp ((L.EFfi ("Basis", "sql_plus"), _), _) => ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFfi ("Basis", "string"), loc), - (L'.EPrim (Prim.String "+"), loc)), loc), fm) + str "+"), loc), fm) | L.ECApp ((L.EFfi ("Basis", "sql_minus"), _), _) => ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFfi ("Basis", "string"), loc), - (L'.EPrim (Prim.String "-"), loc)), loc), fm) + str "-"), loc), fm) | L.ECApp ((L.EFfi ("Basis", "sql_times"), _), _) => ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFfi ("Basis", "string"), loc), - (L'.EPrim (Prim.String "*"), loc)), loc), fm) + str "*"), loc), fm) | L.ECApp ((L.EFfi ("Basis", "sql_div"), _), _) => ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFfi ("Basis", "string"), loc), - (L'.EPrim (Prim.String "/"), loc)), loc), fm) + str "/"), loc), fm) | L.EFfi ("Basis", "sql_mod") => - ((L'.EPrim (Prim.String "%"), loc), fm) + (str "%", fm) | L.EFfi ("Basis", "sql_like") => - ((L'.EPrim (Prim.String "LIKE"), loc), fm) + (str "LIKE", fm) | L.ECApp ( (L.ECApp ( @@ -2570,21 +2555,20 @@ _) => let val s = (L'.TFfi ("Basis", "string"), loc) - fun sc s = (L'.EPrim (Prim.String s), loc) in ((L'.EAbs ("c", s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc), (L'.EAbs ("e1", s, (L'.TFun (s, s), loc), - strcat [sc "(", + strcat [str "(", (L'.ERel 1, loc), - sc " ", + str " ", (L'.ERel 0, loc), - sc ")"]), loc)), loc), + str ")"]), loc)), loc), fm) end - | L.EFfi ("Basis", "sql_not") => ((L'.EPrim (Prim.String "NOT"), loc), fm) + | L.EFfi ("Basis", "sql_not") => (str "NOT", fm) | L.ECApp ((L.EFfi ("Basis", "sql_neg"), _), _) => ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFfi ("Basis", "string"), loc), - (L'.EPrim (Prim.String "-"), loc)), loc), fm) + str "-"), loc), fm) | L.ECApp ( (L.ECApp ( @@ -2601,22 +2585,21 @@ _) => let val s = (L'.TFfi ("Basis", "string"), loc) - fun sc s = (L'.EPrim (Prim.String s), loc) in ((L'.EAbs ("c", s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc), (L'.EAbs ("e1", s, (L'.TFun (s, s), loc), (L'.EAbs ("e2", s, s, - strcat [sc "(", + strcat [str "(", (L'.ERel 1, loc), - sc " ", + str " ", (L'.ERel 2, loc), - sc " ", + str " ", (L'.ERel 0, loc), - sc ")"]), loc)), loc)), loc), + str ")"]), loc)), loc)), loc), fm) end - | L.EFfi ("Basis", "sql_and") => ((L'.EPrim (Prim.String "AND"), loc), fm) - | L.EFfi ("Basis", "sql_or") => ((L'.EPrim (Prim.String "OR"), loc), fm) + | L.EFfi ("Basis", "sql_and") => (str "AND", fm) + | L.EFfi ("Basis", "sql_or") => (str "OR", fm) | L.ECApp ( (L.ECApp ( @@ -2632,7 +2615,7 @@ _), _), _), _), (L.CName tab, _)), _), - (L.CName field, _)) => ((L'.EPrim (Prim.String ("T_" ^ tab ^ "." ^ Settings.mangleSql (lowercaseFirst field))), loc), fm) + (L.CName field, _)) => (str ("T_" ^ tab ^ "." ^ Settings.mangleSql (lowercaseFirst field)), fm) | L.ECApp ( (L.ECApp ( @@ -2644,7 +2627,7 @@ _), _), _), _), _), _), - (L.CName nm, _)) => ((L'.EPrim (Prim.String (Settings.mangleSql (lowercaseFirst nm))), loc), fm) + (L.CName nm, _)) => (str (Settings.mangleSql (lowercaseFirst nm)), fm) | L.ECApp ( (L.ECApp ( @@ -2661,49 +2644,48 @@ _) => let val s = (L'.TFfi ("Basis", "string"), loc) - fun sc s = (L'.EPrim (Prim.String s), loc) in (if #nestedRelops (Settings.currentDbms ()) then (L'.EAbs ("c", s, (L'.TFun ((L'.TFfi ("Basis", "bool"), loc), (L'.TFun (s, (L'.TFun (s, s), loc)), loc)), loc), (L'.EAbs ("all", (L'.TFfi ("Basis", "bool"), loc), (L'.TFun (s, (L'.TFun (s, s), loc)), loc), (L'.EAbs ("e1", s, (L'.TFun (s, s), loc), (L'.EAbs ("e2", s, s, - strcat [sc "((", + strcat [str "((", (L'.ERel 1, loc), - sc ") ", + str ") ", (L'.ERel 3, loc), (L'.ECase ((L'.ERel 2, loc), [((L'.PCon (L'.Enum, L'.PConFfi {mod = "Basis", datatyp = "bool", con = "True", arg = NONE}, NONE), loc), - sc " ALL"), + str " ALL"), ((L'.PWild, loc), - sc "")], + str "")], {disc = (L'.TFfi ("Basis", "bool"), loc), result = s}), loc), - sc " (", + str " (", (L'.ERel 0, loc), - sc "))"]), loc)), loc)), loc)), loc) + str "))"]), loc)), loc)), loc)), loc) else (L'.EAbs ("c", s, (L'.TFun ((L'.TFfi ("Basis", "bool"), loc), (L'.TFun (s, (L'.TFun (s, s), loc)), loc)), loc), (L'.EAbs ("all", (L'.TFfi ("Basis", "bool"), loc), (L'.TFun (s, (L'.TFun (s, s), loc)), loc), (L'.EAbs ("e1", s, (L'.TFun (s, s), loc), (L'.EAbs ("e2", s, s, strcat [(L'.ERel 1, loc), - sc " ", + str " ", (L'.ERel 3, loc), (L'.ECase ((L'.ERel 2, loc), [((L'.PCon (L'.Enum, L'.PConFfi {mod = "Basis", datatyp = "bool", con = "True", arg = NONE}, NONE), loc), - sc " ALL"), + str " ALL"), ((L'.PWild, loc), - sc "")], + str "")], {disc = (L'.TFfi ("Basis", "bool"), loc), result = s}), loc), - sc " ", + str " ", (L'.ERel 0, loc)]), loc)), loc)), loc)), loc), fm) end @@ -2720,25 +2702,24 @@ _) => let val s = (L'.TFfi ("Basis", "string"), loc) - fun sc s = (L'.EPrim (Prim.String s), loc) in ((L'.EAbs ("x", s, s, (L'.ERel 0, loc)), loc), fm) end - | L.EFfi ("Basis", "sql_union") => ((L'.EPrim (Prim.String "UNION"), loc), fm) + | L.EFfi ("Basis", "sql_union") => (str "UNION", fm) | L.EFfi ("Basis", "sql_intersect") => (if #onlyUnion (Settings.currentDbms ()) then ErrorMsg.errorAt loc "The DBMS you've selected doesn't support INTERSECT." else (); - ((L'.EPrim (Prim.String "INTERSECT"), loc), fm)) + (str "INTERSECT", fm)) | L.EFfi ("Basis", "sql_except") => (if #onlyUnion (Settings.currentDbms ()) then ErrorMsg.errorAt loc "The DBMS you've selected doesn't support EXCEPT." else (); - ((L'.EPrim (Prim.String "EXCEPT"), loc), fm)) + (str "EXCEPT", fm)) | L.ECApp ( (L.ECApp ( @@ -2746,8 +2727,7 @@ (L.EFfi ("Basis", "sql_count"), _), _), _), _), _), - _) => ((L'.EPrim (Prim.String "COUNT(*)"), loc), - fm) + _) => (str "COUNT(*)", fm) | L.ECApp ( (L.ECApp ( @@ -2762,12 +2742,11 @@ t) => let val s = (L'.TFfi ("Basis", "string"), loc) - fun sc s = (L'.EPrim (Prim.String s), loc) val main = strcat [(L'.ERel 1, loc), - sc "(", + str "(", (L'.ERel 0, loc), - sc ")"] + str ")"] in ((L'.EAbs ("c", s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc), (L'.EAbs ("e1", s, (L'.TFun (s, s), loc), main), loc)), loc), @@ -2775,8 +2754,7 @@ end | L.ECApp ((L.EFfi ("Basis", "sql_count_col"), _), _) => - ((L'.EPrim (Prim.String "COUNT"), loc), - fm) + (str "COUNT", fm) | L.EFfi ("Basis", "sql_summable_int") => ((L'.ERecord [], loc), fm) | L.EFfi ("Basis", "sql_summable_float") => ((L'.ERecord [], loc), fm) @@ -2786,12 +2764,12 @@ fm) | L.ECApp ((L.EFfi ("Basis", "sql_avg"), _), _) => ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFfi ("Basis", "string"), loc), - (L'.EPrim (Prim.String "AVG"), loc)), loc), + str "AVG"), loc), fm) | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_sum"), _), _), _), _) => ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFun ((L'.TRecord [], loc), (L'.TFfi ("Basis", "string"), loc)), loc), (L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFfi ("Basis", "string"), loc), - (L'.EPrim (Prim.String "SUM"), loc)), loc)), loc), + str "SUM"), loc)), loc), fm) | L.EFfi ("Basis", "sql_arith_int") => ((L'.ERecord [], loc), fm) @@ -2811,16 +2789,16 @@ | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_max"), _), _), _), _) => ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFun ((L'.TRecord [], loc), (L'.TFfi ("Basis", "string"), loc)), loc), (L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFfi ("Basis", "string"), loc), - (L'.EPrim (Prim.String "MAX"), loc)), loc)), loc), + str "MAX"), loc)), loc), fm) | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_min"), _), _), _), _) => ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFun ((L'.TRecord [], loc), (L'.TFfi ("Basis", "string"), loc)), loc), (L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFfi ("Basis", "string"), loc), - (L'.EPrim (Prim.String "MIN"), loc)), loc)), loc), + str "MIN"), loc)), loc), fm) - | L.EFfi ("Basis", "sql_asc") => ((L'.EPrim (Prim.String ""), loc), fm) - | L.EFfi ("Basis", "sql_desc") => ((L'.EPrim (Prim.String " DESC"), loc), fm) + | L.EFfi ("Basis", "sql_asc") => (str "", fm) + | L.EFfi ("Basis", "sql_desc") => (str " DESC", fm) | L.ECApp ( (L.ECApp ( (L.ECApp ( @@ -2832,7 +2810,6 @@ _) => let val s = (L'.TFfi ("Basis", "string"), loc) - fun sc s = (L'.EPrim (Prim.String s), loc) in ((L'.EAbs ("s", s, s, (L'.ERel 0, loc)), loc), fm) @@ -2860,7 +2837,7 @@ fm) end - | L.EFfi ("Basis", "sql_current_timestamp") => ((L'.EPrim (Prim.String "CURRENT_TIMESTAMP"), loc), fm) + | L.EFfi ("Basis", "sql_current_timestamp") => (str "CURRENT_TIMESTAMP", fm) | L.ECApp ( (L.ECApp ( @@ -2875,25 +2852,24 @@ _) => let val s = (L'.TFfi ("Basis", "string"), loc) - fun sc s = (L'.EPrim (Prim.String s), loc) in ((L'.EAbs ("f", s, (L'.TFun (s, s), loc), (L'.EAbs ("x", s, s, strcat [(L'.ERel 1, loc), - sc "(", + str "(", (L'.ERel 0, loc), - sc ")"]), loc)), loc), + str ")"]), loc)), loc), fm) end | L.EFfi ("Basis", "sql_octet_length") => - ((L'.EPrim (Prim.String (if #supportsOctetLength (Settings.currentDbms ()) then - "octet_length" - else - "length")), loc), fm) + (str (if #supportsOctetLength (Settings.currentDbms ()) then + "octet_length" + else + "length"), fm) | L.EFfi ("Basis", "sql_lower") => - ((L'.EPrim (Prim.String "lower"), loc), fm) + (str "lower", fm) | L.EFfi ("Basis", "sql_upper") => - ((L'.EPrim (Prim.String "upper"), loc), fm) + (str "upper", fm) | L.ECApp ((L.EFfi ("Basis", "sql_known"), _), _) => ((L'.EFfi ("Basis", "sql_known"), loc), fm) @@ -2907,12 +2883,11 @@ _), _)) => let val s = (L'.TFfi ("Basis", "string"), loc) - fun sc s = (L'.EPrim (Prim.String s), loc) in ((L'.EAbs ("s", s, s, - strcat [sc "(", + strcat [str "(", (L'.ERel 0, loc), - sc " IS NULL)"]), loc), + str " IS NULL)"]), loc), fm) end @@ -2926,15 +2901,14 @@ _), _)) => let val s = (L'.TFfi ("Basis", "string"), loc) - fun sc s = (L'.EPrim (Prim.String s), loc) in ((L'.EAbs ("x1", s, (L'.TFun (s, s), loc), (L'.EAbs ("x1", s, s, - strcat [sc "COALESCE(", + strcat [str "COALESCE(", (L'.ERel 1, loc), - sc ",", + str ",", (L'.ERel 0, loc), - sc ")"]), loc)), loc), + str ")"]), loc)), loc), fm) end @@ -2948,18 +2922,17 @@ _), _)) => let val s = (L'.TFfi ("Basis", "string"), loc) - fun sc s = (L'.EPrim (Prim.String s), loc) in ((L'.EAbs ("if", s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc), (L'.EAbs ("then", s, (L'.TFun (s, s), loc), (L'.EAbs ("else", s, s, - strcat [sc "(CASE WHEN (", + strcat [str "(CASE WHEN (", (L'.ERel 2, loc), - sc ") THEN (", + str ") THEN (", (L'.ERel 1, loc), - sc ") ELSE (", + str ") ELSE (", (L'.ERel 0, loc), - sc ") END)"]), loc)), loc)), loc), + str ") END)"]), loc)), loc)), loc), fm) end @@ -2974,7 +2947,6 @@ _) => let val s = (L'.TFfi ("Basis", "string"), loc) - fun sc s = (L'.EPrim (Prim.String s), loc) in ((L'.EAbs ("u", (L'.TRecord [], loc), (L'.TFun (s, s), loc), (L'.EAbs ("x", s, s, @@ -2997,13 +2969,12 @@ _) => let val s = (L'.TFfi ("Basis", "string"), loc) - fun sc s = (L'.EPrim (Prim.String s), loc) in ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFun (s, s), loc), (L'.EAbs ("x", s, s, - strcat [sc "(", + strcat [str "(", (L'.ERel 0, loc), - sc ")"]), loc)), loc), + str ")"]), loc)), loc), fm) end @@ -3013,7 +2984,7 @@ (L.EFfi ("Basis", "sql_no_partition"), _), _), _), _), _), - _) => ((L'.EPrim (Prim.String ""), loc), fm) + _) => (str "", fm) | L.ECApp ( (L.ECApp ( (L.ECApp ( @@ -3026,7 +2997,7 @@ let val s = (L'.TFfi ("Basis", "string"), loc) in - ((L'.EAbs ("e", s, s, strcat [(L'.EPrim (Prim.String "PARTITION BY "), loc), (L'.ERel 0, loc)]), loc), + ((L'.EAbs ("e", s, s, strcat [str "PARTITION BY ", (L'.ERel 0, loc)]), loc), fm) end @@ -3046,20 +3017,19 @@ ErrorMsg.errorAt loc "The DBMS you've selected doesn't support window functions." val s = (L'.TFfi ("Basis", "string"), loc) - fun sc s = (L'.EPrim (Prim.String s), loc) val main = strcat [(L'.ERel 2, loc), - sc " OVER (", + str " OVER (", (L'.ERel 1, loc), (L'.ECase ((L'.ERel 0, loc), - [((L'.PPrim (Prim.String ""), loc), - sc ""), + [((L'.PPrim (Prim.String (Prim.Normal, "")), loc), + str ""), ((L'.PWild, loc), - strcat [sc " ORDER BY ", + strcat [str " ORDER BY ", (L'.ERel 0, loc)])], {disc = s, result = s}), loc), - sc ")"] + str ")"] in ((L'.EAbs ("w", s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc), (L'.EAbs ("p", s, (L'.TFun (s, s), loc), @@ -3081,12 +3051,11 @@ _) => let val s = (L'.TFfi ("Basis", "string"), loc) - fun sc s = (L'.EPrim (Prim.String s), loc) val main = strcat [(L'.ERel 1, loc), - sc "(", + str "(", (L'.ERel 0, loc), - sc ")"] + str ")"] in ((L'.EAbs ("c", s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc), (L'.EAbs ("e1", s, s, main), loc)), loc), @@ -3094,9 +3063,9 @@ end | L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_window_count"), _), _), _), _), _), _) => - ((L'.EPrim (Prim.String "COUNT(*)"), loc), fm) + (str "COUNT(*)", fm) | L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_rank"), _), _), _), _), _), _) => - ((L'.EPrim (Prim.String "RANK()"), loc), fm) + (str "RANK()", fm) | L.EFfiApp ("Basis", "nextval", [(e, _)]) => let @@ -3112,19 +3081,19 @@ ((L'.ESetval (e1, e2), loc), fm) end - | L.EFfi ("Basis", "null") => ((L'.EPrim (Prim.String ""), loc), fm) + | L.EFfi ("Basis", "null") => (str "", fm) | L.EFfiApp ("Basis", "classes", [(s1, _), (s2, _)]) => let val (s1, fm) = monoExp (env, st, fm) s1 val (s2, fm) = monoExp (env, st, fm) s2 in - ((L'.EStrcat (s1, (L'.EStrcat ((L'.EPrim (Prim.String " "), loc), s2), loc)), loc), + ((L'.EStrcat (s1, (L'.EStrcat (str " ", s2), loc)), loc), fm) end - | L.EFfi ("Basis", "data_kind") => ((L'.EPrim (Prim.String "data-"), loc), fm) - | L.EFfi ("Basis", "aria_kind") => ((L'.EPrim (Prim.String "aria-"), loc), fm) + | L.EFfi ("Basis", "data_kind") => (str "data-", fm) + | L.EFfi ("Basis", "aria_kind") => (str "aria-", fm) | L.EFfiApp ("Basis", "data_attr", [(sk, _), (s1, _), (s2, _)]) => let @@ -3134,9 +3103,9 @@ in ((L'.EStrcat (sk, (L'.EStrcat ((L'.EFfiApp ("Basis", "blessData", [(s1, (L'.TFfi ("Basis", "string"), loc))]), loc), - (L'.EStrcat ((L'.EPrim (Prim.String "=\""), loc), + (L'.EStrcat (str "=\"", (L'.EStrcat ((L'.EFfiApp ("Basis", "attrifyString", [(s2, (L'.TFfi ("Basis", "string"), loc))]), loc), - (L'.EPrim (Prim.String "\""), loc)), loc)), + str "\""), loc)), loc)), loc)), loc), fm) end @@ -3146,7 +3115,7 @@ val (s1, fm) = monoExp (env, st, fm) s1 val (s2, fm) = monoExp (env, st, fm) s2 in - ((L'.EStrcat (s1, (L'.EStrcat ((L'.EPrim (Prim.String " "), loc), s2), loc)), loc), + ((L'.EStrcat (s1, (L'.EStrcat (str " ", s2), loc)), loc), fm) end @@ -3154,9 +3123,9 @@ let val (s, fm) = monoExp (env, st, fm) s in - ((L'.EStrcat ((L'.EPrim (Prim.String "url("), loc), + ((L'.EStrcat (str "url(", (L'.EStrcat ((L'.EFfiApp ("Basis", "css_url", [(s, (L'.TFfi ("Basis", "string"), loc))]), loc), - (L'.EPrim (Prim.String ")"), loc)), loc)), loc), + str ")"), loc)), loc), fm) end @@ -3165,7 +3134,7 @@ val (s, fm) = monoExp (env, st, fm) s in ((L'.EStrcat ((L'.EFfiApp ("Basis", "property", [(s, (L'.TFfi ("Basis", "string"), loc))]), loc), - (L'.EPrim (Prim.String ":"), loc)), loc), + str ":"), loc), fm) end | L.EFfiApp ("Basis", "value", [(s1, _), (s2, _)]) => @@ -3173,17 +3142,17 @@ val (s1, fm) = monoExp (env, st, fm) s1 val (s2, fm) = monoExp (env, st, fm) s2 in - ((L'.EStrcat (s1, (L'.EStrcat ((L'.EPrim (Prim.String " "), loc), s2), loc)), loc), + ((L'.EStrcat (s1, (L'.EStrcat (str " ", s2), loc)), loc), fm) end - | L.EFfi ("Basis", "noStyle") => ((L'.EPrim (Prim.String ""), loc), fm) + | L.EFfi ("Basis", "noStyle") => (str "", fm) | L.EFfiApp ("Basis", "oneProperty", [(s1, _), (s2, _)]) => let val (s1, fm) = monoExp (env, st, fm) s1 val (s2, fm) = monoExp (env, st, fm) s2 in - ((L'.EStrcat (s1, (L'.EStrcat (s2, (L'.EPrim (Prim.String ";"), loc)), loc)), loc), + ((L'.EStrcat (s1, (L'.EStrcat (s2, str ";"), loc)), loc), fm) end @@ -3332,28 +3301,28 @@ fun tagStart tag' = let val t = (L'.TFfi ("Basis", "string"), loc) - val s = (L'.EPrim (Prim.String (String.concat ["<", tag'])), loc) + val s = strH (String.concat ["<", tag']) val s = (L'.EStrcat (s, (L'.ECase (class, - [((L'.PPrim (Prim.String ""), loc), - (L'.EPrim (Prim.String ""), loc)), + [((L'.PPrim (Prim.String (Prim.Normal, "")), loc), + strH ""), ((L'.PVar ("x", t), loc), - (L'.EStrcat ((L'.EPrim (Prim.String " class=\""), loc), + (L'.EStrcat (strH " class=\"", (L'.EStrcat ((L'.ERel 0, loc), - (L'.EPrim (Prim.String "\""), loc)), + strH "\""), loc)), loc))], {disc = t, result = t}), loc)), loc) val s = (L'.EStrcat (s, (L'.ECase (style, - [((L'.PPrim (Prim.String ""), loc), - (L'.EPrim (Prim.String ""), loc)), + [((L'.PPrim (Prim.String (Prim.Normal, "")), loc), + strH ""), ((L'.PVar ("x", t), loc), - (L'.EStrcat ((L'.EPrim (Prim.String " style=\""), loc), + (L'.EStrcat (strH " style=\"", (L'.EStrcat ((L'.ERel 0, loc), - (L'.EPrim (Prim.String "\""), loc)), + strH "\""), loc)), loc))], {disc = t, result = t}), loc)), loc) @@ -3363,7 +3332,7 @@ | (("Data", e, _), (s, fm)) => ((L'.EStrcat (s, (L'.EStrcat ( - (L'.EPrim (Prim.String " "), loc), + strH " ", e), loc)), loc), fm) | ((x, e, t), (s, fm)) => @@ -3380,7 +3349,7 @@ arg = NONE}, NONE), loc), (L'.EStrcat (s, - (L'.EPrim (Prim.String s'), loc)), loc)), + strH s'), loc)), ((L'.PCon (L'.Enum, L'.PConFfi {mod = "Basis", datatyp = "bool", @@ -3409,10 +3378,10 @@ in ((L'.EStrcat (s, (L'.EStrcat ( - (L'.EPrim (Prim.String s'), loc), + strH s', (L'.EStrcat ( (L'.EJavaScript (L'.Attribute, e), loc), - (L'.EPrim (Prim.String ");return false'"), loc)), loc)), + strH ");return false'"), loc)), loc)), loc), fm) end @@ -3438,14 +3407,13 @@ val (e, fm) = fooify env fm (e, t) val e = case (tag, x) of - ("coption", "Value") => (L'.EStrcat ((L'.EPrim (Prim.String "x"), loc), e), loc) + ("coption", "Value") => (L'.EStrcat (strH "x", e), loc) | _ => e in ((L'.EStrcat (s, - (L'.EStrcat ((L'.EPrim (Prim.String xp), loc), + (L'.EStrcat (strH xp, (L'.EStrcat (e, - (L'.EPrim (Prim.String "\""), - loc)), + strH "\""), loc)), loc)), loc), fm) @@ -3454,7 +3422,7 @@ in (if tag = "coption" andalso List.all (fn ("Value", _, _) => false | _ => true) attrs then (L'.EStrcat (s, - (L'.EPrim (Prim.String " value=\"\""), loc)), loc) + strH " value=\"\""), loc) else s, fm) @@ -3467,8 +3435,7 @@ val (ts, fm) = tagStart "input" in ((L'.EStrcat (ts, - (L'.EPrim (Prim.String (" type=\"" ^ typ ^ "\" name=\"" ^ name ^ "\" />")), - loc)), loc), fm) + strH (" type=\"" ^ typ ^ "\" name=\"" ^ name ^ "\" />")), loc), fm) end | _ => (Print.prefaces "Targs" (map (fn t => ("T", CorePrint.p_con env t)) targs); raise Fail "No name passed to input tag") @@ -3488,10 +3455,9 @@ NONE => xml | SOME extra => (L'.EStrcat (extra, xml), loc) in - ((L'.EStrcat ((L'.EStrcat (tagStart, (L'.EPrim (Prim.String ">"), loc)), loc), + ((L'.EStrcat ((L'.EStrcat (tagStart, strH ">"), loc), (L'.EStrcat (xml, - (L'.EPrim (Prim.String (String.concat ["</", tag, ">"])), - loc)), loc)), + strH (String.concat ["</", tag, ">"])), loc)), loc), fm) end @@ -3511,9 +3477,9 @@ (L.ECApp ((L.EFfi ("Basis", "cdata"), _), _), _), _), _), - (L.EPrim (Prim.String s), _)), _), NONE) => + (L.EPrim (Prim.String (_, s)), _)), _), NONE) => if CharVector.all Char.isSpace s andalso isSingleton () then - ((L'.EStrcat (tagStart, (L'.EPrim (Prim.String " />"), loc)), loc), fm) + ((L'.EStrcat (tagStart, strH " />"), loc), fm) else normal () | _ => normal () @@ -3521,7 +3487,7 @@ fun setAttrs jexp = let - val s = (L'.EPrim (Prim.String (String.concat ["<", tag])), loc) + val s = strH (String.concat ["<", tag]) val assgns = List.mapPartial (fn ("Source", _, _) => NONE @@ -3570,12 +3536,12 @@ val t = (L'.TFfi ("Basis", "string"), loc) val setClass = (L'.ECase (class, - [((L'.PPrim (Prim.String ""), loc), + [((L'.PPrim (Prim.String (Prim.Normal, "")), loc), str ""), ((L'.PVar ("x", t), loc), - (L'.EStrcat ((L'.EPrim (Prim.String "d.className=\""), loc), + (L'.EStrcat (strH "d.className=\"", (L'.EStrcat ((L'.ERel 0, loc), - (L'.EPrim (Prim.String "\";"), loc)), loc)), + strH "\";"), loc)), loc))], {disc = (L'.TOption t, loc), result = t}), loc) @@ -3594,14 +3560,14 @@ fun execify e = case e of - NONE => (L'.EPrim (Prim.String ""), loc) + NONE => strH "" | SOME e => let val e = (L'.EApp (e, (L'.ERecord [], loc)), loc) in - (L'.EStrcat ((L'.EPrim (Prim.String "exec("), loc), + (L'.EStrcat (strH "exec(", (L'.EStrcat ((L'.EJavaScript (L'.Attribute, e), loc), - (L'.EPrim (Prim.String ")"), loc)), loc)), loc) + strH ")"), loc)), loc) end fun inTag tag' = case ctxOuter of @@ -3643,10 +3609,10 @@ case attrs of [("Signal", e, _)] => ((L'.EStrcat - ((L'.EPrim (Prim.String ("<script type=\"text/javascript\">dyn(\"" - ^ pnode () ^ "\", execD(")), loc), + (strH ("<script type=\"text/javascript\">dyn(\"" + ^ pnode () ^ "\", execD("), (L'.EStrcat ((L'.EJavaScript (L'.Script, e), loc), - (L'.EPrim (Prim.String ("))</script>")), loc)), loc)), loc), + strH ("))</script>")), loc)), loc), fm) | _ => raise Fail "Monoize: Bad <dyn> attributes" end @@ -3655,9 +3621,9 @@ (case attrs of [("Code", e, _)] => ((L'.EStrcat - ((L'.EPrim (Prim.String ("<script type=\"text/javascript\">active(execD(")), loc), + (strH "<script type=\"text/javascript\">active(execD(", (L'.EStrcat ((L'.EJavaScript (L'.Script, e), loc), - (L'.EPrim (Prim.String ("))</script>")), loc)), loc)), loc), + strH "))</script>"), loc)), loc), fm) | _ => raise Fail "Monoize: Bad <active> attributes") @@ -3665,9 +3631,9 @@ (case attrs of [("Code", e, _)] => ((L'.EStrcat - ((L'.EPrim (Prim.String ("<script type=\"text/javascript\">execF(execD(")), loc), + (strH "<script type=\"text/javascript\">execF(execD(", (L'.EStrcat ((L'.EJavaScript (L'.Script, e), loc), - (L'.EPrim (Prim.String ("))</script>")), loc)), loc)), loc), + strH "))</script>"), loc)), loc), fm) | _ => raise Fail "Monoize: Bad <script> attributes") @@ -3684,8 +3650,8 @@ val (ts, fm) = tagStart "input" in ((L'.EStrcat (ts, - (L'.EPrim (Prim.String (" type=\"text\" name=\"" ^ name ^ "\" />")), - loc)), loc), fm) + strH (" type=\"text\" name=\"" ^ name ^ "\" />")), + loc), fm) end | SOME (_, src, _) => (strcat [str "<script type=\"text/javascript\">inp(exec(", @@ -3705,10 +3671,9 @@ val (xml, fm) = monoExp (env, st, fm) xml in ((L'.EStrcat ((L'.EStrcat (ts, - (L'.EPrim (Prim.String (" name=\"" ^ name ^ "\">")), loc)), loc), + strH (" name=\"" ^ name ^ "\">")), loc), (L'.EStrcat (xml, - (L'.EPrim (Prim.String "</textarea>"), - loc)), loc)), + strH "</textarea>"), loc)), loc), fm) end | _ => (Print.prefaces "Targs" (map (fn t => ("T", CorePrint.p_con env t)) targs); @@ -3728,7 +3693,7 @@ NONE => raise Fail "No name for radioGroup" | SOME name => normal ("input", - SOME (L'.EPrim (Prim.String (" type=\"radio\" name=\"" ^ name ^ "\"")), loc))) + SOME (strH (" type=\"radio\" name=\"" ^ name ^ "\"")))) | "select" => (case targs of @@ -3738,11 +3703,10 @@ val (xml, fm) = monoExp (env, st, fm) xml in ((L'.EStrcat ((L'.EStrcat (ts, - (L'.EPrim (Prim.String (" name=\"" ^ name ^ "\">")), - loc)), loc), + strH (" name=\"" ^ name ^ "\">")), loc), (L'.EStrcat (xml, - (L'.EPrim (Prim.String "</select>"), - loc)), loc)), + strH "</select>"), + loc)), loc), fm) end @@ -3756,7 +3720,7 @@ val (ts, fm) = tagStart "input" in ((L'.EStrcat (ts, - (L'.EPrim (Prim.String " type=\"text\" />"), loc)), + strH " type=\"text\" />"), loc), fm) end | SOME (_, src, _) => @@ -3779,7 +3743,7 @@ val (ts, fm) = tagStart "input type=\"checkbox\"" in ((L'.EStrcat (ts, - (L'.EPrim (Prim.String " />"), loc)), + strH " />"), loc), fm) end | SOME (_, src, _) => @@ -3834,7 +3798,7 @@ val (ts, fm) = tagStart "textarea" in ((L'.EStrcat (ts, - (L'.EPrim (Prim.String " />"), loc)), + strH " />"), loc), fm) end | SOME (_, src, _) => @@ -3957,7 +3921,7 @@ | _ => NotFound val (func, action, fm) = case findSubmit xml of - NotFound => (0, (L'.EPrim (Prim.String ""), loc), fm) + NotFound => (0, strH "", fm) | Error => raise Fail "Not ready for multi-submit lforms yet" | Found (action, actionT) => let @@ -3969,9 +3933,9 @@ val (action, fm) = urlifyExp env fm (action, actionT) in (func, - (L'.EStrcat ((L'.EPrim (Prim.String " action=\""), loc), + (L'.EStrcat (strH " action=\"", (L'.EStrcat (action, - (L'.EPrim (Prim.String "\""), loc)), loc)), loc), + strH "\""), loc)), loc), fm) end @@ -4010,12 +3974,12 @@ val sigName = getSigName () val sigSet = (L'.EFfiApp ("Basis", "sigString", [((L'.ERecord [], loc), (L'.TRecord [], loc))]), loc) - val sigSet = (L'.EStrcat ((L'.EPrim (Prim.String ("<input type=\"hidden\" name=\"" - ^ sigName - ^ "\" value=\"")), loc), + val sigSet = (L'.EStrcat (strH ("<input type=\"hidden\" name=\"" + ^ sigName + ^ "\" value=\""), sigSet), loc) val sigSet = (L'.EStrcat (sigSet, - (L'.EPrim (Prim.String "\" />"), loc)), loc) + strH "\" />"), loc) in (L'.EStrcat (sigSet, xml), loc) end @@ -4024,7 +3988,7 @@ val action = if hasUpload then (L'.EStrcat (action, - (L'.EPrim (Prim.String " enctype=\"multipart/form-data\""), loc)), loc) + strH " enctype=\"multipart/form-data\""), loc) else action @@ -4033,19 +3997,19 @@ val action = (L'.EStrcat (action, (L'.ECase (class, [((L'.PNone stt, loc), - (L'.EPrim (Prim.String ""), loc)), + strH ""), ((L'.PSome (stt, (L'.PVar ("x", stt), loc)), loc), - (L'.EStrcat ((L'.EPrim (Prim.String " class=\""), loc), + (L'.EStrcat (strH " class=\"", (L'.EStrcat ((L'.ERel 0, loc), - (L'.EPrim (Prim.String "\""), loc)), loc)), loc))], + strH "\""), loc)), loc))], {disc = (L'.TOption stt, loc), result = stt}), loc)), loc) in - ((L'.EStrcat ((L'.EStrcat ((L'.EPrim (Prim.String "<form method=\"post\""), loc), + ((L'.EStrcat ((L'.EStrcat (strH "<form method=\"post\"", (L'.EStrcat (action, - (L'.EPrim (Prim.String ">"), loc)), loc)), loc), + strH ">"), loc)), loc), (L'.EStrcat (xml, - (L'.EPrim (Prim.String "</form>"), loc)), loc)), loc), + strH "</form>"), loc)), loc), fm) end @@ -4056,10 +4020,10 @@ val s = (L'.TFfi ("Basis", "string"), loc) in ((L'.EAbs ("xml", s, s, - strcat [(L'.EPrim (Prim.String ("<input type=\"hidden\" name=\".b\" value=\"" - ^ nm ^ "\" />")), loc), + strcat [strH ("<input type=\"hidden\" name=\".b\" value=\"" + ^ nm ^ "\" />"), (L'.ERel 0, loc), - (L'.EPrim (Prim.String ("<input type=\"hidden\" name=\".e\" value=\"1\" />")), loc)]), + strH ("<input type=\"hidden\" name=\".e\" value=\"1\" />")]), loc), fm) end @@ -4071,10 +4035,10 @@ val s = (L'.TFfi ("Basis", "string"), loc) in ((L'.EAbs ("xml", s, s, - strcat [(L'.EPrim (Prim.String ("<input type=\"hidden\" name=\".s\" value=\"" - ^ nm ^ "\" />")), loc), + strcat [strH ("<input type=\"hidden\" name=\".s\" value=\"" + ^ nm ^ "\" />"), (L'.ERel 0, loc), - (L'.EPrim (Prim.String ("<input type=\"hidden\" name=\".e\" value=\"1\" />")), loc)]), + strH ("<input type=\"hidden\" name=\".e\" value=\"1\" />")]), loc), fm) end @@ -4085,9 +4049,9 @@ val s = (L'.TFfi ("Basis", "string"), loc) in ((L'.EAbs ("xml", s, s, - strcat [(L'.EPrim (Prim.String ("<input type=\"hidden\" name=\".i\" value=\"1\" />")), loc), + strcat [strH ("<input type=\"hidden\" name=\".i\" value=\"1\" />"), (L'.ERel 0, loc), - (L'.EPrim (Prim.String ("<input type=\"hidden\" name=\".e\" value=\"1\" />")), loc)]), + strH ("<input type=\"hidden\" name=\".e\" value=\"1\" />")]), loc), fm) end @@ -4175,7 +4139,7 @@ val (e, fm) = monoExp (env, st, fm) e val (e, fm) = urlifyExp env fm (e, dummyTyp) in - ((L'.EStrcat ((L'.EPrim (Prim.String (Settings.getUrlPrePrefix ())), loc), e), loc), fm) + ((L'.EStrcat (str (Settings.getUrlPrePrefix ()), e), loc), fm) end | L.EApp (e1, e2) => @@ -4296,14 +4260,14 @@ val (e, fm) = urlifyExp env fm (e, monoType env dom) in encodeArgs (es, ran, e - :: (L'.EPrim (Prim.String "/"), loc) + :: str "/" :: acc, fm) end | _ => raise Fail "Monoize: Not enough arguments visible in RPC function type" val (call, fm) = encodeArgs (es, ft, [], fm) val call = foldl (fn (e, call) => (L'.EStrcat (call, e), loc)) - (L'.EPrim (Prim.String name), loc) call + (str name) call val unit = (L'.TRecord [], loc) @@ -4329,6 +4293,9 @@ (E.errorAt loc "Unsupported declaration"; Print.eprefaces' [("Declaration", CorePrint.p_decl env all)]; NONE) + + fun str s = (L'.EPrim (Prim.String (Prim.Normal, s)), loc) + fun strH s = (L'.EPrim (Prim.String (Prim.Html, s)), loc) in case d of L.DCon _ => NONE @@ -4426,7 +4393,7 @@ val t = (L.CFfi ("Basis", "string"), loc) val t' = (L'.TFfi ("Basis", "string"), loc) val s = Settings.mangleSqlTable s - val e_name = (L'.EPrim (Prim.String s), loc) + val e_name = str s val xts = map (fn (x, t) => (monoName env x, monoType env t)) xts @@ -4444,7 +4411,7 @@ val t = (L.CFfi ("Basis", "string"), loc) val t' = (L'.TFfi ("Basis", "string"), loc) val s = Settings.mangleSqlTable s - val e_name = (L'.EPrim (Prim.String s), loc) + val e_name = str s val xts = map (fn (x, t) => (monoName env x, monoType env t)) xts @@ -4462,7 +4429,7 @@ val t = (L.CFfi ("Basis", "string"), loc) val t' = (L'.TFfi ("Basis", "string"), loc) val s = Settings.mangleSql s - val e = (L'.EPrim (Prim.String s), loc) + val e = str s in SOME (Env.pushENamed env x n t NONE s, fm, @@ -4474,7 +4441,7 @@ let val t = (L.CFfi ("Basis", "string"), loc) val t' = (L'.TFfi ("Basis", "string"), loc) - val e = (L'.EPrim (Prim.String s), loc) + val e = str s in SOME (Env.pushENamed env x n t NONE s, fm, @@ -4485,7 +4452,7 @@ let val t = (L.CFfi ("Basis", "string"), loc) val t' = (L'.TFfi ("Basis", "string"), loc) - val e = (L'.EPrim (Prim.String s), loc) + val e = strH s in SOME (Env.pushENamed env x n t NONE s, fm, @@ -4581,6 +4548,9 @@ val client = (L'.TFfi ("Basis", "client"), loc) val unit = (L'.TRecord [], loc) + fun str s = (L'.EPrim (Prim.String (Prim.Normal, s)), loc) + fun strH s = (L'.EPrim (Prim.String (Prim.Html, s)), loc) + fun calcClientish xts = foldl (fn ((x : L.con, t : L.con), st as (nullable, notNullable)) => case #1 x of @@ -4610,22 +4580,22 @@ val (nullable, notNullable) = calcClientish xts fun cond (x, v) = - (L'.EStrcat ((L'.EPrim (Prim.String (Settings.mangleSql x - ^ (case v of - Client => "" - | Channel => " >> 32") - ^ " = ")), loc), + (L'.EStrcat (str (Settings.mangleSql x + ^ (case v of + Client => "" + | Channel => " >> 32") + ^ " = "), target), loc) val e = foldl (fn ((x, v), e) => (L'.ESeq ( (L'.EDml ((L'.EStrcat ( - (L'.EPrim (Prim.String ("UPDATE " - ^ Settings.mangleSql tab - ^ " SET " - ^ Settings.mangleSql x - ^ " = NULL WHERE ")), loc), + str ("UPDATE " + ^ Settings.mangleSql tab + ^ " SET " + ^ Settings.mangleSql x + ^ " = NULL WHERE "), cond (x, v)), loc), L'.Error), loc), e), loc)) e nullable @@ -4638,12 +4608,11 @@ (L'.EDml (foldl (fn (eb, s) => (L'.EStrcat (s, - (L'.EStrcat ((L'.EPrim (Prim.String " OR "), - loc), + (L'.EStrcat (str " OR ", cond eb), loc)), loc)) - (L'.EStrcat ((L'.EPrim (Prim.String ("DELETE FROM " - ^ Settings.mangleSql tab - ^ " WHERE ")), loc), + (L'.EStrcat (str ("DELETE FROM " + ^ Settings.mangleSql tab + ^ " WHERE "), cond eb), loc) ebs, L'.Error), loc), e), loc) @@ -4673,15 +4642,15 @@ [] => e | (x, _) :: ebs => (L'.ESeq ( - (L'.EDml ((L'.EPrim (Prim.String - (foldl (fn ((x, _), s) => - s ^ ", " ^ Settings.mangleSql x ^ " = NULL") - ("UPDATE uw_" - ^ tab - ^ " SET " - ^ Settings.mangleSql x + (L'.EDml (str + (foldl (fn ((x, _), s) => + s ^ ", " ^ Settings.mangleSql x ^ " = NULL") + ("UPDATE uw_" + ^ tab + ^ " SET " + ^ Settings.mangleSql x ^ " = NULL") - ebs)), loc), L'.Error), loc), + ebs), L'.Error), loc), e), loc) val e = @@ -4689,8 +4658,8 @@ [] => e | eb :: ebs => (L'.ESeq ( - (L'.EDml ((L'.EPrim (Prim.String ("DELETE FROM " - ^ Settings.mangleSql tab)), loc), L'.Error), loc), + (L'.EDml (str ("DELETE FROM " + ^ Settings.mangleSql tab), L'.Error), loc), e), loc) in e
--- a/src/pathcheck.sml Fri Aug 01 11:43:44 2014 -0400 +++ b/src/pathcheck.sml Fri Aug 01 15:44:17 2014 -0400 @@ -88,7 +88,7 @@ val rels = #2 (doRel s) val rels = case #1 pe of - EPrim (Prim.String "") => rels + EPrim (Prim.String (_, "")) => rels | _ => let val s' = s ^ "_Pkey"
--- a/src/prepare.sml Fri Aug 01 11:43:44 2014 -0400 +++ b/src/prepare.sml Fri Aug 01 15:44:17 2014 -0400 @@ -65,7 +65,7 @@ SOME (#p_blank (Settings.currentDbms ()) (n + 1, t) :: ss, n + 1) in case #1 e of - EPrim (Prim.String s) => + EPrim (Prim.String (_, s)) => SOME (s :: ss, n) | EFfiApp ("Basis", "strcat", [(e1, _), (e2, _)]) => (case prepString' (e1, ss, n) of @@ -82,16 +82,16 @@ | ECase (e, [((PNone _, _), - (EPrim (Prim.String "NULL"), _)), + (EPrim (Prim.String (_, "NULL")), _)), ((PSome (_, (PVar _, _)), _), (EFfiApp (m, x, [((ERel 0, _), _)]), _))], {disc = t, ...}) => prepString' ((EFfiApp (m, x, [(e, t)]), #2 e), ss, n) | ECase (e, [((PCon (_, PConFfi {mod = "Basis", con = "True", ...}, _), _), - (EPrim (Prim.String "TRUE"), _)), + (EPrim (Prim.String (_, "TRUE")), _)), ((PCon (_, PConFfi {mod = "Basis", con = "False", ...}, _), _), - (EPrim (Prim.String "FALSE"), _))], + (EPrim (Prim.String (_, "FALSE")), _))], _) => doOne Bool | _ => NONE @@ -268,14 +268,14 @@ if #supportsNextval (Settings.currentDbms ()) then let val s = case seq of - (EPrim (Prim.String s), loc) => - (EPrim (Prim.String ("SELECT NEXTVAL('" ^ s ^ "')")), loc) + (EPrim (Prim.String (_, s)), loc) => + (EPrim (Prim.String (Prim.Normal, "SELECT NEXTVAL('" ^ s ^ "')")), loc) | _ => let val t = (TFfi ("Basis", "string"), loc) - val s' = (EFfiApp ("Basis", "strcat", [(seq, t), ((EPrim (Prim.String "')"), loc), t)]), loc) + val s' = (EFfiApp ("Basis", "strcat", [(seq, t), ((EPrim (Prim.String (Prim.Normal, "')")), loc), t)]), loc) in - (EFfiApp ("Basis", "strcat", [((EPrim (Prim.String "SELECT NEXTVAL('"), loc), t), (s', t)]), loc) + (EFfiApp ("Basis", "strcat", [((EPrim (Prim.String (Prim.Normal, "SELECT NEXTVAL('")), loc), t), (s', t)]), loc) end in case prepString (s, st) of
--- a/src/prim.sig Fri Aug 01 11:43:44 2014 -0400 +++ b/src/prim.sig Fri Aug 01 15:44:17 2014 -0400 @@ -1,4 +1,4 @@ -(* Copyright (c) 2008, Adam Chlipala +(* Copyright (c) 2008, 2014, Adam Chlipala * All rights reserved. * * Redistribution and use in source and binary forms, with or without @@ -27,10 +27,12 @@ signature PRIM = sig + datatype string_mode = Normal | Html + datatype t = Int of Int64.int | Float of Real64.real - | String of string + | String of string_mode * string | Char of char val p_t : t Print.printer
--- a/src/prim.sml Fri Aug 01 11:43:44 2014 -0400 +++ b/src/prim.sml Fri Aug 01 15:44:17 2014 -0400 @@ -1,4 +1,4 @@ -(* Copyright (c) 2008, Adam Chlipala +(* Copyright (c) 2008, 2014, Adam Chlipala * All rights reserved. * * Redistribution and use in source and binary forms, with or without @@ -27,10 +27,12 @@ structure Prim :> PRIM = struct +datatype string_mode = Normal | Html + datatype t = Int of Int64.int | Float of Real64.real - | String of string + | String of string_mode * string | Char of char open Print.PD @@ -40,7 +42,7 @@ case t of Int n => string (Int64.toString n) | Float n => string (Real64.toString n) - | String s => box [string "\"", string (String.toString s), string "\""] + | String (_, s) => box [string "\"", string (String.toString s), string "\""] | Char ch => box [string "#\"", string (String.toString (String.str ch)), string "\""] fun int2s n = @@ -61,7 +63,7 @@ case t of Int n => int2s' n | Float n => float2s n - | String s => s + | String (_, s) => s | Char ch => str ch fun pad (n, ch, s) = @@ -86,14 +88,14 @@ case t of Int n => string (int2s n) | Float n => string (float2s n) - | String s => box [string "\"", string (toCString s), string "\""] + | String (_, s) => box [string "\"", string (toCString s), string "\""] | Char ch => box [string "'", string (toCChar ch), string "'"] fun equal x = case x of (Int n1, Int n2) => n1 = n2 | (Float n1, Float n2) => Real64.== (n1, n2) - | (String s1, String s2) => s1 = s2 + | (String (_, s1), String (_, s2)) => s1 = s2 | (Char ch1, Char ch2) => ch1 = ch2 | _ => false @@ -108,7 +110,7 @@ | (Float _, _) => LESS | (_, Float _) => GREATER - | (String n1, String n2) => String.compare (n1, n2) + | (String (_, n1), String (_, n2)) => String.compare (n1, n2) | (String _, _) => LESS | (_, String _) => GREATER
--- a/src/shake.sml Fri Aug 01 11:43:44 2014 -0400 +++ b/src/shake.sml Fri Aug 01 15:44:17 2014 -0400 @@ -44,7 +44,7 @@ } val dummyt = (TRecord (CRecord ((KType, ErrorMsg.dummySpan), []), ErrorMsg.dummySpan), ErrorMsg.dummySpan) -val dummye = (EPrim (Prim.String ""), ErrorMsg.dummySpan) +val dummye = (EPrim (Prim.String (Prim.Normal, "")), ErrorMsg.dummySpan) fun tupleC cs = (CTuple cs, ErrorMsg.dummySpan) fun tupleE es = (ERecord (map (fn e => (dummyt, e, dummyt)) es), ErrorMsg.dummySpan)
--- a/src/sql.sml Fri Aug 01 11:43:44 2014 -0400 +++ b/src/sql.sml Fri Aug 01 15:44:17 2014 -0400 @@ -47,7 +47,7 @@ fun chunkify e = case #1 e of - EPrim (Prim.String s) => [String s] + EPrim (Prim.String (_, s)) => [String s] | EStrcat (e1, e2) => let val chs1 = chunkify e1 @@ -248,7 +248,7 @@ (Option.map Prim.Int o Int64.fromString)) (opt (const "::int8"))) #1, wrap (follow (opt (const "E")) (follow string (opt (const "::text")))) - (Prim.String o #1 o #2)] + ((fn s => Prim.String (Prim.Normal, s)) o #1 o #2)] fun known' chs = case chs of @@ -263,9 +263,9 @@ else NONE | Exp (ECase (e, [((PCon (_, PConFfi {mod = "Basis", con = "True", ...}, NONE), _), - (EPrim (Prim.String "TRUE"), _)), + (EPrim (Prim.String (Prim.Normal, "TRUE")), _)), ((PCon (_, PConFfi {mod = "Basis", con = "False", ...}, NONE), _), - (EPrim (Prim.String "FALSE"), _))], _), _) :: chs => + (EPrim (Prim.String (Prim.Normal, "FALSE")), _))], _), _) :: chs => SOME (e, chs) | _ => NONE
--- a/src/urweb.grm Fri Aug 01 11:43:44 2014 -0400 +++ b/src/urweb.grm Fri Aug 01 15:44:17 2014 -0400 @@ -282,11 +282,11 @@ in (EApp ((EVar (["Basis"], "css_url", Infer), pos), (EApp ((EVar (["Basis"], "bless", Infer), pos), - (EPrim (Prim.String s), pos)), pos)), pos) + (EPrim (Prim.String (Prim.Normal, s)), pos)), pos)), pos) end else (EApp ((EVar (["Basis"], "atom", Infer), pos), - (EPrim (Prim.String s), pos)), pos) + (EPrim (Prim.String (Prim.Normal, s)), pos)), pos) fun parseProperty s pos = let @@ -294,11 +294,11 @@ in if Substring.isEmpty after then (ErrorMsg.errorAt pos ("Invalid CSS property syntax: " ^ s); - (EPrim (Prim.String ""), pos)) + (EPrim (Prim.String (Prim.Normal, "")), pos)) else foldl (fn (value, e) => (EApp ((EApp ((EVar (["Basis"], "value", Infer), pos), e), pos), parseValue value pos), pos)) (EApp ((EVar (["Basis"], "property", Infer), pos), - (EPrim (Prim.String (Substring.string (#2 (Substring.splitl Char.isSpace befor)))), pos)), pos) + (EPrim (Prim.String (Prim.Normal, Substring.string (#2 (Substring.splitl Char.isSpace befor)))), pos)), pos) (String.tokens Char.isSpace (Substring.string (Substring.slice (after, 1, NONE)))) end @@ -1152,8 +1152,8 @@ | eapps BANG (EDisjointApp eapps, s (eappsleft, BANGright)) eexp : eapps (case #1 eapps of - EApp ((EVar ([], "CLASS", _), _), (EPrim (Prim.String s), loc)) => parseClass s loc - | EApp ((EVar ([], "STYLE", _), _), (EPrim (Prim.String s), loc)) => parseStyle s loc + EApp ((EVar ([], "CLASS", _), _), (EPrim (Prim.String (_, s)), loc)) => parseClass s loc + | EApp ((EVar ([], "STYLE", _), _), (EPrim (Prim.String (_, s)), loc)) => parseStyle s loc | _ => eapps) | FN eargs DARROW eexp (let val loc = s (FNleft, eexpright) @@ -1347,7 +1347,7 @@ | INT (EPrim (Prim.Int INT), s (INTleft, INTright)) | FLOAT (EPrim (Prim.Float FLOAT), s (FLOATleft, FLOATright)) - | STRING (EPrim (Prim.String STRING), s (STRINGleft, STRINGright)) + | STRING (EPrim (Prim.String (Prim.Normal, STRING)), s (STRINGleft, STRINGright)) | CHAR (EPrim (Prim.Char CHAR), s (CHARleft, CHARright)) | path DOT idents (let @@ -1396,7 +1396,7 @@ else ErrorMsg.errorAt loc "Initial XML tag pair aren't both tagged \"xml\"."; (EApp ((EVar (["Basis"], "cdata", Infer), loc), - (EPrim (Prim.String ""), loc)), + (EPrim (Prim.String (Prim.Html, "")), loc)), loc) end) | XML_BEGIN_END (let @@ -1407,7 +1407,7 @@ else ErrorMsg.errorAt loc "Initial XML tag pair aren't both tagged \"xml\"."; (EApp ((EVar (["Basis"], "cdata", Infer), loc), - (EPrim (Prim.String ""), loc)), + (EPrim (Prim.String (Prim.Html, "")), loc)), loc) end) @@ -1511,7 +1511,7 @@ | UNDER (PWild, s (UNDERleft, UNDERright)) | INT (PPrim (Prim.Int INT), s (INTleft, INTright)) | MINUS INT (PPrim (Prim.Int (~INT)), s (MINUSleft, INTright)) - | STRING (PPrim (Prim.String STRING), s (STRINGleft, STRINGright)) + | STRING (PPrim (Prim.String (Prim.Normal, STRING)), s (STRINGleft, STRINGright)) | CHAR (PPrim (Prim.Char CHAR), s (CHARleft, CHARright)) | LPAREN pat RPAREN (pat) | LBRACE RBRACE (PRecord ([], false), s (LBRACEleft, RBRACEright)) @@ -1547,11 +1547,11 @@ xmlOpt : xml (xml) | (EApp ((EVar (["Basis"], "cdata", Infer), dummy), - (EPrim (Prim.String ""), dummy)), + (EPrim (Prim.String (Prim.Html, "")), dummy)), dummy) xmlOne : NOTAGS (EApp ((EVar (["Basis"], "cdata", Infer), s (NOTAGSleft, NOTAGSright)), - (EPrim (Prim.String NOTAGS), s (NOTAGSleft, NOTAGSright))), + (EPrim (Prim.String (Prim.Html, NOTAGS)), s (NOTAGSleft, NOTAGSright))), s (NOTAGSleft, NOTAGSright)) | tag DIVIDE GT (let val pos = s (tagleft, GTright) @@ -1568,7 +1568,7 @@ (EVar (["Basis"], "cdata", Infer), pos) val cdata = (EApp (cdata, - (EPrim (Prim.String ""), pos)), + (EPrim (Prim.String (Prim.Html, "")), pos)), pos) in (EApp (#4 tag, cdata), pos) @@ -1629,7 +1629,7 @@ val e = (EVar (["Basis"], "tag", Infer), pos) val eo = case #1 attrs of NONE => (EVar (["Basis"], "null", Infer), pos) - | SOME (EPrim (Prim.String s), pos) => parseClass s pos + | SOME (EPrim (Prim.String (_, s)), pos) => parseClass s pos | SOME e => e val e = (EApp (e, eo), pos) val eo = case #2 attrs of @@ -1639,7 +1639,7 @@ val e = (EApp (e, eo), pos) val eo = case #3 attrs of NONE => (EVar (["Basis"], "noStyle", Infer), pos) - | SOME (EPrim (Prim.String s), pos) => parseStyle s pos + | SOME (EPrim (Prim.String (_, s)), pos) => parseStyle s pos | SOME e => e val e = (EApp (e, eo), pos) val eo = case #4 attrs of @@ -1656,7 +1656,7 @@ let val e = (EVar (["Basis"], "data_attr", Infer), pos) val e = (EApp (e, (EVar (["Basis"], kind ^ "_kind", Infer), pos)), pos) - val e = (EApp (e, (EPrim (Prim.String name), pos)), pos) + val e = (EApp (e, (EPrim (Prim.String (Prim.Normal, name)), pos)), pos) in (EApp (e, value), pos) end @@ -1750,7 +1750,7 @@ attrv : INT (EPrim (Prim.Int INT), s (INTleft, INTright)) | FLOAT (EPrim (Prim.Float FLOAT), s (FLOATleft, FLOATright)) - | STRING (EPrim (Prim.String STRING), s (STRINGleft, STRINGright)) + | STRING (EPrim (Prim.String (Prim.Normal, STRING)), s (STRINGleft, STRINGright)) | LBRACE eexp RBRACE (eexp) query : query1 obopt lopt ofopt (let @@ -2038,7 +2038,7 @@ s (INTleft, INTright))) | FLOAT (sql_inject (EPrim (Prim.Float FLOAT), s (FLOATleft, FLOATright))) - | STRING (sql_inject (EPrim (Prim.String STRING), + | STRING (sql_inject (EPrim (Prim.String (Prim.Normal, STRING)), s (STRINGleft, STRINGright))) | CURRENT_TIMESTAMP (sql_nfunc ("current_timestamp", s (CURRENT_TIMESTAMPleft, CURRENT_TIMESTAMPright)))