Laconic -> Ur

1 files changed, 1055 insertions, 0 deletions

diff --git a/src/urweb.grm b/src/urweb.grm
new file mode 100644
index 00000000..aa062516
--- /dev/null
+++ b/src/urweb.grm
@@ -0,0 +1,1055 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* Grammar for Ur/Web programs *)
+
+open Source
+
+val s = ErrorMsg.spanOf
+val dummy = ErrorMsg.dummySpan
+
+fun capitalize "" = ""
+  | capitalize s = str (Char.toUpper (String.sub (s, 0))) ^ String.extract (s, 1, NONE)
+
+fun entable t =
+    case #1 t of
+        TRecord c => c
+      | _ => t
+
+datatype select_item =
+         Field of con * con
+       | Exp of con * exp
+
+datatype select =
+         Star
+       | Items of select_item list
+
+datatype group_item =
+         GField of con * con
+
+fun eqTnames ((c1, _), (c2, _)) =
+    case (c1, c2) of
+        (CVar (ms1, x1), CVar (ms2, x2)) => ms1 = ms2 andalso x1 = x2
+      | (CName x1, CName x2) => x1 = x2
+      | _ => false
+
+fun amend_select loc (si, (tabs, exps)) =
+    case si of
+        Field (tx, fx) =>
+        let
+            val c = (CRecord ([(fx, (CWild (KType, loc), loc))]), loc)
+
+            val (tabs, found) = ListUtil.foldlMap (fn ((tx', c'), found) =>
+                                                      if eqTnames (tx, tx') then
+                                                          ((tx', (CConcat (c, c'), loc)), true)
+                                                      else
+                                                          ((tx', c'), found))
+                                                  false tabs
+        in
+            if found then
+                ()
+            else
+                ErrorMsg.errorAt loc "Select of field from unbound table";
+            
+            (tabs, exps)
+        end
+      | Exp (c, e) => (tabs, (c, e) :: exps)
+
+fun amend_group loc (gi, tabs) =
+    let
+        val (tx, c) = case gi of
+                          GField (tx, fx) => (tx, (CRecord ([(fx, (CWild (KType, loc), loc))]), loc))
+
+        val (tabs, found) = ListUtil.foldlMap (fn ((tx', c'), found) =>
+                                                  if eqTnames (tx, tx') then
+                                                      ((tx', (CConcat (c, c'), loc)), true)
+                                                  else
+                                                      ((tx', c'), found))
+                            false tabs
+    in
+        if found then
+            ()
+        else
+            ErrorMsg.errorAt loc "Select of field from unbound table";
+
+        tabs
+    end
+
+fun sql_inject (v, t, loc) =
+    let
+        val e = (EApp ((EVar (["Basis"], "sql_inject"), loc), (t, loc)), loc)
+    in
+        (EApp (e, (v, loc)), loc)
+    end
+
+fun sql_compare (oper, sqlexp1, sqlexp2, loc) =
+    let
+        val e = (EVar (["Basis"], "sql_comparison"), loc)
+        val e = (EApp (e, (EVar (["Basis"], "sql_" ^ oper), loc)), loc)
+        val e = (EApp (e, sqlexp1), loc)
+    in
+        (EApp (e, sqlexp2), loc)
+    end
+
+fun sql_binary (oper, sqlexp1, sqlexp2, loc) =
+    let
+        val e = (EVar (["Basis"], "sql_binary"), loc)
+        val e = (EApp (e, (EVar (["Basis"], "sql_" ^ oper), loc)), loc)
+        val e = (EApp (e, sqlexp1), loc)
+    in
+        (EApp (e, sqlexp2), loc)
+    end
+
+fun sql_unary (oper, sqlexp, loc) =
+    let
+        val e = (EVar (["Basis"], "sql_unary"), loc)
+        val e = (EApp (e, (EVar (["Basis"], "sql_" ^ oper), loc)), loc)
+    in
+        (EApp (e, sqlexp), loc)
+    end
+
+fun sql_relop (oper, sqlexp1, sqlexp2, loc) =
+    let
+        val e = (EVar (["Basis"], "sql_relop"), loc)
+        val e = (EApp (e, (EVar (["Basis"], "sql_" ^ oper), loc)), loc)
+        val e = (EApp (e, sqlexp1), loc)
+    in
+        (EApp (e, sqlexp2), loc)
+    end
+
+%%
+%header (functor UrwebLrValsFn(structure Token : TOKEN))
+
+%term 
+   EOF
+ | STRING of string | INT of Int64.int | FLOAT of Real64.real
+ | SYMBOL of string | CSYMBOL of string
+ | LPAREN | RPAREN | LBRACK | RBRACK | LBRACE | RBRACE
+ | EQ | COMMA | COLON | DCOLON | TCOLON | DOT | HASH | UNDER | UNDERUNDER | BAR
+ | DIVIDE | DOTDOTDOT
+ | CON | LTYPE | VAL | REC | AND | FUN | FOLD | UNIT | KUNIT | CLASS
+ | DATATYPE | OF
+ | TYPE | NAME
+ | ARROW | LARROW | DARROW | STAR | SEMI
+ | FN | PLUSPLUS | MINUSMINUS | DOLLAR | TWIDDLE
+ | STRUCTURE | SIGNATURE | STRUCT | SIG | END | FUNCTOR | WHERE | EXTERN
+ | INCLUDE | OPEN | CONSTRAINT | CONSTRAINTS | EXPORT | TABLE
+ | CASE | IF | THEN | ELSE
+
+ | XML_BEGIN of string | XML_END
+ | NOTAGS of string 
+ | BEGIN_TAG of string | END_TAG of string
+
+ | SELECT | FROM | AS | CWHERE | GROUP | ORDER | BY | HAVING
+ | UNION | INTERSECT | EXCEPT
+ | LIMIT | OFFSET | ALL
+ | TRUE | FALSE | CAND | OR | NOT
+ | COUNT | AVG | SUM | MIN | MAX
+ | NE | LT | LE | GT | GE
+
+%nonterm
+   file of decl list
+ | decls of decl list
+ | decl of decl
+ | vali of string * con option * exp
+ | valis of (string * con option * exp) list
+ | copt of con option
+
+ | dargs of string list
+ | barOpt of unit
+ | dcons of (string * con option) list
+ | dcon of string * con option
+
+ | sgn of sgn
+ | sgntm of sgn
+ | sgi of sgn_item
+ | sgis of sgn_item list
+
+ | str of str
+
+ | kind of kind
+ | ktuple of kind list
+ | kcolon of explicitness
+ | kopt of kind option
+
+ | path of string list * string
+ | cpath of string list * string
+ | spath of str
+ | mpath of string list
+
+ | cexp of con
+ | capps of con
+ | cterm of con
+ | ctuple of con list
+ | ctuplev of con list
+ | ident of con
+ | idents of con list
+ | rcon of (con * con) list
+ | rconn of (con * con) list
+ | rcone of (con * con) list
+ | cargs of con * kind -> con * kind
+ | cargl of con * kind -> con * kind
+ | cargl2 of con * kind -> con * kind
+ | carg of con * kind -> con * kind
+ | cargp of con * kind -> con * kind
+
+ | eexp of exp
+ | eapps of exp
+ | eterm of exp
+ | etuple of exp list
+ | rexp of (con * exp) list
+ | xml of exp
+ | xmlOne of exp
+ | tag of string * exp
+ | tagHead of string * exp
+
+ | earg of exp * con -> exp * con
+ | eargp of exp * con -> exp * con
+ | eargs of exp * con -> exp * con
+ | eargl of exp * con -> exp * con
+ | eargl2 of exp * con -> exp * con
+
+ | branch of pat * exp
+ | branchs of (pat * exp) list
+ | pat of pat
+ | pterm of pat
+ | rpat of (string * pat) list * bool
+ | ptuple of pat list
+
+ | attrs of (con * exp) list
+ | attr of con * exp
+ | attrv of exp
+
+ | query of exp
+ | query1 of exp
+ | tables of (con * exp) list
+ | tname of con
+ | table of con * exp
+ | tident of con
+ | fident of con
+ | seli of select_item
+ | selis of select_item list
+ | select of select
+ | sqlexp of exp
+ | wopt of exp
+ | groupi of group_item
+ | groupis of group_item list
+ | gopt of group_item list option
+ | hopt of exp
+ | obopt of exp
+ | obexps of exp
+ | lopt of exp
+ | ofopt of exp
+ | sqlint of exp
+ | sqlagg of string
+
+
+%verbose                                (* print summary of errors *)
+%pos int                                (* positions *)
+%start file
+%pure
+%eop EOF
+%noshift EOF
+
+%name Urweb
+
+%right SEMI
+%nonassoc LARROW
+%nonassoc IF THEN ELSE
+%nonassoc DARROW
+%nonassoc COLON
+%nonassoc DCOLON TCOLON
+%left UNION INTERSECT EXCEPT
+%right COMMA
+%right OR
+%right CAND
+%nonassoc EQ NE LT LE GT GE
+%right ARROW
+%right PLUSPLUS MINUSMINUS
+%right STAR
+%left NOT
+%nonassoc TWIDDLE
+%nonassoc DOLLAR
+%left DOT
+%nonassoc LBRACE RBRACE
+
+%%
+
+file   : decls                          (decls)
+       | SIG sgis                       ([(DSgn ("?", (SgnConst sgis, s (SIGleft, sgisright))),
+                                           s (SIGleft, sgisright))])
+
+decls  :                                ([])
+       | decl decls                     (decl :: decls)
+
+decl   : CON SYMBOL cargl2 kopt EQ cexp (let
+                                             val loc = s (CONleft, cexpright)
+
+                                             val k = Option.getOpt (kopt, (KWild, loc))
+                                             val (c, k) = cargl2 (cexp, k)
+                                         in
+                                             (DCon (SYMBOL, SOME k, c), loc)
+                                         end)
+       | LTYPE SYMBOL EQ cexp           (DCon (SYMBOL, SOME (KType, s (LTYPEleft, cexpright)), cexp),
+                                         s (LTYPEleft, cexpright))
+       | DATATYPE SYMBOL dargs EQ barOpt dcons(DDatatype (SYMBOL, dargs, dcons), s (DATATYPEleft, dconsright))
+       | DATATYPE SYMBOL dargs EQ DATATYPE CSYMBOL DOT path
+                (case dargs of
+                     [] => (DDatatypeImp (SYMBOL, CSYMBOL :: #1 path, #2 path), s (DATATYPEleft, pathright))
+                   | _ => raise Fail "Arguments specified for imported datatype")
+       | VAL vali                       (DVal vali, s (VALleft, valiright))
+       | VAL REC valis                  (DValRec valis, s (VALleft, valisright))
+       | FUN valis                      (DValRec valis, s (FUNleft, valisright))
+
+       | SIGNATURE CSYMBOL EQ sgn       (DSgn (CSYMBOL, sgn), s (SIGNATUREleft, sgnright))
+       | STRUCTURE CSYMBOL EQ str       (DStr (CSYMBOL, NONE, str), s (STRUCTUREleft, strright))
+       | STRUCTURE CSYMBOL COLON sgn EQ str (DStr (CSYMBOL, SOME sgn, str), s (STRUCTUREleft, strright))
+       | FUNCTOR CSYMBOL LPAREN CSYMBOL COLON sgn RPAREN EQ str
+                                        (DStr (CSYMBOL1, NONE,
+                                               (StrFun (CSYMBOL2, sgn1, NONE, str), s (FUNCTORleft, strright))),
+                                         s (FUNCTORleft, strright))
+       | FUNCTOR CSYMBOL LPAREN CSYMBOL COLON sgn RPAREN COLON sgn EQ str
+                                        (DStr (CSYMBOL1, NONE,
+                                               (StrFun (CSYMBOL2, sgn1, SOME sgn2, str), s (FUNCTORleft, strright))),
+                                         s (FUNCTORleft, strright))
+       | EXTERN STRUCTURE CSYMBOL COLON sgn (DFfiStr (CSYMBOL, sgn), s (EXTERNleft, sgnright))
+       | OPEN mpath                     (case mpath of
+                                             [] => raise Fail "Impossible mpath parse [1]"
+                                           | m :: ms => (DOpen (m, ms), s (OPENleft, mpathright)))
+       | OPEN CONSTRAINTS mpath         (case mpath of
+                                             [] => raise Fail "Impossible mpath parse [3]"
+                                           | m :: ms => (DOpenConstraints (m, ms), s (OPENleft, mpathright)))
+       | CONSTRAINT cterm TWIDDLE cterm (DConstraint (cterm1, cterm2), s (CONSTRAINTleft, ctermright))
+       | EXPORT spath                   (DExport spath, s (EXPORTleft, spathright))
+       | TABLE SYMBOL COLON cexp        (DTable (SYMBOL, entable cexp), s (TABLEleft, cexpright))
+       | CLASS SYMBOL EQ cexp           (DClass (SYMBOL, cexp), s (CLASSleft, cexpright))
+       | CLASS SYMBOL SYMBOL EQ cexp    (let
+                                             val loc = s (CLASSleft, cexpright)
+                                             val k = (KType, loc)
+                                             val c = (CAbs (SYMBOL2, SOME k, cexp), loc)
+                                         in
+                                             (DClass (SYMBOL1, c), s (CLASSleft, cexpright))
+                                         end)
+
+kopt   :                                (NONE)
+       | DCOLON kind                    (SOME kind)
+
+dargs  :                                ([])
+       | SYMBOL dargs                   (SYMBOL :: dargs)
+
+barOpt :                                ()
+       | BAR                            ()
+
+dcons  : dcon                           ([dcon])
+       | dcon BAR dcons                 (dcon :: dcons)
+
+dcon   : CSYMBOL                        (CSYMBOL, NONE)
+       | CSYMBOL OF cexp                (CSYMBOL, SOME cexp)
+
+vali   : SYMBOL eargl2 copt EQ eexp     (let
+                                             val loc = s (SYMBOLleft, eexpright)
+                                             val t = Option.getOpt (copt, (CWild (KType, loc), loc))
+
+                                             val (e, t) = eargl2 (eexp, t)
+                                         in
+                                             (SYMBOL, SOME t, e)
+                                         end)
+
+copt   :                                (NONE)
+       | COLON cexp                     (SOME cexp)
+
+valis  : vali                           ([vali])
+       | vali AND valis                 (vali :: valis)
+
+sgn    : sgntm                          (sgntm)
+       | FUNCTOR LPAREN CSYMBOL COLON sgn RPAREN COLON sgn
+                                        (SgnFun (CSYMBOL, sgn1, sgn2), s (FUNCTORleft, sgn2right))
+
+sgntm  : SIG sgis END                   (SgnConst sgis, s (SIGleft, ENDright))
+       | mpath                          (case mpath of
+                                             [] => raise Fail "Impossible mpath parse [2]"
+                                           | [x] => SgnVar x
+                                           | m :: ms => SgnProj (m,
+                                                                 List.take (ms, length ms - 1),
+                                                                 List.nth (ms, length ms - 1)),
+                                         s (mpathleft, mpathright))
+       | sgntm WHERE CON SYMBOL EQ cexp (SgnWhere (sgntm, SYMBOL, cexp), s (sgntmleft, cexpright))
+       | sgntm WHERE LTYPE SYMBOL EQ cexp(SgnWhere (sgntm, SYMBOL, cexp), s (sgntmleft, cexpright))
+       | LPAREN sgn RPAREN              (sgn)
+
+sgi    : CON SYMBOL DCOLON kind         (SgiConAbs (SYMBOL, kind), s (CONleft, kindright))
+       | LTYPE SYMBOL                   (SgiConAbs (SYMBOL, (KType, s (LTYPEleft, SYMBOLright))),
+                                         s (LTYPEleft, SYMBOLright))
+       | CON SYMBOL EQ cexp             (SgiCon (SYMBOL, NONE, cexp), s (CONleft, cexpright))
+       | CON SYMBOL DCOLON kind EQ cexp (SgiCon (SYMBOL, SOME kind, cexp), s (CONleft, cexpright))
+       | LTYPE SYMBOL EQ cexp           (SgiCon (SYMBOL, SOME (KType, s (LTYPEleft, cexpright)), cexp),
+                                         s (LTYPEleft, cexpright))
+       | DATATYPE SYMBOL dargs EQ barOpt dcons(SgiDatatype (SYMBOL, dargs, dcons), s (DATATYPEleft, dconsright))
+       | DATATYPE SYMBOL dargs EQ DATATYPE CSYMBOL DOT path
+                (case dargs of
+                     [] => (SgiDatatypeImp (SYMBOL, CSYMBOL :: #1 path, #2 path), s (DATATYPEleft, pathright))
+                   | _ => raise Fail "Arguments specified for imported datatype")
+       | VAL SYMBOL COLON cexp          (SgiVal (SYMBOL, cexp), s (VALleft, cexpright))
+
+       | STRUCTURE CSYMBOL COLON sgn    (SgiStr (CSYMBOL, sgn), s (STRUCTUREleft, sgnright))
+       | SIGNATURE CSYMBOL EQ sgn       (SgiSgn (CSYMBOL, sgn), s (SIGNATUREleft, sgnright))
+       | FUNCTOR CSYMBOL LPAREN CSYMBOL COLON sgn RPAREN COLON sgn
+                                        (SgiStr (CSYMBOL1,
+                                                 (SgnFun (CSYMBOL2, sgn1, sgn2), s (FUNCTORleft, sgn2right))),
+                                         s (FUNCTORleft, sgn2right))
+       | INCLUDE sgn                    (SgiInclude sgn, s (INCLUDEleft, sgnright))
+       | CONSTRAINT cterm TWIDDLE cterm (SgiConstraint (cterm1, cterm2), s (CONSTRAINTleft, ctermright))
+       | TABLE SYMBOL COLON cexp        (SgiTable (SYMBOL, entable cexp), s (TABLEleft, cexpright))
+       | CLASS SYMBOL                   (SgiClassAbs SYMBOL, s (CLASSleft, SYMBOLright))
+       | CLASS SYMBOL EQ cexp           (SgiClass (SYMBOL, cexp), s (CLASSleft, cexpright))
+       | CLASS SYMBOL SYMBOL EQ cexp    (let
+                                             val loc = s (CLASSleft, cexpright)
+                                             val k = (KType, loc)
+                                             val c = (CAbs (SYMBOL2, SOME k, cexp), loc)
+                                         in
+                                             (SgiClass (SYMBOL1, c), s (CLASSleft, cexpright))
+                                         end)
+
+sgis   :                                ([])
+       | sgi sgis                       (sgi :: sgis)
+
+str    : STRUCT decls END               (StrConst decls, s (STRUCTleft, ENDright))
+       | spath                          (spath)
+       | FUNCTOR LPAREN CSYMBOL COLON sgn RPAREN DARROW str
+                                        (StrFun (CSYMBOL, sgn, NONE, str), s (FUNCTORleft, strright))
+       | FUNCTOR LPAREN CSYMBOL COLON sgn RPAREN COLON sgn DARROW str
+                                        (StrFun (CSYMBOL, sgn1, SOME sgn2, str), s (FUNCTORleft, strright))
+       | spath LPAREN str RPAREN        (StrApp (spath, str), s (spathleft, RPARENright))
+
+spath  : CSYMBOL                        (StrVar CSYMBOL, s (CSYMBOLleft, CSYMBOLright))
+       | spath DOT CSYMBOL              (StrProj (spath, CSYMBOL), s (spathleft, CSYMBOLright))
+
+kind   : TYPE                           (KType, s (TYPEleft, TYPEright))
+       | NAME                           (KName, s (NAMEleft, NAMEright))
+       | LBRACE kind RBRACE             (KRecord kind, s (LBRACEleft, RBRACEright))
+       | kind ARROW kind                (KArrow (kind1, kind2), s (kind1left, kind2right))
+       | LPAREN kind RPAREN             (#1 kind, s (LPARENleft, RPARENright))
+       | KUNIT                          (KUnit, s (KUNITleft, KUNITright))
+       | UNDERUNDER                     (KWild, s (UNDERUNDERleft, UNDERUNDERright))
+       | LPAREN ktuple RPAREN           (KTuple ktuple, s (LPARENleft, RPARENright))
+
+ktuple : kind STAR kind                 ([kind1, kind2])
+       | kind STAR ktuple               (kind :: ktuple)
+
+capps  : cterm                          (cterm)
+       | capps cterm                    (CApp (capps, cterm), s (cappsleft, ctermright))
+
+cexp   : capps                          (capps)
+       | cexp ARROW cexp                (TFun (cexp1, cexp2), s (cexp1left, cexp2right))
+       | SYMBOL kcolon kind ARROW cexp  (TCFun (kcolon, SYMBOL, kind, cexp), s (SYMBOLleft, cexpright))
+
+       | cexp PLUSPLUS cexp             (CConcat (cexp1, cexp2), s (cexp1left, cexp1right))
+
+       | FN cargs DARROW cexp           (#1 (cargs (cexp, (KWild, s (FNleft, cexpright)))))
+       | cterm TWIDDLE cterm DARROW cexp(CDisjoint (cterm1, cterm2, cexp), s (cterm1left, cexpright))
+       | cterm TWIDDLE cterm ARROW cexp (TDisjoint (cterm1, cterm2, cexp), s (cterm1left, cexpright))
+
+       | LPAREN cexp RPAREN DCOLON kind (CAnnot (cexp, kind), s (LPARENleft, kindright))
+
+       | UNDER DCOLON kind              (CWild kind, s (UNDERleft, UNDERright))
+       | ctuple                         (let
+                                             val loc = s (ctupleleft, ctupleright)
+                                         in
+                                             (TRecord (CRecord (ListUtil.mapi (fn (i, c) =>
+                                                                                  ((CName (Int.toString (i + 1)), loc),
+                                                                                   c)) ctuple),
+                                                       loc), loc)
+                                         end)
+
+kcolon : DCOLON                         (Explicit)
+       | TCOLON                         (Implicit)
+
+cargs  : carg                           (carg)
+       | cargl                          (cargl)
+
+cargl  : cargp cargp                    (cargp1 o cargp2)
+       | cargp cargl                    (cargp o cargl)
+
+cargl2 :                                (fn x => x)
+       | cargp cargl2                   (cargp o cargl2)
+
+carg   : SYMBOL DCOLON kind             (fn (c, k) =>
+                                            let
+                                                val loc = s (SYMBOLleft, kindright)
+                                            in
+                                                ((CAbs (SYMBOL, SOME kind, c), loc),
+                                                 (KArrow (kind, k), loc))
+                                            end)
+       | cargp                          (cargp)
+
+cargp  : SYMBOL                         (fn (c, k) =>
+                                            let
+                                                val loc = s (SYMBOLleft, SYMBOLright)
+                                            in
+                                                ((CAbs (SYMBOL, NONE, c), loc),
+                                                 (KArrow ((KWild, loc), k), loc))
+                                            end)
+       | LPAREN SYMBOL DCOLON kind RPAREN (fn (c, k) =>
+                                              let
+                                                  val loc = s (LPARENleft, RPARENright)
+                                              in
+                                                  ((CAbs (SYMBOL, SOME kind, c), loc),
+                                                   (KArrow (kind, k), loc))
+                                              end)
+
+path   : SYMBOL                         ([], SYMBOL)
+       | CSYMBOL DOT path               (let val (ms, x) = path in (CSYMBOL :: ms, x) end)
+
+cpath  : CSYMBOL                        ([], CSYMBOL)
+       | CSYMBOL DOT cpath              (let val (ms, x) = cpath in (CSYMBOL :: ms, x) end)
+
+mpath  : CSYMBOL                        ([CSYMBOL])
+       | CSYMBOL DOT mpath              (CSYMBOL :: mpath)
+
+cterm  : LPAREN cexp RPAREN             (#1 cexp, s (LPARENleft, RPARENright))
+       | LBRACK rcon RBRACK             (CRecord rcon, s (LBRACKleft, RBRACKright))
+       | LBRACK rconn RBRACK            (CRecord rconn, s (LBRACKleft, RBRACKright))
+       | LBRACE rcone RBRACE            (TRecord (CRecord rcone, s (LBRACEleft, RBRACEright)),
+					 s (LBRACEleft, RBRACEright))
+       | DOLLAR cterm                   (TRecord cterm, s (DOLLARleft, ctermright))
+       | HASH CSYMBOL                   (CName CSYMBOL, s (HASHleft, CSYMBOLright))
+       | HASH INT                       (CName (Int64.toString INT), s (HASHleft, INTright))
+
+       | path                           (CVar path, s (pathleft, pathright))
+       | path DOT INT                   (CProj ((CVar path, s (pathleft, pathright)), Int64.toInt INT),
+                                         s (pathleft, INTright))
+       | UNDER                          (CWild (KWild, s (UNDERleft, UNDERright)), s (UNDERleft, UNDERright))
+       | FOLD                           (CFold, s (FOLDleft, FOLDright))
+       | UNIT                           (CUnit, s (UNITleft, UNITright))
+       | LPAREN ctuplev RPAREN          (CTuple ctuplev, s (LPARENleft, RPARENright))
+
+ctuplev: cexp COMMA cexp                ([cexp1, cexp2])
+       | cexp COMMA ctuplev             (cexp :: ctuplev)
+
+ctuple : capps STAR capps               ([capps1, capps2])
+       | capps STAR ctuple              (capps :: ctuple)
+
+rcon   :                                ([])
+       | ident EQ cexp                  ([(ident, cexp)])
+       | ident EQ cexp COMMA rcon       ((ident, cexp) :: rcon)
+
+rconn  : ident                          ([(ident, (CUnit, s (identleft, identright)))])
+       | ident COMMA rconn              ((ident, (CUnit, s (identleft, identright))) :: rconn)
+
+rcone  :                                ([])
+       | ident COLON cexp               ([(ident, cexp)])
+       | ident COLON cexp COMMA rcone   ((ident, cexp) :: rcone)
+
+ident  : CSYMBOL                        (CName CSYMBOL, s (CSYMBOLleft, CSYMBOLright))
+       | INT                            (CName (Int64.toString INT), s (INTleft, INTright))
+       | SYMBOL                         (CVar ([], SYMBOL), s (SYMBOLleft, SYMBOLright))
+
+eapps  : eterm                          (eterm)
+       | eapps eterm                    (EApp (eapps, eterm), s (eappsleft, etermright))
+       | eapps LBRACK cexp RBRACK       (ECApp (eapps, cexp), s (eappsleft, RBRACKright))
+
+eexp   : eapps                          (eapps)
+       | FN eargs DARROW eexp           (let
+                                             val loc = s (FNleft, eexpright)
+                                         in
+                                             #1 (eargs (eexp, (CWild (KType, loc), loc)))
+                                         end)
+       | LBRACK cterm TWIDDLE cterm RBRACK DARROW eexp(EDisjoint (cterm1, cterm2, eexp), s (LBRACKleft, RBRACKright))
+       | eexp COLON cexp                (EAnnot (eexp, cexp), s (eexpleft, cexpright))
+       | eexp MINUSMINUS cexp           (ECut (eexp, cexp), s (eexpleft, cexpright))
+       | CASE eexp OF barOpt branch branchs (ECase (eexp, branch :: branchs), s (CASEleft, branchsright))
+       | IF eexp THEN eexp ELSE eexp    (let
+                                             val loc = s (IFleft, eexp3right)
+                                         in
+                                             (ECase (eexp1, [((PCon (["Basis"], "True", NONE), loc), eexp2),
+                                                             ((PCon (["Basis"], "False", NONE), loc), eexp3)]), loc)
+                                         end)
+       | SYMBOL LARROW eexp SEMI eexp   (let
+                                             val loc = s (SYMBOLleft, eexp2right)
+                                             val e = (EVar (["Basis"], "bind"), loc)
+                                             val e = (EApp (e, eexp1), loc)
+                                         in
+                                             (EApp (e, (EAbs (SYMBOL, NONE, eexp2), loc)), loc)
+                                         end)
+
+eargs  : earg                           (earg)
+       | eargl                          (eargl)
+
+eargl  : eargp eargp                    (eargp1 o eargp2)
+       | eargp eargl                    (eargp o eargl)
+
+eargl2 :                                (fn x => x)
+       | eargp eargl2                   (eargp o eargl2)
+
+earg   : SYMBOL kcolon kind             (fn (e, t) =>
+                                            let
+                                                val loc = s (SYMBOLleft, kindright)
+                                            in
+                                                ((ECAbs (kcolon, SYMBOL, kind, e), loc),
+                                                 (TCFun (kcolon, SYMBOL, kind, t), loc))
+                                            end)
+       | SYMBOL COLON cexp              (fn (e, t) =>
+                                            let
+                                                val loc = s (SYMBOLleft, cexpright)
+                                            in
+                                                ((EAbs (SYMBOL, SOME cexp, e), loc),
+                                                 (TFun (cexp, t), loc))
+                                            end)
+       | UNDER COLON cexp               (fn (e, t) =>
+                                            let
+                                                val loc = s (UNDERleft, cexpright)
+                                            in
+                                                ((EAbs ("_", SOME cexp, e), loc),
+                                                 (TFun (cexp, t), loc))
+                                            end)
+       | eargp                          (eargp)
+
+eargp  : SYMBOL                         (fn (e, t) =>
+                                            let
+                                                val loc = s (SYMBOLleft, SYMBOLright)
+                                            in
+                                                ((EAbs (SYMBOL, NONE, e), loc),
+                                                 (TFun ((CWild (KType, loc), loc), t), loc))
+                                            end)
+       | UNIT                           (fn (e, t) =>
+                                            let
+                                                val loc = s (UNITleft, UNITright)
+                                                val t' = (TRecord (CRecord [], loc), loc)
+                                            in
+                                                ((EAbs ("_", SOME t', e), loc),
+                                                 (TFun (t', t), loc))
+                                            end)
+       | UNDER                          (fn (e, t) =>
+                                            let
+                                                val loc = s (UNDERleft, UNDERright)
+                                            in
+                                                ((EAbs ("_", NONE, e), loc),
+                                                 (TFun ((CWild (KType, loc), loc), t), loc))
+                                            end)
+       | LPAREN SYMBOL kcolon kind RPAREN(fn (e, t) =>
+                                             let
+                                                 val loc = s (LPARENleft, RPARENright)
+                                             in
+                                                 ((ECAbs (kcolon, SYMBOL, kind, e), loc),
+                                                  (TCFun (kcolon, SYMBOL, kind, t), loc))
+                                             end)
+       | LPAREN SYMBOL COLON cexp RPAREN  (fn (e, t) =>
+                                              let
+                                                  val loc = s (LPARENleft, RPARENright)
+                                              in
+                                                  ((EAbs (SYMBOL, SOME cexp, e), loc),
+                                                   (TFun (cexp, t), loc))
+                                              end)
+       | LPAREN UNDER COLON cexp RPAREN   (fn (e, t) =>
+                                            let
+                                                val loc = s (LPARENleft, RPARENright)
+                                            in
+                                                ((EAbs ("_", SOME cexp, e), loc),
+                                                 (TFun (cexp, t), loc))
+                                            end)
+
+eterm  : LPAREN eexp RPAREN             (#1 eexp, s (LPARENleft, RPARENright))
+       | LPAREN etuple RPAREN           (let
+                                             val loc = s (LPARENleft, RPARENright)
+                                         in
+                                             (ERecord (ListUtil.mapi (fn (i, e) =>
+                                                                         ((CName (Int.toString (i + 1)), loc),
+                                                                          e)) etuple), loc)
+                                         end)
+
+       | path                           (EVar path, s (pathleft, pathright))
+       | cpath                          (EVar cpath, s (cpathleft, cpathright))
+       | LBRACE rexp RBRACE             (ERecord rexp, s (LBRACEleft, RBRACEright))
+       | UNIT                           (ERecord [], s (UNITleft, UNITright))
+
+       | INT                            (EPrim (Prim.Int INT), s (INTleft, INTright))
+       | FLOAT                          (EPrim (Prim.Float FLOAT), s (FLOATleft, FLOATright))
+       | STRING                         (EPrim (Prim.String STRING), s (STRINGleft, STRINGright))
+
+       | path DOT idents                (let
+                                             val loc = s (pathleft, identsright)
+                                         in
+                                             foldl (fn (ident, e) =>
+                                                       (EField (e, ident), loc))
+                                                   (EVar path, s (pathleft, pathright)) idents
+                                         end)
+       | FOLD                           (EFold, s (FOLDleft, FOLDright))
+
+       | XML_BEGIN xml XML_END          (xml)
+       | XML_BEGIN XML_END              (EApp ((EVar (["Basis"], "cdata"), s (XML_BEGINleft, XML_ENDright)),
+                                               (EPrim (Prim.String ""), s (XML_BEGINleft, XML_ENDright))),
+                                         s (XML_BEGINleft, XML_ENDright))
+       | LPAREN query RPAREN            (query)
+       | UNDER                          (EWild, s (UNDERleft, UNDERright))
+
+idents : ident                          ([ident])
+       | ident DOT idents               (ident :: idents)
+
+etuple : eexp COMMA eexp                ([eexp1, eexp2])
+       | eexp COMMA etuple              (eexp :: etuple)
+
+branch : pat DARROW eexp                (pat, eexp)
+
+branchs:                                ([])
+       | BAR branch branchs             (branch :: branchs)
+
+pat    : pterm                          (pterm)
+       | cpath pterm                    (PCon (#1 cpath, #2 cpath, SOME pterm), s (cpathleft, ptermright))
+
+pterm  : SYMBOL                         (PVar SYMBOL, s (SYMBOLleft, SYMBOLright))
+       | cpath                          (PCon (#1 cpath, #2 cpath, NONE), s (cpathleft, cpathright))
+       | UNDER                          (PWild, s (UNDERleft, UNDERright))
+       | INT                            (PPrim (Prim.Int INT), s (INTleft, INTright))
+       | STRING                         (PPrim (Prim.String STRING), s (STRINGleft, STRINGright))
+       | LPAREN pat RPAREN              (pat)
+       | LBRACE RBRACE                  (PRecord ([], false), s (LBRACEleft, RBRACEright))
+       | UNIT                           (PRecord ([], false), s (UNITleft, UNITright))
+       | LBRACE rpat RBRACE             (PRecord rpat, s (LBRACEleft, RBRACEright))
+       | LPAREN ptuple RPAREN           (PRecord (ListUtil.mapi (fn (i, p) => (Int.toString (i + 1), p)) ptuple,
+                                                  false),
+                                         s (LPARENleft, RPARENright))
+
+rpat   : CSYMBOL EQ pat                 ([(CSYMBOL, pat)], false)
+       | INT EQ pat                     ([(Int64.toString INT, pat)], false)
+       | DOTDOTDOT                      ([], true)
+       | CSYMBOL EQ pat COMMA rpat      ((CSYMBOL, pat) :: #1 rpat, #2 rpat)
+       | INT EQ pat COMMA rpat          ((Int64.toString INT, pat) :: #1 rpat, #2 rpat)
+
+ptuple : pat COMMA pat                  ([pat1, pat2])
+       | pat COMMA ptuple               (pat :: ptuple)
+
+rexp   :                                ([])
+       | ident EQ eexp                  ([(ident, eexp)])
+       | ident EQ eexp COMMA rexp       ((ident, eexp) :: rexp)
+
+xml    : xmlOne xml                     (let
+                                             val pos = s (xmlOneleft, xmlright)
+                                         in
+                                             (EApp ((EApp (
+                                                     (EVar (["Basis"], "join"), pos),
+                                                  xmlOne), pos),
+                                                    xml), pos)
+                                         end)
+       | xmlOne                         (xmlOne)
+
+xmlOne : NOTAGS                         (EApp ((EVar (["Basis"], "cdata"), s (NOTAGSleft, NOTAGSright)),
+                                               (EPrim (Prim.String NOTAGS), s (NOTAGSleft, NOTAGSright))),
+                                         s (NOTAGSleft, NOTAGSright))
+       | tag DIVIDE GT                  (let
+                                             val pos = s (tagleft, GTright)
+                                         in
+                                             (EApp (#2 tag,
+                                                    (EApp ((EVar (["Basis"], "cdata"), pos),
+                                                           (EPrim (Prim.String ""), pos)),
+                                                     pos)), pos)
+                                         end)
+         
+       | tag GT xml END_TAG             (let
+                                             val pos = s (tagleft, GTright)
+                                         in
+                                             if #1 tag = END_TAG then
+                                                 if END_TAG = "lform" then
+                                                     (EApp ((EVar (["Basis"], "lform"), pos),
+                                                            xml), pos)
+                                                 else
+                                                     (EApp (#2 tag, xml), pos)
+                                             else
+                                                 (ErrorMsg.errorAt pos "Begin and end tags don't match.";
+                                                  (EFold, pos))
+                                         end)
+       | LBRACE eexp RBRACE             (eexp)
+
+tag    : tagHead attrs                  (let
+                                             val pos = s (tagHeadleft, attrsright)
+                                         in
+                                             (#1 tagHead,
+                                              (EApp ((EApp ((EVar (["Basis"], "tag"), pos),
+                                                            (ERecord attrs, pos)), pos),
+                                                     (EApp (#2 tagHead,
+                                                            (ERecord [], pos)), pos)),
+                                               pos))
+                                         end)
+
+tagHead: BEGIN_TAG                      (let
+                                             val pos = s (BEGIN_TAGleft, BEGIN_TAGright)
+                                         in
+                                             (BEGIN_TAG,
+                                              (EVar ([], BEGIN_TAG), pos))
+                                         end)
+       | tagHead LBRACE cexp RBRACE     (#1 tagHead, (ECApp (#2 tagHead, cexp), s (tagHeadleft, RBRACEright)))
+                                          
+attrs  :                                ([])
+       | attr attrs                     (attr :: attrs)
+
+attr   : SYMBOL EQ attrv                ((CName (capitalize SYMBOL), s (SYMBOLleft, SYMBOLright)), attrv)
+                
+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))
+       | LBRACE eexp RBRACE             (eexp)
+
+query  : query1 obopt lopt ofopt        (let
+                                             val loc = s (query1left, query1right)
+
+                                             val re = (ERecord [((CName "Rows", loc),
+                                                                 query1),
+                                                                ((CName "OrderBy", loc),
+                                                                 obopt),
+                                                                ((CName "Limit", loc),
+                                                                 lopt),
+                                                                ((CName "Offset", loc),
+                                                                 ofopt)], loc)
+                                         in
+                                             (EApp ((EVar (["Basis"], "sql_query"), loc), re), loc)
+                                         end)
+                
+query1 : SELECT select FROM tables wopt gopt hopt
+                                        (let
+                                             val loc = s (SELECTleft, tablesright)
+
+                                             val (sel, exps) =
+                                                 case select of
+                                                     Star => (map (fn (nm, _) =>
+                                                                      (nm, (CTuple [(CWild (KRecord (KType, loc), loc),
+                                                                                     loc),
+                                                                                    (CRecord [], loc)],
+                                                                            loc))) tables,
+                                                              [])
+                                                   | Items sis =>
+                                                     let
+                                                         val tabs = map (fn (nm, _) => (nm, (CRecord [], loc))) tables
+                                                         val (tabs, exps) = foldl (amend_select loc) (tabs, []) sis
+                                                     in
+                                                         (map (fn (nm, c) => (nm,
+                                                                              (CTuple [c,
+                                                                                       (CWild (KRecord (KType, loc), loc),
+                                                                                        loc)], loc))) tabs,
+                                                          exps)
+                                                     end
+
+                                             val sel = (CRecord sel, loc)
+
+                                             val grp = case gopt of
+                                                           NONE => (ECApp ((EVar (["Basis"], "sql_subset_all"), loc),
+                                                                           (CWild (KRecord (KRecord (KType, loc), loc),
+                                                                                   loc), loc)), loc)
+                                                         | SOME gis =>
+                                                           let
+                                                               val tabs = map (fn (nm, _) =>
+                                                                                  (nm, (CRecord [], loc))) tables
+                                                               val tabs = foldl (amend_group loc) tabs gis
+
+                                                               val tabs = map (fn (nm, c) =>
+                                                                                  (nm,
+                                                                                   (CTuple [c,
+                                                                                            (CWild (KRecord (KType, loc),
+                                                                                                    loc),
+                                                                                             loc)], loc))) tabs
+                                                           in
+                                                               (ECApp ((EVar (["Basis"], "sql_subset"), loc),
+                                                                       (CRecord tabs, loc)), loc)
+                                                           end
+
+                                             val e = (EVar (["Basis"], "sql_query1"), loc)
+                                             val re = (ERecord [((CName "From", loc),
+                                                                 (ERecord tables, loc)),
+                                                                ((CName "Where", loc),
+                                                                 wopt),
+                                                                ((CName "GroupBy", loc),
+                                                                 grp),
+                                                                ((CName "Having", loc),
+                                                                 hopt),
+                                                                ((CName "SelectFields", loc),
+                                                                 (ECApp ((EVar (["Basis"], "sql_subset"), loc),
+                                                                         sel), loc)),
+                                                                ((CName "SelectExps", loc),
+                                                                 (ERecord exps, loc))], loc)
+
+                                             val e = (EApp (e, re), loc)
+                                         in
+                                             e
+                                         end)
+       | query1 UNION query1            (sql_relop ("union", query11, query12, s (query11left, query12right)))
+       | query1 INTERSECT query1        (sql_relop ("intersect", query11, query12, s (query11left, query12right)))
+       | query1 EXCEPT query1           (sql_relop ("except", query11, query12, s (query11left, query12right)))
+
+tables : table                          ([table])
+       | table COMMA tables             (table :: tables)
+
+tname  : CSYMBOL                        (CName CSYMBOL, s (CSYMBOLleft, CSYMBOLright))
+       | LBRACE cexp RBRACE             (cexp)
+
+table  : SYMBOL                         ((CName (capitalize SYMBOL), s (SYMBOLleft, SYMBOLright)),
+                                         (EVar ([], SYMBOL), s (SYMBOLleft, SYMBOLright)))
+       | SYMBOL AS tname                (tname, (EVar ([], SYMBOL), s (SYMBOLleft, SYMBOLright)))
+       | LBRACE LBRACE eexp RBRACE RBRACE AS tname    (tname, eexp)
+
+tident : SYMBOL                         (CName (capitalize SYMBOL), s (SYMBOLleft, SYMBOLright))
+       | CSYMBOL                        (CName CSYMBOL, s (CSYMBOLleft, CSYMBOLright))
+       | LBRACE LBRACE cexp RBRACE RBRACE (cexp)
+
+fident : CSYMBOL                        (CName CSYMBOL, s (CSYMBOLleft, CSYMBOLright))
+       | LBRACE cexp RBRACE             (cexp)
+
+seli   : tident DOT fident              (Field (tident, fident))
+       | sqlexp AS fident               (Exp (fident, sqlexp))
+
+selis  : seli                           ([seli])
+       | seli COMMA selis               (seli :: selis)
+
+select : STAR                           (Star)
+       | selis                          (Items selis)
+
+sqlexp : TRUE                           (sql_inject (EVar (["Basis"], "True"),
+                                                     EVar (["Basis"], "sql_bool"),
+                                                     s (TRUEleft, TRUEright)))
+       | FALSE                          (sql_inject (EVar (["Basis"], "False"),
+                                                     EVar (["Basis"], "sql_bool"),
+                                                     s (FALSEleft, FALSEright)))
+
+       | INT                            (sql_inject (EPrim (Prim.Int INT),
+                                                     EVar (["Basis"], "sql_int"),
+                                                     s (INTleft, INTright)))
+       | FLOAT                          (sql_inject (EPrim (Prim.Float FLOAT),
+                                                     EVar (["Basis"], "sql_float"),
+                                                     s (FLOATleft, FLOATright)))
+       | STRING                         (sql_inject (EPrim (Prim.String STRING),
+                                                     EVar (["Basis"], "sql_string"),
+                                                     s (STRINGleft, STRINGright)))
+
+       | tident DOT fident              (let
+                                             val loc = s (tidentleft, fidentright)
+                                             val e = (EVar (["Basis"], "sql_field"), loc)
+                                             val e = (ECApp (e, tident), loc)
+                                         in
+                                             (ECApp (e, fident), loc)
+                                         end)
+       | CSYMBOL                         (let
+                                             val loc = s (CSYMBOLleft, CSYMBOLright)
+                                             val e = (EVar (["Basis"], "sql_exp"), loc)
+                                         in
+                                             (ECApp (e, (CName CSYMBOL, loc)), loc)
+                                         end)
+
+       | sqlexp EQ sqlexp               (sql_compare ("eq", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
+       | sqlexp NE sqlexp               (sql_compare ("ne", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
+       | sqlexp LT sqlexp               (sql_compare ("lt", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
+       | sqlexp LE sqlexp               (sql_compare ("le", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
+       | sqlexp GT sqlexp               (sql_compare ("gt", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
+       | sqlexp GE sqlexp               (sql_compare ("ge", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
+
+       | sqlexp CAND sqlexp             (sql_binary ("and", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
+       | sqlexp OR sqlexp               (sql_binary ("or", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
+       | NOT sqlexp                     (sql_unary ("not", sqlexp, s (NOTleft, sqlexpright)))
+
+       | LBRACE eexp RBRACE             (sql_inject (#1 eexp,
+                                                     EWild,
+                                                     s (LBRACEleft, RBRACEright)))
+       | LPAREN sqlexp RPAREN           (sqlexp)
+
+       | COUNT LPAREN STAR RPAREN       (let
+                                             val loc = s (COUNTleft, RPARENright)
+                                         in
+                                             (EApp ((EVar (["Basis"], "sql_count"), loc),
+                                                    (ERecord [], loc)), loc)
+                                         end)
+       | sqlagg LPAREN sqlexp RPAREN    (let
+                                             val loc = s (sqlaggleft, RPARENright)
+
+                                             val e = (EApp ((EVar (["Basis"], "sql_" ^ sqlagg), loc),
+                                                            (EWild, loc)), loc)
+                                             val e = (EApp ((EVar (["Basis"], "sql_aggregate"), loc),
+                                                            e), loc)
+                                         in
+                                             (EApp (e, sqlexp), loc)
+                                         end)
+
+wopt   :                                (sql_inject (EVar (["Basis"], "True"),
+                                                     EVar (["Basis"], "sql_bool"),
+                                                     dummy))
+       | CWHERE sqlexp                  (sqlexp)
+
+groupi : tident DOT fident              (GField (tident, fident))
+
+groupis: groupi                         ([groupi])
+       | groupi COMMA groupis           (groupi :: groupis)
+
+gopt   :                                (NONE)
+       | GROUP BY groupis               (SOME groupis)
+
+hopt   :                                (sql_inject (EVar (["Basis"], "True"),
+                                                     EVar (["Basis"], "sql_bool"),
+                                                     dummy))
+       | HAVING sqlexp                  (sqlexp)
+
+obopt  :                                (ECApp ((EVar (["Basis"], "sql_order_by_Nil"), dummy),
+                                                (CWild (KRecord (KType, dummy), dummy), dummy)),
+                                         dummy)
+       | ORDER BY obexps                (obexps)
+
+obexps : sqlexp                         (let
+                                             val loc = s (sqlexpleft, sqlexpright)
+
+                                             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)
+                                         in
+                                             (EApp (e, e'), loc)
+                                         end)
+       | sqlexp COMMA obexps            (let
+                                             val loc = s (sqlexpleft, obexpsright)
+
+                                             val e = (EApp ((EVar (["Basis"], "sql_order_by_Cons"), loc),
+                                                            sqlexp), loc)
+                                         in
+                                             (EApp (e, obexps), loc)
+                                         end)
+
+lopt   :                                 (EVar (["Basis"], "sql_no_limit"), dummy)
+       | LIMIT ALL                       (EVar (["Basis"], "sql_no_limit"), dummy)
+       | LIMIT sqlint                    (let
+                                              val loc = s (LIMITleft, sqlintright)
+                                          in
+                                              (EApp ((EVar (["Basis"], "sql_limit"), loc), sqlint), loc)
+                                          end)
+
+ofopt  :                                 (EVar (["Basis"], "sql_no_offset"), dummy)
+       | OFFSET sqlint                   (let
+                                              val loc = s (OFFSETleft, sqlintright)
+                                          in
+                                              (EApp ((EVar (["Basis"], "sql_offset"), loc), sqlint), loc)
+                                          end)
+
+sqlint : INT                             (EPrim (Prim.Int INT), s (INTleft, INTright))
+       | LBRACE eexp RBRACE              (eexp)
+
+sqlagg : AVG                             ("avg")
+       | SUM                             ("sum")
+       | MIN                             ("min")
+       | MAX                             ("max")