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
  35 %%
  36 %header (functor MltLrValsFn(structure Token : TOKEN))
  37
  38 %term
  39    EOF
  40  | HTML of string
  41  | IF | THEN | ELSE
  42  | AS | WITH | OPEN | VAL | REF | TRY | CATCH
  43  | FN | END | RAISE
  44  | FOREACH | IN | DO
  45  | SWITCH | CASE | OF | BAR | ARROW
  46  | LPAREN | RPAREN | LBRACK | RBRACK | LBRACE | RBRACE | HASH | SEMI | CONS
  47  | PLUS | MINUS | TIMES | DIVIDE | MOD | NEG | DOLLAR | AT | STRCAT
  48  | ASN | EQ | NEQ | GT | GTE | LT | LTE
  49  | ANDALSO | ORELSE
  50  | IDENT of string | DOT | DOTDOT | DOTDOTDOT | COMMA | COLON | CARET | TILDE | UNDER
  51  | INT of int | STRING of string | CHAR of string | REAL of real
  52
  53 %nonterm
  54    file of block
  55  | block of block
  56  | exp of exp
  57  | cases of (pat * exp) list
  58  | appsL of exp list
  59  | apps of exp
  60  | term of exp
  61  | pterm of pat
  62  | papp of pat
  63  | pat of pat
  64  | path of ident list
  65  | pathList of ident list list
  66  | blockItem of blockItem
  67  | elseOpt of block option
  68  | matches of (pat * block) list withext
  69  | pexp of exp
  70  | ppat of pat
  71  | pseq of pat list
  72  | rseq of (ident * pat) list
  73  | frseq of (ident * pat) list
  74  | eseq of exp list
  75  | elseq of exp list
  76  | plseq of pat list
  77  | erseq of (ident * exp) list
  78  | ilist of ident list
  79  | ivlist of (ident * exp) list
  80  | catch of pat * block
  81  | catches of (pat * block) list
  82
  83 %verbose                                (* print summary of errors *)
  84 %pos int                                (* positions *)
  85 %start file
  86 %pure
  87 %eop EOF
  88 %noshift EOF
  89
  90 %name Mlt
  91
  92 %left ANDALSO
  93 %left ORELSE
  94 %nonassoc EQ NEQ GT GTE LT LTE
  95 %left PLUS MINUS
  96 %left TIMES DIVIDE MOD
  97 %left STRCAT
  98 %nonassoc NEG
  99 %right CONS
 100
 101 %%
 102
 103 file    : block                         (block)
 104
 105 ilist   : IDENT ilist                   (IDENT :: ilist)
 106         | IDENT                         ([IDENT])
 107
 108 ivlist  : IDENT EQ exp COMMA ivlist     ((IDENT, exp) :: ivlist)
 109         | IDENT EQ exp                  ([(IDENT, exp)])
 110
 111 catch   : pat ARROW block               (pat, block)
 112
 113 catches : catches BAR catch             (catch::catches)
 114         | catch                         ([catch])
 115
 116 blockItem       : HTML                  (BITEM (Html_i HTML, (HTMLleft, HTMLright)))
 117                 | REF ivlist            (BITEM (Ref_i ivlist, (REFleft, ivlistright)))
 118                 | OPEN pathList         (BITEM (Open_i pathList, (OPENleft, pathListright)))
 119                 | VAL pat EQ exp        (BITEM (Val_i (pat, exp), (patleft, expright)))
 120                 | IDENT ASN exp         (BITEM (Assn_i (IDENT, exp), (IDENTleft, expright)))
 121                 | exp                   (BITEM (Exp_i exp, (expleft, expright)))
 122                 | IF exp THEN block elseOpt END
 123                         (BITEM (Ifthenelse_i(exp, block, elseOpt),
 124                                 (IFleft, ENDright)))
 125                 | FOREACH IDENT IN exp DO block END
 126                         (BITEM (Foreach_i (IDENT, exp, block),
 127                                 (FOREACHleft, ENDright)))
 128                 | FOREACH IDENT IN exp DOTDOT exp DO block END
 129                         (BITEM (For_i (IDENT, exp1, exp2, block),
 130                                 (FOREACHleft, ENDright)))
 131                 | SWITCH exp OF matches END
 132                         (BITEM (Case_i (exp, List.rev (#1 matches)), (SWITCHleft, ENDright)))
 133                 | TRY block WITH catches END
 134                         (BITEM (TryCatch_i (block, List.rev catches), (TRYleft, ENDright)))
 135
 136 elseOpt         :                       (NONE)
 137                 | ELSE block            (SOME block)
 138
 139 block   : blockItem                     (BLOCK ([blockItem], (blockItemleft, blockItemright)))
 140         | blockItem SEMI block          (BLOCK (blockItem :: (unblock block), (blockItemleft, blockright)))
 141         | blockItem block               (BLOCK (blockItem :: (unblock block), (blockItemleft, blockright)))
 142         | SEMI block                    (block)
 143         |                               (BLOCK ([], (0, 0)))
 144
 145 appsL   : term appsL                    (term::appsL)
 146         | term                          ([term])
 147
 148 apps    : appsL                         (let
 149                                                 val e::r = appsL
 150                                         in
 151                                                 foldl (fn (e, a) => EXP (App_e (a, e), (appsLleft, appsLright))) e r
 152                                         end)
 153
 154
 155 path    : IDENT DOT path                (IDENT::path)
 156         | IDENT                         ([IDENT])
 157
 158 pathList: path pathList                 (path::pathList)
 159         | path                          ([path])
 160
 161 eseq    : exp COMMA eseq                (exp :: eseq)
 162         | exp COMMA exp                 ([exp1, exp2])
 163
 164 elseq   : eseq                          (eseq)
 165         | exp                           ([exp])
 166         |                               ([])
 167
 168 erseq   : IDENT EQ exp COMMA erseq      ((IDENT, exp) :: erseq)
 169         | IDENT COMMA erseq             ((IDENT, EXP (Ident_e [IDENT], (IDENTleft, IDENTright))) :: erseq)
 170         | IDENT                         ([(IDENT, EXP (Ident_e [IDENT], (IDENTleft, IDENTright)))])
 171         | IDENT EQ exp                  ([(IDENT, exp)])
 172
 173 pexp    : LPAREN eseq RPAREN            (EXP (Record_e (true, addNumbers eseq), (LPARENleft, LPARENright)))
 174         | LPAREN RPAREN                 (EXP (Record_e (true, []), (LPARENleft, RPARENright)))
 175         | LPAREN exp RPAREN             (exp)
 176
 177 term    : LBRACE erseq RBRACE           (EXP (Record_e (false, sortRcs erseq), (LBRACEleft, RBRACEright)))
 178         | LBRACE RBRACE                 (EXP (Record_e (false, []), (LBRACEleft, RBRACEright)))
 179         | LBRACE term WITH erseq RBRACE (EXP (RecordUpd_e (term, erseq), (LBRACEleft, RBRACEright)))
 180         | pexp                          (pexp)
 181         | STRING                        (EXP (String_e STRING, (STRINGleft, STRINGright)))
 182         | CHAR                          (EXP (Char_e CHAR, (CHARleft, CHARright)))
 183         | REAL                          (EXP (Real_e REAL, (REALleft, REALright)))
 184         | path                          (EXP (Ident_e path, (pathleft, pathright)))
 185         | INT                           (EXP (Int_e INT, (INTleft, INTright)))
 186         | NEG                           (EXP (Neg_e, (NEGleft, NEGright)))
 187         | DOLLAR                        (EXP (Param_e, (DOLLARleft, DOLLARright)))
 188         | AT IDENT                      (EXP (Template_e IDENT, (ATleft, IDENTright)))
 189         | HASH INT                      (EXP (Proj_e (Int.toString INT), (HASHleft, INTright)))
 190         | HASH IDENT                    (EXP (Proj_e IDENT, (HASHleft, IDENTright)))
 191         | LBRACK elseq RBRACK           (foldr (fn x => EXP (Cons_e x, (LBRACKleft, RBRACKright)))
 192                                                 (EXP (Ident_e ["nil"], (0, 0))) elseq)
 193
 194 exp     : apps                          (apps)
 195         | exp PLUS exp                  (EXP (Plus_e (exp1, exp2), (exp1left, exp2right)))
 196         | exp MINUS exp                 (EXP (Minus_e (exp1, exp2), (exp1left, exp2right)))
 197         | exp TIMES exp                 (EXP (Times_e (exp1, exp2), (exp1left, exp2right)))
 198         | exp DIVIDE exp                (EXP (Divide_e (exp1, exp2), (exp1left, exp2right)))
 199         | exp MOD exp                   (EXP (Mod_e (exp1, exp2), (exp1left, exp2right)))
 200         | exp EQ exp                    (EXP (Eq_e (exp1, exp2), (exp1left, exp2right)))
 201         | exp NEQ exp                   (EXP (Neq_e (exp1, exp2), (exp1left, exp2right)))
 202         | exp LT exp                    (EXP (Lt_e (exp1, exp2), (exp1left, exp2right)))
 203         | exp LTE exp                   (EXP (Lte_e (exp1, exp2), (exp1left, exp2right)))
 204         | exp GT exp                    (EXP (Gt_e (exp1, exp2), (exp1left, exp2right)))
 205         | exp GTE exp                   (EXP (Gte_e (exp1, exp2), (exp1left, exp2right)))
 206         | exp CONS exp                  (EXP (Cons_e (exp1, exp2), (exp1left, exp2right)))
 207         | exp STRCAT exp                (EXP (StrCat_e (exp1, exp2), (exp1left, exp2right)))
 208         | exp ORELSE exp                (EXP (Orelse_e (exp1, exp2), (exp1left, exp2right)))
 209         | exp ANDALSO exp               (EXP (Andalso_e (exp1, exp2), (exp1left, exp2right)))
 210         | CASE exp OF cases             (EXP (Case_e (exp, List.rev cases), (expleft, casesright)))
 211         | FN cases                      (EXP (Fn_e (List.rev cases), (FNleft, casesright)))
 212         | RAISE exp                     (EXP (Raise_e exp, (RAISEleft, expright)))
 213
 214
 215 cases   : pat ARROW exp                 ([(pat, exp)])
 216         | cases BAR pat ARROW exp       ((pat, exp) :: cases)
 217
 218 matches : matches BAR pat ARROW block           (((pat, block) :: (#1 matches), (matchesleft, blockright)))
 219         | pat ARROW block                       ([(pat, block)], (patleft, blockright))
 220
 221 rseq    : IDENT EQ pat COMMA rseq               ((IDENT, pat) :: rseq)
 222         | IDENT COMMA rseq                      ((IDENT, PAT (Ident_p [IDENT], (IDENTleft, IDENTright))) :: rseq)
 223         | IDENT                                 ([(IDENT, PAT (Ident_p [IDENT], (IDENTleft, IDENTright)))])
 224         | IDENT EQ pat                          ([(IDENT, pat)])
 225
 226 frseq   : IDENT EQ pat COMMA frseq              ((IDENT, pat) :: frseq)
 227         | IDENT COMMA frseq                     ((IDENT, PAT (Ident_p [IDENT], (IDENTleft, IDENTright))) :: frseq)
 228         | DOTDOTDOT                             ([])
 229
 230 ppat    : LPAREN pat RPAREN                     (PAT (unpat pat, (LPARENleft, RPARENright)))
 231         | LPAREN pseq RPAREN                    (PAT (Record_p (true, addNumbers pseq), (LPARENleft, LPARENright)))
 232         | LPAREN RPAREN                         (PAT (Record_p (true, []), (LPARENleft, RPARENright)))
 233
 234 pseq    : pat COMMA pseq                        (pat :: pseq)
 235         | pat COMMA pat                         ([pat1, pat2])
 236
 237 plseq   : pseq                                  (pseq)
 238         | pat                                   ([pat])
 239         |                                       ([])
 240
 241 pterm   : path                                  (PAT (Ident_p path, (pathleft, pathright)))
 242         | UNDER                                 (PAT (Wild_p, (UNDERleft, UNDERright)))
 243         | INT                                   (PAT (Int_p INT, (INTleft, INTright)))
 244         | STRING                                (PAT (String_p STRING, (STRINGleft, STRINGright)))
 245         | CHAR                                  (PAT (Char_p CHAR, (CHARleft, CHARright)))
 246         | REAL                                  (PAT (Real_p REAL, (REALleft, REALright)))
 247         | LBRACE rseq RBRACE                    (PAT (Record_p (false, sortRcs rseq), (LBRACEleft, RBRACEright)))
 248         | LBRACE RBRACE                         (PAT (Record_p (false, []), (LBRACEleft, RBRACEright)))
 249         | LBRACE frseq RBRACE                   (PAT (FlexRecord_p (sortRcs frseq), (LBRACEleft, RBRACEright)))
 250         | ppat                                  (ppat)
 251
 252 papp    : path papp                             (PAT (App_p (path, papp), (pathleft, pappright)))
 253         | pterm                                 (pterm)
 254
 255 pat     : papp CONS papp                        (PAT (Cons_p (papp1, papp2), (papp1left, papp2right)))
 256         | papp                                  (papp)
 257         | IDENT AS pat                          (PAT (As_p (IDENT, pat), (IDENTleft, patright)))
 258         | LBRACK plseq RBRACK                   (foldr (fn x => PAT (Cons_p x, (LBRACKleft, RBRACKright)))
 259                                                         (PAT (Ident_p ["nil"], (0, 0))) plseq)