From fbbec2e6b041b89827bafaf1f2f82f42ab8ea508 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Thu, 5 Mar 2015 14:50:31 -0500 Subject: Some new infix operators, contributed by Gabriel Riba --- src/urweb.grm | 32 ++++++++++++++++++++++++++++++++ src/urweb.lex | 9 +++++++++ 2 files changed, 41 insertions(+) (limited to 'src') diff --git a/src/urweb.grm b/src/urweb.grm index 56e6d2ac..7fc34793 100644 --- a/src/urweb.grm +++ b/src/urweb.grm @@ -216,6 +216,14 @@ fun native_op (oper, e1, e2, loc) = (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 @@ fun patternOut (e : exp) = | 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 @@ fun patternOut (e : exp) = %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 : eapps (case #1 eapps of | 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 --git a/src/urweb.lex b/src/urweb.lex index 195fd735..716c44ba 100644 --- a/src/urweb.lex +++ b/src/urweb.lex @@ -376,6 +376,15 @@ xint = x[0-9a-fA-F][0-9a-fA-F]; "&&" => (Tokens.ANDALSO (pos yypos, pos yypos + size yytext)); "||" => (Tokens.ORELSE (pos yypos, pos yypos + size yytext)); + "<<<" => (Tokens.COMPOSE (pos yypos, pos yypos + size yytext)); + ">>>" => (Tokens.ANDTHEN (pos yypos, pos yypos + size yytext)); + "<|" => (Tokens.FWDAPP (pos yypos, pos yypos + size yytext)); + "|>" => (Tokens.REVAPP (pos yypos, pos yypos + size yytext)); + + "`" ({cid} ".")* {id} "`" => (Tokens.BACKTICK_PATH ( (* strip backticks *) + substring (yytext,1,size yytext -2), + pos yypos, pos yypos + size yytext)); + "=" => (Tokens.EQ (pos yypos, pos yypos + size yytext)); "<>" => (Tokens.NE (pos yypos, pos yypos + size yytext)); "<" => (Tokens.LT (pos yypos, pos yypos + size yytext)); -- cgit v1.2.3