# HG changeset patch
# User Adam Chlipala <adam@chlipala.net>
# Date 1425585031 18000
# Node ID 8cf40452c900cacdefc9a6d4b14b0e7b80dfc9e9
# Parent  f89be9cd20871a6b50a493b685280d7b81160222
Some new infix operators, contributed by Gabriel Riba

diff -r f89be9cd2087 -r 8cf40452c900 src/urweb.grm
--- 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
diff -r f89be9cd2087 -r 8cf40452c900 src/urweb.lex
--- a/src/urweb.lex	Tue Mar 03 15:55:00 2015 -0500
+++ b/src/urweb.lex	Thu Mar 05 14:50:31 2015 -0500
@@ -376,6 +376,15 @@
 <INITIAL> "&&"        => (Tokens.ANDALSO (pos yypos, pos yypos + size yytext));
 <INITIAL> "||"        => (Tokens.ORELSE (pos yypos, pos yypos + size yytext));
 
+<INITIAL> "<<<"       => (Tokens.COMPOSE (pos yypos, pos yypos + size yytext));
+<INITIAL> ">>>"       => (Tokens.ANDTHEN (pos yypos, pos yypos + size yytext));
+<INITIAL> "<|"        => (Tokens.FWDAPP (pos yypos, pos yypos + size yytext));
+<INITIAL> "|>"        => (Tokens.REVAPP (pos yypos, pos yypos + size yytext));
+
+<INITIAL> "`" ({cid} ".")* {id} "`"  => (Tokens.BACKTICK_PATH ( (* strip backticks *)
+                                                              substring (yytext,1,size yytext -2),
+                                                              pos yypos, pos yypos + size yytext));
+
 <INITIAL> "="         => (Tokens.EQ (pos yypos, pos yypos + size yytext));
 <INITIAL> "<>"        => (Tokens.NE (pos yypos, pos yypos + size yytext));
 <INITIAL> "<"         => (Tokens.LT (pos yypos, pos yypos + size yytext));