# HG changeset patch # User Adam Chlipala # Date 1406922257 14400 # Node ID 4d64af730e353bed2ee9da3427ee4c66887deb69 # Parent 6be31671911b3b7db21a773c51769baa409dda71 Differentiate between HTML and normal string literals diff -r 6be31671911b -r 4d64af730e35 src/cjr_print.sml --- 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, diff -r 6be31671911b -r 4d64af730e35 src/cjrize.sml --- 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)]; diff -r 6be31671911b -r 4d64af730e35 src/iflow.sml --- 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] diff -r 6be31671911b -r 4d64af730e35 src/jscomp.sml --- 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 = " if inString {needle = " (); (e, st)) | ERel _ => (e, st) diff -r 6be31671911b -r 4d64af730e35 src/mono_opt.sml --- 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]), _), _)]) => diff -r 6be31671911b -r 4d64af730e35 src/mono_reduce.sml --- 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)) diff -r 6be31671911b -r 4d64af730e35 src/monoize.sml --- 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 [""])), - loc)), loc)), + strH (String.concat [""])), 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 ("")), loc)), loc)), loc), + strH ("))")), loc)), loc), fm) | _ => raise Fail "Monoize: Bad attributes" end @@ -3655,9 +3621,9 @@ (case attrs of [("Code", e, _)] => ((L'.EStrcat - ((L'.EPrim (Prim.String ("")), loc)), loc)), loc), + strH "))"), loc)), loc), fm) | _ => raise Fail "Monoize: Bad attributes") @@ -3665,9 +3631,9 @@ (case attrs of [("Code", e, _)] => ((L'.EStrcat - ((L'.EPrim (Prim.String ("")), loc)), loc)), loc), + strH "))"), loc)), loc), fm) | _ => raise Fail "Monoize: Bad