diff options
author | Adam Chlipala <adamc@hcoop.net> | 2008-12-09 14:41:19 -0500 |
---|---|---|
committer | Adam Chlipala <adamc@hcoop.net> | 2008-12-09 14:41:19 -0500 |
commit | 5108a7e86734b335b65b9efd60a7f2f2797b602b (patch) | |
tree | 1bdcd341e3e43df6833972a5384b8552f8343039 /src | |
parent | 55fefa6122803e9739e9e71f1d50eae671665df4 (diff) |
Add SQL arithmetic operators
Diffstat (limited to 'src')
-rw-r--r-- | src/monoize.sml | 63 | ||||
-rw-r--r-- | src/urweb.grm | 29 |
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) |