Add SQL arithmetic operators

2 files changed, 43 insertions, 49 deletions

diff --git a/src/monoize.sml b/src/monoize.sml
index cd20e366..1880c57d 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -165,14 +165,14 @@ fun monoType env =
                     (L'.TFfi ("Basis", "string"), loc)
                   | L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_binary"), _), _), _), _), _), _) =>
                     (L'.TFfi ("Basis", "string"), loc)
-                  | L.CFfi ("Basis", "sql_comparison") =>
-                    (L'.TFfi ("Basis", "string"), loc)
                   | L.CApp ((L.CFfi ("Basis", "sql_aggregate"), _), t) =>
                     (L'.TFfi ("Basis", "string"), loc)
                   | L.CApp ((L.CFfi ("Basis", "sql_summable"), _), _) =>
                     (L'.TRecord [], loc)
                   | L.CApp ((L.CFfi ("Basis", "sql_maxable"), _), _) =>
                     (L'.TRecord [], loc)
+                  | L.CApp ((L.CFfi ("Basis", "sql_arith"), _), _) =>
+                    (L'.TRecord [], loc)
                   | L.CApp ((L.CFfi ("Basis", "sql_nfunc"), _), _) =>
                     (L'.TFfi ("Basis", "string"), loc)
 
@@ -1369,19 +1369,34 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                  fm)
             end
 
-          | L.EFfi ("Basis", "sql_eq") =>
+          | L.ECApp ((L.EFfi ("Basis", "sql_eq"), _), _) =>
             ((L'.EPrim (Prim.String "="), loc), fm)
-          | L.EFfi ("Basis", "sql_ne") =>
+          | L.ECApp ((L.EFfi ("Basis", "sql_ne"), _), _) =>
             ((L'.EPrim (Prim.String "<>"), loc), fm)
-          | L.EFfi ("Basis", "sql_lt") =>
+          | L.ECApp ((L.EFfi ("Basis", "sql_lt"), _), _) =>
             ((L'.EPrim (Prim.String "<"), loc), fm)
-          | L.EFfi ("Basis", "sql_le") =>
+          | L.ECApp ((L.EFfi ("Basis", "sql_le"), _), _) =>
             ((L'.EPrim (Prim.String "<="), loc), fm)
-          | L.EFfi ("Basis", "sql_gt") =>
+          | L.ECApp ((L.EFfi ("Basis", "sql_gt"), _), _) =>
             ((L'.EPrim (Prim.String ">"), loc), fm)
-          | L.EFfi ("Basis", "sql_ge") =>
+          | L.ECApp ((L.EFfi ("Basis", "sql_ge"), _), _) =>
             ((L'.EPrim (Prim.String ">="), loc), fm)
 
+          | L.ECApp ((L.EFfi ("Basis", "sql_plus"), _), _) =>
+            ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFfi ("Basis", "string"), loc),
+                       (L'.EPrim (Prim.String "+"), loc)), loc), fm)
+          | L.ECApp ((L.EFfi ("Basis", "sql_minus"), _), _) =>
+            ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFfi ("Basis", "string"), loc),
+                       (L'.EPrim (Prim.String "-"), loc)), loc), fm)
+          | L.ECApp ((L.EFfi ("Basis", "sql_times"), _), _) =>
+            ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFfi ("Basis", "string"), loc),
+                       (L'.EPrim (Prim.String "*"), loc)), loc), fm)
+          | L.ECApp ((L.EFfi ("Basis", "sql_div"), _), _) =>
+            ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFfi ("Basis", "string"), loc),
+                       (L'.EPrim (Prim.String "/"), loc)), loc), fm)
+          | L.EFfi ("Basis", "sql_mod") =>
+            ((L'.EPrim (Prim.String "%"), loc), fm)
+
           | L.ECApp (
             (L.ECApp (
              (L.ECApp (
@@ -1407,6 +1422,9 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                  fm)
             end
           | L.EFfi ("Basis", "sql_not") => ((L'.EPrim (Prim.String "NOT"), loc), fm)
+          | L.ECApp ((L.EFfi ("Basis", "sql_neg"), _), _) =>
+            ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFfi ("Basis", "string"), loc),
+                       (L'.EPrim (Prim.String "-"), loc)), loc), fm)
 
           | L.ECApp (
             (L.ECApp (
@@ -1444,32 +1462,6 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
             (L.ECApp (
              (L.ECApp (
               (L.ECApp (
-               (L.EFfi ("Basis", "sql_comparison"), _),
-               _), _),
-              _), _),
-             _), _),
-            _) =>
-            let
-                val s = (L'.TFfi ("Basis", "string"), loc)
-                fun sc s = (L'.EPrim (Prim.String s), loc)
-            in
-                ((L'.EAbs ("c", s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc),
-                           (L'.EAbs ("e1", s, (L'.TFun (s, s), loc),
-                                     (L'.EAbs ("e2", s, s,
-                                               strcat loc [sc "(",
-                                                           (L'.ERel 1, loc),
-                                                           sc " ",
-                                                           (L'.ERel 2, loc),
-                                                           sc " ",
-                                                           (L'.ERel 0, loc),
-                                                           sc ")"]), loc)), loc)), loc),
-                 fm)
-            end
-
-          | L.ECApp (
-            (L.ECApp (
-             (L.ECApp (
-              (L.ECApp (
                (L.ECApp (
                 (L.ECApp (
                  (L.ECApp (
@@ -1566,6 +1558,9 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                        (L'.EPrim (Prim.String "SUM"), loc)), loc),
              fm)
 
+          | L.EFfi ("Basis", "sql_arith_int") => ((L'.ERecord [], loc), fm)
+          | L.EFfi ("Basis", "sql_arith_float") => ((L'.ERecord [], loc), fm)
+
           | L.EFfi ("Basis", "sql_maxable_int") => ((L'.ERecord [], loc), fm)
           | L.EFfi ("Basis", "sql_maxable_float") => ((L'.ERecord [], loc), fm)
           | L.EFfi ("Basis", "sql_maxable_string") => ((L'.ERecord [], loc), fm)
diff --git a/src/urweb.grm b/src/urweb.grm
index 3d77905e..7798b018 100644
--- a/src/urweb.grm
+++ b/src/urweb.grm
@@ -119,15 +119,6 @@ fun amend_group loc (gi, tabs) =
 fun sql_inject (v, loc) =
     (EApp ((EVar (["Basis"], "sql_inject", Infer), loc), (v, loc)), loc)
 
-fun sql_compare (oper, sqlexp1, sqlexp2, loc) =
-    let
-        val e = (EVar (["Basis"], "sql_comparison", Infer), loc)
-        val e = (EApp (e, (EVar (["Basis"], "sql_" ^ oper, Infer), 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", Infer), loc)
@@ -1239,16 +1230,24 @@ sqlexp : TRUE                           (sql_inject (EVar (["Basis"], "True", In
 
        | LBRACE eexp RBRACE             (eexp)
 
-       | 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 EQ sqlexp               (sql_binary ("eq", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
+       | sqlexp NE sqlexp               (sql_binary ("ne", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
+       | sqlexp LT sqlexp               (sql_binary ("lt", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
+       | sqlexp LE sqlexp               (sql_binary ("le", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
+       | sqlexp GT sqlexp               (sql_binary ("gt", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
+       | sqlexp GE sqlexp               (sql_binary ("ge", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
+
+       | sqlexp PLUS sqlexp             (sql_binary ("plus", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
+       | sqlexp MINUS sqlexp            (sql_binary ("minus", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
+       | sqlexp STAR sqlexp             (sql_binary ("times", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
+       | sqlexp DIVIDE sqlexp           (sql_binary ("div", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
+       | sqlexp MOD sqlexp              (sql_binary ("mod", 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)))
+       | MINUS sqlexp                   (sql_unary ("neg", sqlexp, s (MINUSleft, sqlexpright)))
 
        | sqlexp IS NULL                 (let
                                              val loc = s (sqlexpleft, NULLright)