Mercurial > urweb
changeset 268:bacd0ba869e1
Monoize ASC/DESC
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Sun, 31 Aug 2008 16:54:13 -0400 |
| parents | f31e8da68e90 |
| children | fac9fae654e2 |
| files | lib/basis.urs src/compiler.sig src/compiler.sml src/mono_reduce.sml src/monoize.sml src/urweb.grm src/urweb.lex tests/order_by.ur |
| diffstat | 8 files changed, 47 insertions(+), 34 deletions(-) [+] |
line wrap: on
line diff
--- a/lib/basis.urs Sun Aug 31 16:32:49 2008 -0400 +++ b/lib/basis.urs Sun Aug 31 16:54:13 2008 -0400 @@ -73,7 +73,7 @@ con sql_order_by :: {{Type}} -> {Type} -> Type val sql_order_by_Nil : tables ::: {{Type}} -> exps :: {Type} -> sql_order_by tables exps val sql_order_by_Cons : tables ::: {{Type}} -> exps ::: {Type} -> t ::: Type - -> sql_exp tables [] exps t -> sql_order_by tables exps + -> sql_exp tables [] exps t -> sql_direction -> sql_order_by tables exps -> sql_order_by tables exps type sql_limit
--- a/src/compiler.sig Sun Aug 31 16:32:49 2008 -0400 +++ b/src/compiler.sig Sun Aug 31 16:54:13 2008 -0400 @@ -74,12 +74,9 @@ 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
--- a/src/compiler.sml Sun Aug 31 16:32:49 2008 -0400 +++ b/src/compiler.sml Sun Aug 31 16:54:13 2008 -0400 @@ -313,29 +313,23 @@ 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
--- a/src/mono_reduce.sml Sun Aug 31 16:32:49 2008 -0400 +++ b/src/mono_reduce.sml Sun Aug 31 16:54:13 2008 -0400 @@ -203,6 +203,9 @@ 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) =
--- a/src/monoize.sml Sun Aug 31 16:32:49 2008 -0400 +++ b/src/monoize.sml Sun Aug 31 16:54:13 2008 -0400 @@ -718,17 +718,19 @@ 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 @@ (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"), _), _), _),
--- a/src/urweb.grm Sun Aug 31 16:32:49 2008 -0400 +++ b/src/urweb.grm Sun Aug 31 16:54:13 2008 -0400 @@ -178,6 +178,7 @@ | 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 @@ | 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 @@ 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
--- a/src/urweb.lex Sun Aug 31 16:32:49 2008 -0400 +++ b/src/urweb.lex Sun Aug 31 16:54:13 2008 -0400 @@ -332,6 +332,9 @@ <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));
--- a/tests/order_by.ur Sun Aug 31 16:32:49 2008 -0400 +++ b/tests/order_by.ur Sun Aug 31 16:54:13 2008 -0400 @@ -12,7 +12,7 @@ ORDER BY Lt) val q5 = (SELECT t1.A, t1.B, t2.D, t1.A < t2.D AS Lt FROM t1, t2 - ORDER BY t1.A, Lt, t2.D) + ORDER BY t1.A DESC, Lt ASC, t2.D DESC) datatype list a = Nil | Cons of a * list a