From 83431c3e4c3fa74cae515520be04a0be3c11fef2 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sun, 31 Aug 2008 16:54:13 -0400 Subject: Monoize ASC/DESC --- lib/basis.urs | 2 +- src/compiler.sig | 7 ++----- src/compiler.sml | 14 ++++---------- src/mono_reduce.sml | 3 +++ src/monoize.sml | 27 ++++++++++++++++----------- src/urweb.grm | 23 +++++++++++++++++------ src/urweb.lex | 3 +++ tests/order_by.ur | 2 +- 8 files changed, 47 insertions(+), 34 deletions(-) diff --git a/lib/basis.urs b/lib/basis.urs index bfb25651..cd355316 100644 --- a/lib/basis.urs +++ b/lib/basis.urs @@ -73,7 +73,7 @@ val sql_desc : sql_direction 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 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]+; "MIN" => (Tokens.MIN (pos yypos, pos yypos + size yytext)); "MAX" => (Tokens.MAX (pos yypos, pos yypos + size yytext)); + "ASC" => (Tokens.ASC (pos yypos, pos yypos + size yytext)); + "DESC" => (Tokens.DESC (pos yypos, pos yypos + size yytext)); + {id} => (Tokens.SYMBOL (yytext, pos yypos, pos yypos + size yytext)); {cid} => (Tokens.CSYMBOL (yytext, pos yypos, pos yypos + size yytext)); diff --git a/tests/order_by.ur b/tests/order_by.ur index dbe041c2..de584fda 100644 --- a/tests/order_by.ur +++ b/tests/order_by.ur @@ -12,7 +12,7 @@ val q4 = (SELECT t1.A, t2.D, t1.A < t2.D AS Lt 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 -- cgit v1.2.3