Mercurial > urweb

comparison src/urweb.grm @ 2122:8cf40452c900

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Some new infix operators, contributed by Gabriel Riba
author Adam Chlipala <adam@chlipala.net>
date Thu, 05 Mar 2015 14:50:31 -0500
parents c647f113ba3e
children 39bd1d4007a9
comparison
equal deleted inserted replaced
2121:f89be9cd2087 2122:8cf40452c900
214 val e = (EApp (e, e1), loc) 214 val e = (EApp (e, e1), loc)
215 in 215 in
216 (EApp (e, e2), loc) 216 (EApp (e, e2), loc)
217 end 217 end
218 218
219 fun top_binop (oper, e1, e2, loc) =
220 let
221 val e = (EVar (["Top"], oper, Infer), loc)
222 val e = (EApp (e, e1), loc)
223 in
224 (EApp (e, e2), loc)
225 end
226
219 val inDml = ref false 227 val inDml = ref false
220 228
221 fun tagIn bt = 229 fun tagIn bt =
222 case bt of 230 case bt of
223 "table" => "tabl" 231 "table" => "tabl"
393 | CURRENT_TIMESTAMP 401 | CURRENT_TIMESTAMP
394 | NE | LT | LE | GT | GE 402 | NE | LT | LE | GT | GE
395 | CCONSTRAINT | UNIQUE | CHECK | PRIMARY | FOREIGN | KEY | ON | NO | ACTION | RESTRICT | CASCADE | REFERENCES 403 | CCONSTRAINT | UNIQUE | CHECK | PRIMARY | FOREIGN | KEY | ON | NO | ACTION | RESTRICT | CASCADE | REFERENCES
396 | JOIN | INNER | CROSS | OUTER | LEFT | RIGHT | FULL 404 | JOIN | INNER | CROSS | OUTER | LEFT | RIGHT | FULL
397 | CIF | CTHEN | CELSE 405 | CIF | CTHEN | CELSE
406 | FWDAPP | REVAPP | COMPOSE | ANDTHEN
407 | BACKTICK_PATH of string
398 408
399 %nonterm 409 %nonterm
400 file of decl list 410 file of decl list
401 | decls of decl list 411 | decls of decl list
402 | decl of decl list 412 | decl of decl list
563 %right JOIN INNER CROSS OUTER LEFT RIGHT FULL 573 %right JOIN INNER CROSS OUTER LEFT RIGHT FULL
564 %right OR 574 %right OR
565 %right CAND 575 %right CAND
566 %nonassoc EQ NE LT LE GT GE IS 576 %nonassoc EQ NE LT LE GT GE IS
567 %right ARROW 577 %right ARROW
578
579 %left REVAPP
580 %right FWDAPP
581 %left BACKTICK_PATH
582 %right COMPOSE ANDTHEN
583
568 %right CARET PLUSPLUS 584 %right CARET PLUSPLUS
569 %left MINUSMINUS MINUSMINUSMINUS 585 %left MINUSMINUS MINUSMINUSMINUS
570 %left PLUS MINUS 586 %left PLUS MINUS
571 %left STAR DIVIDE MOD 587 %left STAR DIVIDE MOD
572 %left NOT 588 %left NOT
1199 1215
1200 | eexp LT eexp (native_op ("lt", eexp1, eexp2, s (eexp1left, eexp2right))) 1216 | eexp LT eexp (native_op ("lt", eexp1, eexp2, s (eexp1left, eexp2right)))
1201 | eexp LE eexp (native_op ("le", eexp1, eexp2, s (eexp1left, eexp2right))) 1217 | eexp LE eexp (native_op ("le", eexp1, eexp2, s (eexp1left, eexp2right)))
1202 | eexp GT eexp (native_op ("gt", eexp1, eexp2, s (eexp1left, eexp2right))) 1218 | eexp GT eexp (native_op ("gt", eexp1, eexp2, s (eexp1left, eexp2right)))
1203 | eexp GE eexp (native_op ("ge", eexp1, eexp2, s (eexp1left, eexp2right))) 1219 | eexp GE eexp (native_op ("ge", eexp1, eexp2, s (eexp1left, eexp2right)))
1220
1221 | eexp FWDAPP eexp (EApp (eexp1, eexp2), s (eexp1left, eexp2right))
1222 | eexp REVAPP eexp (EApp (eexp2, eexp1), s (eexp1left, eexp2right))
1223 | eexp COMPOSE eexp (top_binop ("compose", eexp1, eexp2, s (eexp1left, eexp2right)))
1224 | eexp ANDTHEN eexp (top_binop ("compose", eexp2, eexp1, s (eexp1left, eexp2right)))
1225 | eexp BACKTICK_PATH eexp (let
1226 val path = String.tokens (fn ch => ch = #".") BACKTICK_PATH
1227 val pathModules = List.take (path, (length path -1))
1228 val pathOp = List.last path
1229
1230 val e = (EVar (pathModules, pathOp, Infer)
1231 , s (BACKTICK_PATHleft, BACKTICK_PATHright))
1232 val e = (EApp (e, eexp1), s (eexp1left, BACKTICK_PATHright))
1233 in
1234 (EApp (e, eexp2), s (eexp1left, eexp2right))
1235 end)
1204 1236
1205 | eexp ANDALSO eexp (let 1237 | eexp ANDALSO eexp (let
1206 val loc = s (eexp1left, eexp2right) 1238 val loc = s (eexp1left, eexp2right)
1207 in 1239 in
1208 (ECase (eexp1, [((PCon (["Basis"], "True", NONE), loc), 1240 (ECase (eexp1, [((PCon (["Basis"], "True", NONE), loc),