comparison src/urweb.grm @ 559:5d494183ca89

Add SQL arithmetic operators
author Adam Chlipala <adamc@hcoop.net>
date Tue, 09 Dec 2008 14:41:19 -0500
parents 4154b4dc62c6
children 44958d74c43f
comparison
equal deleted inserted replaced
558:390cba747188 559:5d494183ca89
116 tabs 116 tabs
117 end 117 end
118 118
119 fun sql_inject (v, loc) = 119 fun sql_inject (v, loc) =
120 (EApp ((EVar (["Basis"], "sql_inject", Infer), loc), (v, loc)), loc) 120 (EApp ((EVar (["Basis"], "sql_inject", Infer), loc), (v, loc)), loc)
121
122 fun sql_compare (oper, sqlexp1, sqlexp2, loc) =
123 let
124 val e = (EVar (["Basis"], "sql_comparison", Infer), loc)
125 val e = (EApp (e, (EVar (["Basis"], "sql_" ^ oper, Infer), loc)), loc)
126 val e = (EApp (e, sqlexp1), loc)
127 in
128 (EApp (e, sqlexp2), loc)
129 end
130 121
131 fun sql_binary (oper, sqlexp1, sqlexp2, loc) = 122 fun sql_binary (oper, sqlexp1, sqlexp2, loc) =
132 let 123 let
133 val e = (EVar (["Basis"], "sql_binary", Infer), loc) 124 val e = (EVar (["Basis"], "sql_binary", Infer), loc)
134 val e = (EApp (e, (EVar (["Basis"], "sql_" ^ oper, Infer), loc)), loc) 125 val e = (EApp (e, (EVar (["Basis"], "sql_" ^ oper, Infer), loc)), loc)
1237 end 1228 end
1238 end) 1229 end)
1239 1230
1240 | LBRACE eexp RBRACE (eexp) 1231 | LBRACE eexp RBRACE (eexp)
1241 1232
1242 | sqlexp EQ sqlexp (sql_compare ("eq", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right))) 1233 | sqlexp EQ sqlexp (sql_binary ("eq", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
1243 | sqlexp NE sqlexp (sql_compare ("ne", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right))) 1234 | sqlexp NE sqlexp (sql_binary ("ne", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
1244 | sqlexp LT sqlexp (sql_compare ("lt", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right))) 1235 | sqlexp LT sqlexp (sql_binary ("lt", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
1245 | sqlexp LE sqlexp (sql_compare ("le", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right))) 1236 | sqlexp LE sqlexp (sql_binary ("le", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
1246 | sqlexp GT sqlexp (sql_compare ("gt", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right))) 1237 | sqlexp GT sqlexp (sql_binary ("gt", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
1247 | sqlexp GE sqlexp (sql_compare ("ge", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right))) 1238 | sqlexp GE sqlexp (sql_binary ("ge", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
1239
1240 | sqlexp PLUS sqlexp (sql_binary ("plus", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
1241 | sqlexp MINUS sqlexp (sql_binary ("minus", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
1242 | sqlexp STAR sqlexp (sql_binary ("times", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
1243 | sqlexp DIVIDE sqlexp (sql_binary ("div", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
1244 | sqlexp MOD sqlexp (sql_binary ("mod", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
1248 1245
1249 | sqlexp CAND sqlexp (sql_binary ("and", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right))) 1246 | sqlexp CAND sqlexp (sql_binary ("and", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
1250 | sqlexp OR sqlexp (sql_binary ("or", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right))) 1247 | sqlexp OR sqlexp (sql_binary ("or", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
1248
1251 | NOT sqlexp (sql_unary ("not", sqlexp, s (NOTleft, sqlexpright))) 1249 | NOT sqlexp (sql_unary ("not", sqlexp, s (NOTleft, sqlexpright)))
1250 | MINUS sqlexp (sql_unary ("neg", sqlexp, s (MINUSleft, sqlexpright)))
1252 1251
1253 | sqlexp IS NULL (let 1252 | sqlexp IS NULL (let
1254 val loc = s (sqlexpleft, NULLright) 1253 val loc = s (sqlexpleft, NULLright)
1255 in 1254 in
1256 (EApp ((EVar (["Basis"], "sql_is_null", Infer), loc), 1255 (EApp ((EVar (["Basis"], "sql_is_null", Infer), loc),