Mercurial > urweb
changeset 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 | f89be9cd2087 |
| children | 1218daa14279 |
| files | src/urweb.grm src/urweb.lex |
| diffstat | 2 files changed, 41 insertions(+), 0 deletions(-) [+] |
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
--- 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));