diff src/urweb.grm @ 2122:8cf40452c900

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
line wrap: on
line diff
--- a/src/urweb.grm	Tue Mar 03 15:55:00 2015 -0500
+++ b/src/urweb.grm	Thu Mar 05 14:50:31 2015 -0500
@@ -216,6 +216,14 @@
         (EApp (e, e2), loc)
     end
 
+fun top_binop (oper, e1, e2, loc) =
+    let
+        val e = (EVar (["Top"], oper, Infer), loc)
+        val e = (EApp (e, e1), loc)
+    in
+        (EApp (e, e2), loc)
+    end
+
 val inDml = ref false
 
 fun tagIn bt =
@@ -395,6 +403,8 @@
  | CCONSTRAINT | UNIQUE | CHECK | PRIMARY | FOREIGN | KEY | ON | NO | ACTION | RESTRICT | CASCADE | REFERENCES
  | JOIN | INNER | CROSS | OUTER | LEFT | RIGHT | FULL
  | CIF | CTHEN | CELSE
+ | FWDAPP | REVAPP | COMPOSE | ANDTHEN
+ | BACKTICK_PATH of string
 
 %nonterm
    file of decl list
@@ -565,6 +575,12 @@
 %right CAND
 %nonassoc EQ NE LT LE GT GE IS
 %right ARROW
+
+%left REVAPP
+%right FWDAPP
+%left BACKTICK_PATH
+%right COMPOSE ANDTHEN
+
 %right CARET PLUSPLUS
 %left MINUSMINUS MINUSMINUSMINUS
 %left PLUS MINUS
@@ -1202,6 +1218,22 @@
        | eexp GT eexp                   (native_op ("gt", eexp1, eexp2, s (eexp1left, eexp2right)))
        | eexp GE eexp                   (native_op ("ge", eexp1, eexp2, s (eexp1left, eexp2right)))
 
+       | eexp FWDAPP eexp               (EApp (eexp1, eexp2), s (eexp1left, eexp2right))
+       | eexp REVAPP eexp               (EApp (eexp2, eexp1), s (eexp1left, eexp2right))
+       | eexp COMPOSE eexp              (top_binop ("compose", eexp1, eexp2, s (eexp1left, eexp2right)))
+       | eexp ANDTHEN eexp              (top_binop ("compose", eexp2, eexp1, s (eexp1left, eexp2right)))
+       | eexp BACKTICK_PATH eexp        (let
+                                                val path = String.tokens (fn ch => ch = #".") BACKTICK_PATH
+                                                val pathModules = List.take (path, (length path -1))
+                                                val pathOp = List.last path
+
+                                                val e = (EVar (pathModules, pathOp, Infer)
+                                                        , s (BACKTICK_PATHleft, BACKTICK_PATHright))
+                                                val e = (EApp (e, eexp1), s (eexp1left, BACKTICK_PATHright))
+                                        in
+                                                (EApp (e, eexp2), s (eexp1left, eexp2right))
+                                        end)
+
        | eexp ANDALSO eexp              (let
                                              val loc = s (eexp1left, eexp2right)
                                          in