Various improvements made while working on relwiki

[bpt/mlt.git] / src / mlt.grm

diff --git a/src/mlt.grm b/src/mlt.grm
index 6a584f5..5bb039d 100644 (file)
--- a/src/mlt.grm
+++ b/src/mlt.grm
@@ -31,6 +31,11 @@ fun addNumbers L =
                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))
@@ -38,12 +43,12 @@ fun addNumbers L =
 %term 
    EOF
  | HTML of string
- | IF | THEN | ELSE
+ | IF | THEN | ELSE | ELSEIF | IFF
  | AS | WITH | OPEN | VAL | REF | TRY | CATCH
- | FN | END | RAISE
- | FOREACH | IN | DO
+ | FN | LET | IN | END | RAISE
+ | FOREACH | FOR | DO
  | SWITCH | CASE | OF | BAR | ARROW
- | LPAREN | RPAREN | LBRACK | RBRACK | LBRACE | RBRACE | HASH | SEMI | CONS
+ | 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
@@ -100,7 +105,7 @@ fun addNumbers L =
 
 %%
 
-file   : block                         (block)
+file   : block                         (compact block)
 
 ilist  : IDENT ilist                   (IDENT :: ilist)
        | IDENT                         ([IDENT])
@@ -108,7 +113,7 @@ ilist       : IDENT ilist                   (IDENT :: ilist)
 ivlist : IDENT EQ exp COMMA ivlist     ((IDENT, exp) :: ivlist)
        | IDENT EQ exp                  ([(IDENT, exp)])
 
-catch  : pat ARROW block               (pat, block)
+catch  : pat ARROW block               (pat, compact block)
 
 catches        : catches BAR catch             (catch::catches)
        | catch                         ([catch])
@@ -120,21 +125,24 @@ blockItem : HTML                  (BITEM (Html_i HTML, (HTMLleft, HTMLright)))
                | IDENT ASN exp         (BITEM (Assn_i (IDENT, exp), (IDENTleft, expright)))
                | exp                   (BITEM (Exp_i exp, (expleft, expright)))
                | IF exp THEN block elseOpt END
-                        (BITEM (Ifthenelse_i(exp, block, elseOpt),
+                        (BITEM (Ifthenelse_i(exp, compact block, elseOpt),
                                (IFleft, ENDright)))
-               | FOREACH IDENT IN exp DO block END
-                       (BITEM (Foreach_i (IDENT, exp, block),
+               | FOREACH pat IN exp DO block END
+                       (BITEM (Foreach_i (pat, exp, compact block),
                                (FOREACHleft, ENDright)))
-               | FOREACH IDENT IN exp DOTDOT exp DO block END
-                       (BITEM (For_i (IDENT, exp1, exp2, 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 (block, List.rev catches), (TRYleft, ENDright)))
+                       (BITEM (TryCatch_i (compact block, List.rev catches), (TRYleft, ENDright)))
 
-elseOpt         :                       (NONE)
-                | ELSE block            (SOME block)
+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)))
@@ -204,19 +212,22 @@ exp       : apps                          (apps)
        | 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        : matches BAR pat ARROW block           (((pat, block) :: (#1 matches), (matchesleft, blockright)))
-       | pat ARROW block                       ([(pat, block)], (patleft, blockright))
+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)