addNum (1, L)
end
+fun compact' [] = []
+ | compact' (BITEM (Html_i h1, p1) :: BITEM (Html_i h2, p2) :: rest) = compact' (BITEM (Html_i (h1 ^ h2), p1) :: rest)
+ | compact' (first :: rest) = first :: compact' rest
+
+fun compact (BLOCK (items, pos)) = BLOCK (compact' items, pos)
%%
%header (functor MltLrValsFn(structure Token : TOKEN))
%term
EOF
| HTML of string
- | IF | THEN | ELSE | AS | WITH | OPEN | VAL | REF | TRY | CATCH
- | FOREACH | IN | CASE | ORELSE | ANDALSO
- | LPAREN | RPAREN | LBRACK | RBRACK | LBRACE | RBRACE | HASH | SEMI | CONS
+ | IF | THEN | ELSE | ELSEIF | IFF
+ | AS | WITH | OPEN | VAL | REF | TRY | CATCH
+ | FN | LET | IN | END | RAISE
+ | FOREACH | FOR | DO
+ | SWITCH | CASE | OF | BAR | ARROW
+ | LPAREN | RPAREN | LBRACK | RBRACK | LBRACE | RBRACE | HASH | SEMI | CONS | O
| PLUS | MINUS | TIMES | DIVIDE | MOD | NEG | DOLLAR | AT | STRCAT
| ASN | EQ | NEQ | GT | GTE | LT | LTE
+ | ANDALSO | ORELSE
| IDENT of string | DOT | DOTDOT | DOTDOTDOT | COMMA | COLON | CARET | TILDE | UNDER
- | INT of int | STRING of string | CHAR of string
+ | INT of int | STRING of string | CHAR of string | REAL of real
%nonterm
file of block
| block of block
| exp of exp
+ | cases of (pat * exp) list
| appsL of exp list
| apps of exp
| term of exp
| path of ident list
| pathList of ident list list
| blockItem of blockItem
- | ifte of ((exp * block) list * block option) withext
+ | elseOpt of block option
| matches of (pat * block) list withext
| pexp of exp
| ppat of pat
%%
-file : block (block)
+file : block (compact block)
ilist : IDENT ilist (IDENT :: ilist)
| IDENT ([IDENT])
ivlist : IDENT EQ exp COMMA ivlist ((IDENT, exp) :: ivlist)
| IDENT EQ exp ([(IDENT, exp)])
-catch : CATCH ppat LBRACE block RBRACE (ppat, block)
+catch : pat ARROW block (pat, compact block)
-catches : catch catches (catch::catches)
- | catch ([catch])
+catches : catches BAR catch (catch::catches)
+ | catch ([catch])
blockItem : HTML (BITEM (Html_i HTML, (HTMLleft, HTMLright)))
| REF ivlist (BITEM (Ref_i ivlist, (REFleft, ivlistright)))
| VAL pat EQ exp (BITEM (Val_i (pat, exp), (patleft, expright)))
| IDENT ASN exp (BITEM (Assn_i (IDENT, exp), (IDENTleft, expright)))
| exp (BITEM (Exp_i exp, (expleft, expright)))
- | IF LPAREN exp RPAREN LBRACE block RBRACE ifte
- (let val ((L, O), _) = ifte in
- BITEM (Ifthenelse_i((exp, block) :: L, O),
- (IFleft, ifteright))
- end)
- | FOREACH LPAREN IDENT IN exp RPAREN LBRACE block RBRACE
- (BITEM (Foreach_i (IDENT, exp, block),
- (FOREACHleft, RBRACEright)))
- | FOREACH LPAREN IDENT IN exp DOTDOT exp RPAREN LBRACE block RBRACE
- (BITEM (For_i (IDENT, exp1, exp2, block),
- (FOREACHleft, RBRACEright)))
- | CASE pexp matches
- (BITEM (Case_i (pexp, #1 matches), (CASEleft, matchesright)))
- | TRY LBRACE block RBRACE catches
- (BITEM (TryCatch_i (block, catches), (TRYleft, catchesright)))
-
-ifte : ELSE LBRACE block RBRACE (([], SOME block), (ELSEleft, RBRACEright))
- | ELSE IF LPAREN exp RPAREN LBRACE block RBRACE ifte (let val ((L, O), _) = ifte in
- (((exp, block) :: L, O), (ELSEleft, ifteright))
- end)
- | (([], NONE), (0, 0))
+ | IF exp THEN block elseOpt END
+ (BITEM (Ifthenelse_i(exp, compact block, elseOpt),
+ (IFleft, ENDright)))
+ | FOREACH pat IN exp DO block END
+ (BITEM (Foreach_i (pat, exp, compact block),
+ (FOREACHleft, ENDright)))
+ | FOR IDENT IN exp DOTDOT exp DO block END
+ (BITEM (For_i (IDENT, exp1, exp2, compact block),
+ (FORleft, ENDright)))
+ | SWITCH exp OF matches END
+ (BITEM (Case_i (exp, List.rev (#1 matches)), (SWITCHleft, ENDright)))
+ | TRY block WITH catches END
+ (BITEM (TryCatch_i (compact block, List.rev catches), (TRYleft, ENDright)))
+
+elseOpt : (NONE)
+ | ELSEIF exp THEN block elseOpt (SOME (BLOCK ([BITEM (Ifthenelse_i (exp, compact block, elseOpt),
+ (ELSEIFleft, elseOptright))],
+ (ELSEIFleft, elseOptright))))
+ | ELSE block (SOME (compact block))
block : blockItem (BLOCK ([blockItem], (blockItemleft, blockItemright)))
| blockItem SEMI block (BLOCK (blockItem :: (unblock block), (blockItemleft, blockright)))
| pexp (pexp)
| STRING (EXP (String_e STRING, (STRINGleft, STRINGright)))
| CHAR (EXP (Char_e CHAR, (CHARleft, CHARright)))
+ | REAL (EXP (Real_e REAL, (REALleft, REALright)))
| path (EXP (Ident_e path, (pathleft, pathright)))
| INT (EXP (Int_e INT, (INTleft, INTright)))
| NEG (EXP (Neg_e, (NEGleft, NEGright)))
| exp GT exp (EXP (Gt_e (exp1, exp2), (exp1left, exp2right)))
| exp GTE exp (EXP (Gte_e (exp1, exp2), (exp1left, exp2right)))
| exp CONS exp (EXP (Cons_e (exp1, exp2), (exp1left, exp2right)))
+ | exp O exp (EXP (Compose_e (exp1, exp2), (exp1left, exp2right)))
| exp STRCAT exp (EXP (StrCat_e (exp1, exp2), (exp1left, exp2right)))
| exp ORELSE exp (EXP (Orelse_e (exp1, exp2), (exp1left, exp2right)))
| exp ANDALSO exp (EXP (Andalso_e (exp1, exp2), (exp1left, exp2right)))
+ | CASE exp OF cases (EXP (Case_e (exp, List.rev cases), (expleft, casesright)))
+ | FN cases (EXP (Fn_e (List.rev cases), (FNleft, casesright)))
+ | RAISE exp (EXP (Raise_e exp, (RAISEleft, expright)))
+ | LET block IN exp END (EXP (Let_e (compact block, exp), (LETleft, ENDright)))
+ | IFF exp THEN exp ELSE exp (EXP (If_e (exp1, exp2, exp3), (IFFleft, exp3right)))
+
+
+cases : pat ARROW exp ([(pat, exp)])
+ | cases BAR pat ARROW exp ((pat, exp) :: cases)
-matches : ppat LBRACE block RBRACE matches (((ppat, block) :: (#1 matches), (ppatleft, matchesright)))
- | ([], (0, 0))
+matches : matches BAR pat ARROW block (((pat, compact block) :: (#1 matches), (matchesleft, blockright)))
+ | pat ARROW block ([(pat, compact block)], (patleft, blockright))
rseq : IDENT EQ pat COMMA rseq ((IDENT, pat) :: rseq)
| IDENT COMMA rseq ((IDENT, PAT (Ident_p [IDENT], (IDENTleft, IDENTright))) :: rseq)
| UNDER (PAT (Wild_p, (UNDERleft, UNDERright)))
| INT (PAT (Int_p INT, (INTleft, INTright)))
| STRING (PAT (String_p STRING, (STRINGleft, STRINGright)))
+ | CHAR (PAT (Char_p CHAR, (CHARleft, CHARright)))
+ | REAL (PAT (Real_p REAL, (REALleft, REALright)))
| LBRACE rseq RBRACE (PAT (Record_p (false, sortRcs rseq), (LBRACEleft, RBRACEright)))
| LBRACE RBRACE (PAT (Record_p (false, []), (LBRACEleft, RBRACEright)))
| LBRACE frseq RBRACE (PAT (FlexRecord_p (sortRcs frseq), (LBRACEleft, RBRACEright)))
HCoop / hcoop / mlt.git / blobdiff