summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adam@chlipala.net>2014-08-01 15:44:17 -0400
committerGravatar Adam Chlipala <adam@chlipala.net>2014-08-01 15:44:17 -0400
commit1816e4664bfa4b10cfdb9d10a871343acb250f83 (patch)
tree76d0a9801c5ad0dc1e08f11635a8c2010926586b /src
parent32aa8589761b58e24715818a7b3af73d69055b27 (diff)
Differentiate between HTML and normal string literals
Diffstat (limited to 'src')
-rw-r--r--src/cjr_print.sml16
-rw-r--r--src/cjrize.sml10
-rw-r--r--src/iflow.sml18
-rw-r--r--src/jscomp.sml18
-rw-r--r--src/mono_opt.sml186
-rw-r--r--src/mono_reduce.sml10
-rw-r--r--src/monoize.sml707
-rw-r--r--src/pathcheck.sml2
-rw-r--r--src/prepare.sml16
-rw-r--r--src/prim.sig6
-rw-r--r--src/prim.sml16
-rw-r--r--src/shake.sml2
-rw-r--r--src/sql.sml8
-rw-r--r--src/urweb.grm36
14 files changed, 516 insertions, 535 deletions
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index 9046acc8..a4cc8c54 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -203,10 +203,10 @@ fun p_patMatch (env, disc) (p, loc) =
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 @@ fun getPargs (e, _) =
| 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 @@ and p_exp' par tail env (e, loc) =
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 --git a/src/cjrize.sml b/src/cjrize.sml
index d153feff..6dc0299c 100644
--- a/src/cjrize.sml
+++ b/src/cjrize.sml
@@ -242,7 +242,7 @@ fun cifyExp (eAll as (e, loc), sm) =
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 cifyDecl ((d, loc), sm) =
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 @@ fun cifyDecl ((d, loc), sm) =
[])
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 cifyDecl ((d, loc), sm) =
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 @@ fun cifyDecl ((d, loc), sm) =
[])
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 --git a/src/iflow.sml b/src/iflow.sml
index 461dc956..40cf8993 100644
--- a/src/iflow.sml
+++ b/src/iflow.sml
@@ -1446,7 +1446,7 @@ fun evalExp env (e as (_, loc)) k =
case es of
[_, (cname, _), _, _, _] =>
(case #1 cname of
- EPrim (Prim.String cname) =>
+ EPrim (Prim.String (_, cname)) =>
St.havocCookie cname
| _ => ())
| _ => ()
@@ -1637,7 +1637,7 @@ fun evalExp env (e as (_, loc)) k =
| 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 @@ fun evalExp env (e as (_, loc)) k =
handle Cc.Contradiction => ())
end)
- | ENextval (EPrim (Prim.String seq), _) =>
+ | ENextval (EPrim (Prim.String (_, seq)), _) =>
let
val nv = St.nextVar ()
in
@@ -1775,7 +1775,7 @@ fun evalExp env (e as (_, loc)) k =
| 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 @@ fun nameSubexps k (e : Mono.exp) =
(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 @@ fun check (file : file) =
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 @@ fun check (file : file) =
| 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 @@ fun check (file : file) =
| _ => 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 --git a/src/jscomp.sml b/src/jscomp.sml
index bcabed0b..1a476739 100644
--- a/src/jscomp.sml
+++ b/src/jscomp.sml
@@ -55,7 +55,7 @@ type state = {
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 @@ fun process (file : file) =
| (_, 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 @@ fun process (file : file) =
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 @@ fun process (file : file) =
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 process (file : file) =
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 @@ fun process (file : file) =
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)
diff --git a/src/mono_opt.sml b/src/mono_opt.sml
index ae306e68..d1e5ce55 100644
--- a/src/mono_opt.sml
+++ b/src/mono_opt.sml
@@ -145,7 +145,7 @@ fun checkProperty s = size s > 0
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 @@ fun exp e =
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 @@ fun exp e =
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 @@ fun exp e =
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 @@ fun exp e =
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 @@ fun exp e =
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 @@ fun exp e =
| 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 @@ fun exp e =
| 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 @@ fun exp e =
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 @@ fun exp e =
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 @@ fun exp e =
| 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 @@ fun exp e =
#"_" :: 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 @@ fun exp e =
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 @@ fun exp e =
(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 @@ fun exp e =
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 --git a/src/mono_reduce.sml b/src/mono_reduce.sml
index 98e81185..f1a6758d 100644
--- a/src/mono_reduce.sml
+++ b/src/mono_reduce.sml
@@ -190,13 +190,13 @@ fun match (env, p : pat, e : exp) =
(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 @@ fun reduce (file : file) =
| 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 --git a/src/monoize.sml b/src/monoize.sml
index 9182c077..a1f97184 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -515,7 +515,7 @@ fun fooifyExp fk env =
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 @@ fun fooifyExp fk env =
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 @@ fun fooifyExp fk env =
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 @@ fun fooifyExp fk env =
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 @@ fun fooifyExp fk env =
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 @@ fun fooifyExp fk env =
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 monoPat env (all as (p, loc)) =
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 strcat loc es =
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 @@ fun strcatComma loc es =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
((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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
((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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
| 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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
((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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
((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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
| 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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
| 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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
("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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
(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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
((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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
(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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
(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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
(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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
(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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
(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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
(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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
_) =>
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
_) =>
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
_) =>
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
_), _),
_), _),
(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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
_), _),
_), _),
_), _),
- (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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
_) =>
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
_) =>
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
(L.EFfi ("Basis", "sql_count"), _),
_), _),
_), _),
- _) => ((L'.EPrim (Prim.String "COUNT(*)"), loc),
- fm)
+ _) => (str "COUNT(*)", fm)
| L.ECApp (
(L.ECApp (
@@ -2762,12 +2742,11 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
| 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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
_) =>
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
_) =>
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
_), _)) =>
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
_), _)) =>
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
_), _)) =>
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
_) =>
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
_) =>
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
(L.EFfi ("Basis", "sql_no_partition"), _),
_), _),
_), _),
- _) => ((L'.EPrim (Prim.String ""), loc), fm)
+ _) => (str "", fm)
| L.ECApp (
(L.ECApp (
(L.ECApp (
@@ -3026,7 +2997,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
_) =>
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
((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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
| (("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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
(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 monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
(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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
(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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
val (ts, fm) = tagStart "textarea"
in
((L'.EStrcat (ts,
- (L'.EPrim (Prim.String " />"), loc)),
+ strH " />"),
loc), fm)
end
| SOME (_, src, _) =>
@@ -3957,7 +3921,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
| _ => 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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoDecl (env, fm) (all as (d, loc)) =
(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 @@ fun monoDecl (env, fm) (all as (d, loc)) =
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 @@ fun monoDecl (env, fm) (all as (d, loc)) =
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 @@ fun monoDecl (env, fm) (all as (d, loc)) =
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 @@ fun monoDecl (env, fm) (all as (d, loc)) =
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 @@ fun monoDecl (env, fm) (all as (d, loc)) =
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 @@ fun monoize env file =
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 @@ fun monoize env file =
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 @@ fun monoize env file =
(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 @@ fun monoize env file =
[] => 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 @@ fun monoize env file =
[] => 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
diff --git a/src/pathcheck.sml b/src/pathcheck.sml
index c1bb667b..3533032e 100644
--- a/src/pathcheck.sml
+++ b/src/pathcheck.sml
@@ -88,7 +88,7 @@ fun checkDecl ((d, loc), (funcs, rels, cookies, styles)) =
val rels = #2 (doRel s)
val rels = case #1 pe of
- EPrim (Prim.String "") => rels
+ EPrim (Prim.String (_, "")) => rels
| _ =>
let
val s' = s ^ "_Pkey"
diff --git a/src/prepare.sml b/src/prepare.sml
index 89cd1b43..660173f0 100644
--- a/src/prepare.sml
+++ b/src/prepare.sml
@@ -65,7 +65,7 @@ fun prepString (e, st) =
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 @@ fun prepString (e, st) =
| 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 @@ fun prepExp (e as (_, loc), st) =
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
diff --git a/src/prim.sig b/src/prim.sig
index 74147471..1da53d33 100644
--- a/src/prim.sig
+++ b/src/prim.sig
@@ -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
diff --git a/src/prim.sml b/src/prim.sml
index 94801e7f..1de4fc7b 100644
--- a/src/prim.sml
+++ b/src/prim.sml
@@ -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 @@ fun p_t t =
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 @@ fun toString t =
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 @@ fun p_t_GCC t =
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 @@ fun compare (p1, p2) =
| (Float _, _) => LESS
| (_, Float _) => GREATER
- | (String n1, String n2) => String.compare (n1, n2)
+ | (String (_, n1), String (_, n2)) => String.compare (n1, n2)
| (String _, _) => LESS
| (_, String _) => GREATER
diff --git a/src/shake.sml b/src/shake.sml
index 57ebec8e..051507d8 100644
--- a/src/shake.sml
+++ b/src/shake.sml
@@ -44,7 +44,7 @@ type free = {
}
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)
diff --git a/src/sql.sml b/src/sql.sml
index c314eb3d..91e303c3 100644
--- a/src/sql.sml
+++ b/src/sql.sml
@@ -47,7 +47,7 @@ datatype chunk =
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 @@ val prim =
(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 @@ fun sqlify chs =
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
diff --git a/src/urweb.grm b/src/urweb.grm
index 862debc5..edac345f 100644
--- a/src/urweb.grm
+++ b/src/urweb.grm
@@ -282,11 +282,11 @@ fun parseValue s pos =
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 @@ fun parseProperty s pos =
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 : eterm (eterm)
| 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 @@ eterm : LPAREN eexp RPAREN (#1 eexp, s (LPARENleft, RPARENright))
| 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 @@ eterm : LPAREN eexp RPAREN (#1 eexp, s (LPARENleft, RPARENright))
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 @@ eterm : LPAREN eexp RPAREN (#1 eexp, s (LPARENleft, RPARENright))
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 @@ pterm : SYMBOL (PVar SYMBOL, s (SYMBOLleft, SYMBOLright
| 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 @@ xml : xmlOne xml (let
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 @@ xmlOne : NOTAGS (EApp ((EVar (["Basis"], "cdata", Infer)
(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 @@ tag : tagHead attrs (let
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 @@ tag : tagHead attrs (let
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 @@ tag : tagHead attrs (let
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 @@ attr : SYMBOL EQ attrv (case SYMBOL of
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 @@ sqlexp : TRUE (sql_inject (EVar (["Basis"], "True", In
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)))
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-25 23:57:33 +0000