SELECT DISTINCT; eta expansion during Cjrization

6 files changed, 43 insertions, 10 deletions

diff --git a/src/cjrize.sml b/src/cjrize.sml
index 6a79b4e6..bf814266 100644
--- a/src/cjrize.sml
+++ b/src/cjrize.sml
@@ -520,9 +520,14 @@ fun cifyDecl ((d, loc), sm) =
                                           in
                                               ((ax, dom) :: args, t, e)
                                           end
-                                        | (L'.TFun _, _) =>
-                                          (ErrorMsg.errorAt loc "Function isn't explicit at code generation";
-                                           ([], tAll, eAll))
+                                        | (L'.TFun (dom, ran), _) =>
+                                          let
+                                              val e = MonoEnv.liftExpInExp 0 eAll
+                                              val e = (L.EApp (e, (L.ERel 0, loc)), loc)
+                                              val (args, t, e) = unravel (ran, e)
+                                          in
+                                              (("x", dom) :: args, t, e)
+                                          end
                                         | _ => ([], tAll, eAll)
 
                                   val (args, ran, e) = unravel (t, e)
diff --git a/src/elisp/urweb-mode.el b/src/elisp/urweb-mode.el
index 7f4b0dee..42846e6c 100644
--- a/src/elisp/urweb-mode.el
+++ b/src/elisp/urweb-mode.el
@@ -144,7 +144,7 @@ See doc for the variable `urweb-mode-info'."
   "A regexp that matches any non-SQL keywords of Ur/Web.")
 
 (defconst urweb-sql-keywords-regexp
-  (urweb-syms-re "SELECT" "FROM" "AS" "WHERE" "SQL" "GROUP" "ORDER" "BY"
+  (urweb-syms-re "SELECT" "DISTINCT" "FROM" "AS" "WHERE" "SQL" "GROUP" "ORDER" "BY"
                  "HAVING" "LIMIT" "OFFSET" "ALL" "UNION" "INTERSECT" "EXCEPT"
                  "TRUE" "FALSE" "AND" "OR" "NOT" "COUNT" "AVG" "SUM" "MIN" "MAX"
                  "ASC" "DESC" "INSERT" "INTO" "VALUES" "UPDATE" "SET" "DELETE"
diff --git a/src/mono_env.sig b/src/mono_env.sig
index c59596ae..c5ca7c0b 100644
--- a/src/mono_env.sig
+++ b/src/mono_env.sig
@@ -48,5 +48,7 @@ signature MONO_ENV = sig
     val declBinds : env -> Mono.decl -> env
     val patBinds : env -> Mono.pat -> env
     val patBindsN : Mono.pat -> int
+
+    val liftExpInExp : int -> Mono.exp -> Mono.exp
                                                  
 end
diff --git a/src/monoize.sml b/src/monoize.sml
index b80b4a65..a01f953f 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -1771,6 +1771,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
             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)
                 fun gf s = (L'.EField ((L'.ERel 0, loc), s), loc)
 
@@ -1806,7 +1807,8 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                                         (fn ((x, _), (y, _)) => String.compare (x, y) = GREATER) sexps
                     in
                         ((L'.EAbs ("r",
-                                   (L'.TRecord [("From", s),
+                                   (L'.TRecord [("Distinct", b),
+                                                ("From", s),
                                                 ("Where", s),
                                                 ("GroupBy", un),
                                                 ("Having", s),
@@ -1815,6 +1817,22 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                                     loc),
                                    s,
                                    strcat [sc "SELECT ",
+                                           (L'.ECase (gf "Distinct",
+                                                      [((L'.PCon (L'.Enum,
+                                                                  L'.PConFfi {mod = "Basis",
+                                                                              datatyp = "bool",
+                                                                              con = "True",
+                                                                              arg = NONE},
+                                                                  NONE), loc),
+                                                        (L'.EPrim (Prim.String "DISTINCT "), loc)),
+                                                       ((L'.PCon (L'.Enum,
+                                                                  L'.PConFfi {mod = "Basis",
+                                                                              datatyp = "bool",
+                                                                              con = "False",
+                                                                              arg = NONE},
+                                                                  NONE), loc),
+                                                        (L'.EPrim (Prim.String ""), loc))],
+                                                      {disc = b, result = s}), loc),
                                            strcatComma (map (fn (x, t) =>
                                                                 strcat [
                                                                 (L'.EField (gf "SelectExps", x), loc),
diff --git a/src/urweb.grm b/src/urweb.grm
index 111b1854..edd93d96 100644
--- a/src/urweb.grm
+++ b/src/urweb.grm
@@ -208,7 +208,7 @@ fun patType loc (p : pat) =
  | NOTAGS of string 
  | BEGIN_TAG of string | END_TAG of string
 
- | SELECT | FROM | AS | CWHERE | GROUP | ORDER | BY | HAVING
+ | SELECT | DISTINCT | FROM | AS | CWHERE | GROUP | ORDER | BY | HAVING
  | UNION | INTERSECT | EXCEPT
  | LIMIT | OFFSET | ALL
  | TRUE | FALSE | CAND | OR | NOT
@@ -314,6 +314,7 @@ fun patType loc (p : pat) =
 
  | query of exp
  | query1 of exp
+ | dopt of exp
  | tables of con list * exp
  | fitem of con list * exp
  | tname of con
@@ -625,7 +626,7 @@ pmodes :                                ([])
 commaOpt:                               ()
         | COMMA                         ()
 
-pkopt  :                                (EVar (["Basis"], "no_primary_key", Infer), ErrorMsg.dummySpan)
+pkopt  :                                (EVar (["Basis"], "no_primary_key", Infer), dummy)
        | PRIMARY KEY tnames             (let
                                              val loc = s (PRIMARYleft, tnamesright)
 
@@ -1410,8 +1411,12 @@ query  : query1 obopt lopt ofopt        (let
                                          in
                                              (EApp ((EVar (["Basis"], "sql_query", Infer), loc), re), loc)
                                          end)
-                
-query1 : SELECT select FROM tables wopt gopt hopt
+
+dopt   :                                (EVar (["Basis"], "False", Infer), dummy)
+       | DISTINCT                       (EVar (["Basis"], "True", Infer),
+                                         s (DISTINCTleft, DISTINCTright))
+
+query1 : SELECT dopt select FROM tables wopt gopt hopt
                                         (let
                                              val loc = s (SELECTleft, tablesright)
 
@@ -1460,7 +1465,9 @@ query1 : SELECT select FROM tables wopt gopt hopt
                                                            end
 
                                              val e = (EVar (["Basis"], "sql_query1", Infer), loc)
-                                             val re = (ERecord [((CName "From", loc),
+                                             val re = (ERecord [((CName "Distinct", loc),
+                                                                 dopt),
+                                                                ((CName "From", loc),
                                                                  #2 tables),
                                                                 ((CName "Where", loc),
                                                                  wopt),
diff --git a/src/urweb.lex b/src/urweb.lex
index 38816a3c..4e572009 100644
--- a/src/urweb.lex
+++ b/src/urweb.lex
@@ -408,6 +408,7 @@ notags = [^<{\n]+;
 <INITIAL> "Unit"      => (Tokens.KUNIT (pos yypos, pos yypos + size yytext));
 
 <INITIAL> "SELECT"    => (Tokens.SELECT (pos yypos, pos yypos + size yytext));
+<INITIAL> "DISTINCT"  => (Tokens.DISTINCT (pos yypos, pos yypos + size yytext));
 <INITIAL> "FROM"      => (Tokens.FROM (pos yypos, pos yypos + size yytext));
 <INITIAL> "AS"        => (Tokens.AS (pos yypos, pos yypos + size yytext));
 <INITIAL> "WHERE"     => (Tokens.CWHERE (pos yypos, pos yypos + size yytext));