src/mlt.grm

   1 (*                                                                           *)
   2 (* Dynamic web page generation with Standard ML                              *)
   3 (* Copyright (C) 2003  Adam Chlipala                                         *)
   4 (*                                                                           *)
   5 (* This library is free software; you can redistribute it and/or             *)
   6 (* modify it under the terms of the GNU Lesser General Public                *)
   7 (* License as published by the Free Software Foundation; either              *)
   8 (* version 2.1 of the License, or (at your option) any later version.        *)
   9 (*                                                                           *)
  10 (* This library is distributed in the hope that it will be useful,           *)
  11 (* but WITHOUT ANY WARRANTY; without even the implied warranty of            *)
  12 (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU         *)
  13 (* Lesser General Public License for more details.                           *)
  14 (*                                                                           *)
  15 (* You should have received a copy of the GNU Lesser General Public          *)
  16 (* License along with this library; if not, write to the Free Software       *)
  17 (* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA *)
  18
  19 (* Grammar for ML template language *)
  20
  21 open Tree
  22
  23 fun rcomp ((a, _), (b, _)) = String.compare (a, b) = GREATER
  24 fun sortRcs x = ListMergeSort.sort rcomp x
  25
  26 fun addNumbers L =
  27         let
  28                 fun addNum (_, []) = []
  29                   | addNum (n, h::t) = (Int.toString n, h)::(addNum(n+1,t))
  30         in
  31                 addNum (1, L)
  32         end
  33
  34 fun compact' [] = []
  35   | compact' (BITEM (Html_i h1, p1) :: BITEM (Html_i h2, p2) :: rest) = compact' (BITEM (Html_i (h1 ^ h2), p1) :: rest)
  36   | compact' (first :: rest) = first :: compact' rest
  37
  38 fun compact (BLOCK (items, pos)) = BLOCK (compact' items, pos)
  39
  40 %%
  41 %header (functor MltLrValsFn(structure Token : TOKEN))
  42
  43 %term
  44    EOF
  45  | HTML of string
  46  | IF | THEN | ELSE | ELSEIF | IFF
  47  | AS | WITH | OPEN | VAL | REF | TRY | CATCH
  48  | FN | LET | IN | END | RAISE
  49  | FOREACH | FOR | DO
  50  | SWITCH | CASE | OF | BAR | ARROW
  51  | LPAREN | RPAREN | LBRACK | RBRACK | LBRACE | RBRACE | HASH | SEMI | CONS | O
  52  | PLUS | MINUS | TIMES | DIVIDE | MOD | NEG | DOLLAR | AT | STRCAT
  53  | ASN | EQ | NEQ | GT | GTE | LT | LTE
  54  | ANDALSO | ORELSE
  55  | IDENT of string | DOT | DOTDOT | DOTDOTDOT | COMMA | COLON | CARET | TILDE | UNDER
  56  | INT of int | STRING of string | CHAR of string | REAL of real
  57
  58 %nonterm
  59    file of block
  60  | block of block
  61  | exp of exp
  62  | cases of (pat * exp) list
  63  | appsL of exp list
  64  | apps of exp
  65  | term of exp
  66  | pterm of pat
  67  | papp of pat
  68  | pat of pat
  69  | path of ident list
  70  | pathList of ident list list
  71  | blockItem of blockItem
  72  | elseOpt of block option
  73  | matches of (pat * block) list withext
  74  | pexp of exp
  75  | ppat of pat
  76  | pseq of pat list
  77  | rseq of (ident * pat) list
  78  | frseq of (ident * pat) list
  79  | eseq of exp list
  80  | elseq of exp list
  81  | plseq of pat list
  82  | erseq of (ident * exp) list
  83  | ilist of ident list
  84  | ivlist of (ident * exp) list
  85  | catch of pat * block
  86  | catches of (pat * block) list
  87
  88 %verbose                                (* print summary of errors *)
  89 %pos int                                (* positions *)
  90 %start file
  91 %pure
  92 %eop EOF
  93 %noshift EOF
  94
  95 %name Mlt
  96
  97 %left ANDALSO
  98 %left ORELSE
  99 %nonassoc EQ NEQ GT GTE LT LTE
 100 %left PLUS MINUS
 101 %left TIMES DIVIDE MOD
 102 %left STRCAT
 103 %nonassoc NEG
 104 %right CONS
 105
 106 %%
 107
 108 file    : block                         (compact block)
 109
 110 ilist   : IDENT ilist                   (IDENT :: ilist)
 111         | IDENT                         ([IDENT])
 112
 113 ivlist  : IDENT EQ exp COMMA ivlist     ((IDENT, exp) :: ivlist)
 114         | IDENT EQ exp                  ([(IDENT, exp)])
 115
 116 catch   : pat ARROW block               (pat, compact block)
 117
 118 catches : catches BAR catch             (catch::catches)
 119         | catch                         ([catch])
 120
 121 blockItem       : HTML                  (BITEM (Html_i HTML, (HTMLleft, HTMLright)))
 122                 | REF ivlist            (BITEM (Ref_i ivlist, (REFleft, ivlistright)))
 123                 | OPEN pathList         (BITEM (Open_i pathList, (OPENleft, pathListright)))
 124                 | VAL pat EQ exp        (BITEM (Val_i (pat, exp), (patleft, expright)))
 125                 | IDENT ASN exp         (BITEM (Assn_i (IDENT, exp), (IDENTleft, expright)))
 126                 | exp                   (BITEM (Exp_i exp, (expleft, expright)))
 127                 | IF exp THEN block elseOpt END
 128                         (BITEM (Ifthenelse_i(exp, compact block, elseOpt),
 129                                 (IFleft, ENDright)))
 130                 | FOREACH pat IN exp DO block END
 131                         (BITEM (Foreach_i (pat, exp, compact block),
 132                                 (FOREACHleft, ENDright)))
 133                 | FOR IDENT IN exp DOTDOT exp DO block END
 134                         (BITEM (For_i (IDENT, exp1, exp2, compact block),
 135                                 (FORleft, ENDright)))
 136                 | SWITCH exp OF matches END
 137                         (BITEM (Case_i (exp, List.rev (#1 matches)), (SWITCHleft, ENDright)))
 138                 | TRY block WITH catches END
 139                         (BITEM (TryCatch_i (compact block, List.rev catches), (TRYleft, ENDright)))
 140
 141 elseOpt         :                                 (NONE)
 142                 | ELSEIF exp THEN block elseOpt  (SOME (BLOCK ([BITEM (Ifthenelse_i (exp, compact block, elseOpt),
 143                                                                        (ELSEIFleft, elseOptright))],
 144                                                                (ELSEIFleft, elseOptright))))
 145                 | ELSE block                      (SOME (compact block))
 146
 147 block   : blockItem                     (BLOCK ([blockItem], (blockItemleft, blockItemright)))
 148         | blockItem SEMI block          (BLOCK (blockItem :: (unblock block), (blockItemleft, blockright)))
 149         | blockItem block               (BLOCK (blockItem :: (unblock block), (blockItemleft, blockright)))
 150         | SEMI block                    (block)
 151         |                               (BLOCK ([], (0, 0)))
 152
 153 appsL   : term appsL                    (term::appsL)
 154         | term                          ([term])
 155
 156 apps    : appsL                         (let
 157                                                 val e::r = appsL
 158                                         in
 159                                                 foldl (fn (e, a) => EXP (App_e (a, e), (appsLleft, appsLright))) e r
 160                                         end)
 161
 162
 163 path    : IDENT DOT path                (IDENT::path)
 164         | IDENT                         ([IDENT])
 165
 166 pathList: path pathList                 (path::pathList)
 167         | path                          ([path])
 168
 169 eseq    : exp COMMA eseq                (exp :: eseq)
 170         | exp COMMA exp                 ([exp1, exp2])
 171
 172 elseq   : eseq                          (eseq)
 173         | exp                           ([exp])
 174         |                               ([])
 175
 176 erseq   : IDENT EQ exp COMMA erseq      ((IDENT, exp) :: erseq)
 177         | IDENT COMMA erseq             ((IDENT, EXP (Ident_e [IDENT], (IDENTleft, IDENTright))) :: erseq)
 178         | IDENT                         ([(IDENT, EXP (Ident_e [IDENT], (IDENTleft, IDENTright)))])
 179         | IDENT EQ exp                  ([(IDENT, exp)])
 180
 181 pexp    : LPAREN eseq RPAREN            (EXP (Record_e (true, addNumbers eseq), (LPARENleft, LPARENright)))
 182         | LPAREN RPAREN                 (EXP (Record_e (true, []), (LPARENleft, RPARENright)))
 183         | LPAREN exp RPAREN             (exp)
 184
 185 term    : LBRACE erseq RBRACE           (EXP (Record_e (false, sortRcs erseq), (LBRACEleft, RBRACEright)))
 186         | LBRACE RBRACE                 (EXP (Record_e (false, []), (LBRACEleft, RBRACEright)))
 187         | LBRACE term WITH erseq RBRACE (EXP (RecordUpd_e (term, erseq), (LBRACEleft, RBRACEright)))
 188         | pexp                          (pexp)
 189         | STRING                        (EXP (String_e STRING, (STRINGleft, STRINGright)))
 190         | CHAR                          (EXP (Char_e CHAR, (CHARleft, CHARright)))
 191         | REAL                          (EXP (Real_e REAL, (REALleft, REALright)))
 192         | path                          (EXP (Ident_e path, (pathleft, pathright)))
 193         | INT                           (EXP (Int_e INT, (INTleft, INTright)))
 194         | NEG                           (EXP (Neg_e, (NEGleft, NEGright)))
 195         | DOLLAR                        (EXP (Param_e, (DOLLARleft, DOLLARright)))
 196         | AT IDENT                      (EXP (Template_e IDENT, (ATleft, IDENTright)))
 197         | HASH INT                      (EXP (Proj_e (Int.toString INT), (HASHleft, INTright)))
 198         | HASH IDENT                    (EXP (Proj_e IDENT, (HASHleft, IDENTright)))
 199         | LBRACK elseq RBRACK           (foldr (fn x => EXP (Cons_e x, (LBRACKleft, RBRACKright)))
 200                                                 (EXP (Ident_e ["nil"], (0, 0))) elseq)
 201
 202 exp     : apps                          (apps)
 203         | exp PLUS exp                  (EXP (Plus_e (exp1, exp2), (exp1left, exp2right)))
 204         | exp MINUS exp                 (EXP (Minus_e (exp1, exp2), (exp1left, exp2right)))
 205         | exp TIMES exp                 (EXP (Times_e (exp1, exp2), (exp1left, exp2right)))
 206         | exp DIVIDE exp                (EXP (Divide_e (exp1, exp2), (exp1left, exp2right)))
 207         | exp MOD exp                   (EXP (Mod_e (exp1, exp2), (exp1left, exp2right)))
 208         | exp EQ exp                    (EXP (Eq_e (exp1, exp2), (exp1left, exp2right)))
 209         | exp NEQ exp                   (EXP (Neq_e (exp1, exp2), (exp1left, exp2right)))
 210         | exp LT exp                    (EXP (Lt_e (exp1, exp2), (exp1left, exp2right)))
 211         | exp LTE exp                   (EXP (Lte_e (exp1, exp2), (exp1left, exp2right)))
 212         | exp GT exp                    (EXP (Gt_e (exp1, exp2), (exp1left, exp2right)))
 213         | exp GTE exp                   (EXP (Gte_e (exp1, exp2), (exp1left, exp2right)))
 214         | exp CONS exp                  (EXP (Cons_e (exp1, exp2), (exp1left, exp2right)))
 215         | exp O exp                     (EXP (Compose_e (exp1, exp2), (exp1left, exp2right)))
 216         | exp STRCAT exp                (EXP (StrCat_e (exp1, exp2), (exp1left, exp2right)))
 217         | exp ORELSE exp                (EXP (Orelse_e (exp1, exp2), (exp1left, exp2right)))
 218         | exp ANDALSO exp               (EXP (Andalso_e (exp1, exp2), (exp1left, exp2right)))
 219         | CASE exp OF cases             (EXP (Case_e (exp, List.rev cases), (expleft, casesright)))
 220         | FN cases                      (EXP (Fn_e (List.rev cases), (FNleft, casesright)))
 221         | RAISE exp                     (EXP (Raise_e exp, (RAISEleft, expright)))
 222         | LET block IN exp END          (EXP (Let_e (compact block, exp), (LETleft, ENDright)))
 223         | IFF exp THEN exp ELSE exp     (EXP (If_e (exp1, exp2, exp3), (IFFleft, exp3right)))
 224
 225
 226 cases   : pat ARROW exp                 ([(pat, exp)])
 227         | cases BAR pat ARROW exp       ((pat, exp) :: cases)
 228
 229 matches : matches BAR pat ARROW block           (((pat, compact block) :: (#1 matches), (matchesleft, blockright)))
 230         | pat ARROW block                       ([(pat, compact block)], (patleft, blockright))
 231
 232 rseq    : IDENT EQ pat COMMA rseq               ((IDENT, pat) :: rseq)
 233         | IDENT COMMA rseq                      ((IDENT, PAT (Ident_p [IDENT], (IDENTleft, IDENTright))) :: rseq)
 234         | IDENT                                 ([(IDENT, PAT (Ident_p [IDENT], (IDENTleft, IDENTright)))])
 235         | IDENT EQ pat                          ([(IDENT, pat)])
 236
 237 frseq   : IDENT EQ pat COMMA frseq              ((IDENT, pat) :: frseq)
 238         | IDENT COMMA frseq                     ((IDENT, PAT (Ident_p [IDENT], (IDENTleft, IDENTright))) :: frseq)
 239         | DOTDOTDOT                             ([])
 240
 241 ppat    : LPAREN pat RPAREN                     (PAT (unpat pat, (LPARENleft, RPARENright)))
 242         | LPAREN pseq RPAREN                    (PAT (Record_p (true, addNumbers pseq), (LPARENleft, LPARENright)))
 243         | LPAREN RPAREN                         (PAT (Record_p (true, []), (LPARENleft, RPARENright)))
 244
 245 pseq    : pat COMMA pseq                        (pat :: pseq)
 246         | pat COMMA pat                         ([pat1, pat2])
 247
 248 plseq   : pseq                                  (pseq)
 249         | pat                                   ([pat])
 250         |                                       ([])
 251
 252 pterm   : path                                  (PAT (Ident_p path, (pathleft, pathright)))
 253         | UNDER                                 (PAT (Wild_p, (UNDERleft, UNDERright)))
 254         | INT                                   (PAT (Int_p INT, (INTleft, INTright)))
 255         | STRING                                (PAT (String_p STRING, (STRINGleft, STRINGright)))
 256         | CHAR                                  (PAT (Char_p CHAR, (CHARleft, CHARright)))
 257         | REAL                                  (PAT (Real_p REAL, (REALleft, REALright)))
 258         | LBRACE rseq RBRACE                    (PAT (Record_p (false, sortRcs rseq), (LBRACEleft, RBRACEright)))
 259         | LBRACE RBRACE                         (PAT (Record_p (false, []), (LBRACEleft, RBRACEright)))
 260         | LBRACE frseq RBRACE                   (PAT (FlexRecord_p (sortRcs frseq), (LBRACEleft, RBRACEright)))
 261         | ppat                                  (ppat)
 262
 263 papp    : path papp                             (PAT (App_p (path, papp), (pathleft, pappright)))
 264         | pterm                                 (pterm)
 265
 266 pat     : papp CONS papp                        (PAT (Cons_p (papp1, papp2), (papp1left, papp2right)))
 267         | papp                                  (papp)
 268         | IDENT AS pat                          (PAT (As_p (IDENT, pat), (IDENTleft, patright)))
 269         | LBRACK plseq RBRACK                   (foldr (fn x => PAT (Cons_p x, (LBRACKleft, RBRACKright)))
 270                                                         (PAT (Ident_p ["nil"], (0, 0))) plseq)