summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/compiler.sig7
-rw-r--r--src/compiler.sml14
-rw-r--r--src/mono_reduce.sml3
-rw-r--r--src/monoize.sml27
-rw-r--r--src/urweb.grm23
-rw-r--r--src/urweb.lex3
6 files changed, 45 insertions, 32 deletions
diff --git a/src/compiler.sig b/src/compiler.sig
index 2549b4f1..51ec0537 100644
--- a/src/compiler.sig
+++ b/src/compiler.sig
@@ -74,12 +74,9 @@ signature COMPILER = sig
val toMonoize : (job, Mono.file) transform
val toMono_opt1 : (job, Mono.file) transform
val toUntangle : (job, Mono.file) transform
- val toMono_reduce1 : (job, Mono.file) transform
- val toMono_shake1 : (job, Mono.file) transform
+ val toMono_reduce : (job, Mono.file) transform
+ val toMono_shake : (job, Mono.file) transform
val toMono_opt2 : (job, Mono.file) transform
- val toMono_reduce2 : (job, Mono.file) transform
- val toMono_opt3 : (job, Mono.file) transform
- val toMono_shake2 : (job, Mono.file) transform
val toCjrize : (job, Cjr.file) transform
end
diff --git a/src/compiler.sml b/src/compiler.sml
index cc8e459d..8c6c8f1f 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -313,29 +313,23 @@ val mono_reduce = {
print = MonoPrint.p_file MonoEnv.empty
}
-val toMono_reduce1 = toUntangle o transform mono_reduce "mono_reduce1"
+val toMono_reduce = toUntangle o transform mono_reduce "mono_reduce"
val mono_shake = {
func = MonoShake.shake,
print = MonoPrint.p_file MonoEnv.empty
}
-val toMono_shake1 = toMono_reduce1 o transform mono_shake "mono_shake1"
+val toMono_shake = toMono_reduce o transform mono_shake "mono_shake1"
-val toMono_opt2 = toMono_shake1 o transform mono_opt "mono_opt2"
-
-val toMono_reduce2 = toMono_opt2 o transform mono_reduce "mono_reduce2"
-
-val toMono_opt3 = toMono_reduce2 o transform mono_opt "mono_opt3"
-
-val toMono_shake2 = toMono_opt3 o transform mono_shake "mono_shake2"
+val toMono_opt2 = toMono_shake o transform mono_opt "mono_opt2"
val cjrize = {
func = Cjrize.cjrize,
print = CjrPrint.p_file CjrEnv.empty
}
-val toCjrize = toMono_shake2 o transform cjrize "cjrize"
+val toCjrize = toMono_opt2 o transform cjrize "cjrize"
fun compileC {cname, oname, ename} =
let
diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml
index caa3c124..5367be60 100644
--- a/src/mono_reduce.sml
+++ b/src/mono_reduce.sml
@@ -203,6 +203,9 @@ fun exp env e =
else
#1 (reduceExp env (subExpInExp (0, e') b))
+ | EStrcat ((EPrim (Prim.String s1), _), (EPrim (Prim.String s2), _)) =>
+ EPrim (Prim.String (s1 ^ s2))
+
| _ => e
and bind (env, b) =
diff --git a/src/monoize.sml b/src/monoize.sml
index 55245074..6624c971 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -718,17 +718,19 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
val s = (L'.TFfi ("Basis", "string"), loc)
fun sc s = (L'.EPrim (Prim.String s), loc)
in
- ((L'.EAbs ("e1", s, (L'.TFun (s, s), loc),
- (L'.EAbs ("e2", s, s,
- (L'.ECase ((L'.ERel 0, loc),
- [((L'.PPrim (Prim.String ""), loc),
- (L'.ERel 1, loc)),
- ((L'.PWild, loc),
- strcat loc [(L'.ERel 1, loc),
- sc ", ",
- (L'.ERel 0, loc),
- sc ")"])],
- {disc = s, result = 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),
+ strcat loc [(L'.ERel 2, loc),
+ (L'.ERel 1, loc)]),
+ ((L'.PWild, loc),
+ strcat loc [(L'.ERel 2, loc),
+ (L'.ERel 1, loc),
+ sc ", ",
+ (L'.ERel 0, loc)])],
+ {disc = s, result = s}), loc)), loc)), loc)), loc),
fm)
end
@@ -968,6 +970,9 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
(L'.EPrim (Prim.String "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.EApp (
(L.ECApp (
(L.ECApp ((L.EFfi ("Basis", "cdata"), _), _), _),
diff --git a/src/urweb.grm b/src/urweb.grm
index 51c104d7..6cb41890 100644
--- a/src/urweb.grm
+++ b/src/urweb.grm
@@ -178,6 +178,7 @@ fun native_op (oper, e1, e2, loc) =
| LIMIT | OFFSET | ALL
| TRUE | FALSE | CAND | OR | NOT
| COUNT | AVG | SUM | MIN | MAX
+ | ASC | DESC
| NE | LT | LE | GT | GE
%nonterm
@@ -270,7 +271,9 @@ fun native_op (oper, e1, e2, loc) =
| gopt of group_item list option
| hopt of exp
| obopt of exp
+ | obitem of exp * exp
| obexps of exp
+ | diropt of exp
| lopt of exp
| ofopt of exp
| sqlint of exp
@@ -1022,26 +1025,34 @@ obopt : (ECApp ((EVar (["Basis"], "sql_order_by_
dummy)
| ORDER BY obexps (obexps)
-obexps : sqlexp (let
- val loc = s (sqlexpleft, sqlexpright)
+obitem : sqlexp diropt (sqlexp, diropt)
+
+obexps : obitem (let
+ val loc = s (obitemleft, obitemright)
val e' = (ECApp ((EVar (["Basis"], "sql_order_by_Nil"), loc),
(CWild (KRecord (KType, loc), loc), loc)),
loc)
val e = (EApp ((EVar (["Basis"], "sql_order_by_Cons"), loc),
- sqlexp), loc)
+ #1 obitem), loc)
+ val e = (EApp (e, #2 obitem), loc)
in
(EApp (e, e'), loc)
end)
- | sqlexp COMMA obexps (let
- val loc = s (sqlexpleft, obexpsright)
+ | obitem COMMA obexps (let
+ val loc = s (obitemleft, obexpsright)
val e = (EApp ((EVar (["Basis"], "sql_order_by_Cons"), loc),
- sqlexp), loc)
+ #1 obitem), loc)
+ val e = (EApp (e, #2 obitem), loc)
in
(EApp (e, obexps), loc)
end)
+diropt : (EVar (["Basis"], "sql_asc"), dummy)
+ | ASC (EVar (["Basis"], "sql_asc"), s (ASCleft, ASCright))
+ | DESC (EVar (["Basis"], "sql_desc"), s (DESCleft, DESCright))
+
lopt : (EVar (["Basis"], "sql_no_limit"), dummy)
| LIMIT ALL (EVar (["Basis"], "sql_no_limit"), dummy)
| LIMIT sqlint (let
diff --git a/src/urweb.lex b/src/urweb.lex
index 1d64a85c..e47546b3 100644
--- a/src/urweb.lex
+++ b/src/urweb.lex
@@ -332,6 +332,9 @@ notags = [^<{\n]+;
<INITIAL> "MIN" => (Tokens.MIN (pos yypos, pos yypos + size yytext));
<INITIAL> "MAX" => (Tokens.MAX (pos yypos, pos yypos + size yytext));
+<INITIAL> "ASC" => (Tokens.ASC (pos yypos, pos yypos + size yytext));
+<INITIAL> "DESC" => (Tokens.DESC (pos yypos, pos yypos + size yytext));
+
<INITIAL> {id} => (Tokens.SYMBOL (yytext, pos yypos, pos yypos + size yytext));
<INITIAL> {cid} => (Tokens.CSYMBOL (yytext, pos yypos, pos yypos + size yytext));
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-29 14:31:00 +0000