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 | AS | WITH | OPEN | VAL | REF | TRY | CATCH
  42  | FOREACH | IN | CASE | ORELSE | ANDALSO
  43  | LPAREN | RPAREN | LBRACK | RBRACK | LBRACE | RBRACE | HASH | SEMI | CONS
  44  | PLUS | MINUS | TIMES | DIVIDE | MOD | NEG | DOLLAR | AT | STRCAT
  45  | ASN | EQ | NEQ | GT | GTE | LT | LTE
  46  | IDENT of string | DOT | DOTDOT | DOTDOTDOT | COMMA | COLON | CARET | TILDE | UNDER
  47  | INT of int | STRING of string | CHAR of string
  48
  49 %nonterm
  50    file of block
  51  | block of block
  52  | exp of exp
  53  | appsL of exp list
  54  | apps of exp
  55  | term of exp
  56  | pterm of pat
  57  | papp of pat
  58  | pat of pat
  59  | path of ident list
  60  | pathList of ident list list
  61  | blockItem of blockItem
  62  | ifte of ((exp * block) list * block option) withext
  63  | matches of (pat * block) list withext
  64  | pexp of exp
  65  | ppat of pat
  66  | pseq of pat list
  67  | rseq of (ident * pat) list
  68  | frseq of (ident * pat) list
  69  | eseq of exp list
  70  | elseq of exp list
  71  | plseq of pat list
  72  | erseq of (ident * exp) list
  73  | ilist of ident list
  74  | ivlist of (ident * exp) list
  75  | catch of pat * block
  76  | catches of (pat * block) list
  77
  78 %verbose                                (* print summary of errors *)
  79 %pos int                                (* positions *)
  80 %start file
  81 %pure
  82 %eop EOF
  83 %noshift EOF
  84
  85 %name Mlt
  86
  87 %left ANDALSO
  88 %left ORELSE
  89 %nonassoc EQ NEQ GT GTE LT LTE
  90 %left PLUS MINUS
  91 %left TIMES DIVIDE MOD
  92 %left STRCAT
  93 %nonassoc NEG
  94 %right CONS
  95
  96 %%
  97
  98 file    : block                         (block)
  99
 100 ilist   : IDENT ilist                   (IDENT :: ilist)
 101         | IDENT                         ([IDENT])
 102
 103 ivlist  : IDENT EQ exp COMMA ivlist     ((IDENT, exp) :: ivlist)
 104         | IDENT EQ exp                  ([(IDENT, exp)])
 105
 106 catch   : CATCH ppat LBRACE block RBRACE        (ppat, block)
 107
 108 catches : catch catches                         (catch::catches)
 109         | catch                                 ([catch])
 110
 111 blockItem       : HTML                  (BITEM (Html_i HTML, (HTMLleft, HTMLright)))
 112                 | REF ivlist            (BITEM (Ref_i ivlist, (REFleft, ivlistright)))
 113                 | OPEN pathList         (BITEM (Open_i pathList, (OPENleft, pathListright)))
 114                 | VAL pat EQ exp        (BITEM (Val_i (pat, exp), (patleft, expright)))
 115                 | IDENT ASN exp         (BITEM (Assn_i (IDENT, exp), (IDENTleft, expright)))
 116                 | exp                   (BITEM (Exp_i exp, (expleft, expright)))
 117                 | IF LPAREN exp RPAREN LBRACE block RBRACE ifte
 118                         (let val ((L, O), _) = ifte in
 119                                  BITEM (Ifthenelse_i((exp, block) :: L, O),
 120                                 (IFleft, ifteright))
 121                          end)
 122                 | FOREACH LPAREN IDENT IN exp RPAREN LBRACE block RBRACE
 123                         (BITEM (Foreach_i (IDENT, exp, block),
 124                                 (FOREACHleft, RBRACEright)))
 125                 | FOREACH LPAREN IDENT IN exp DOTDOT exp RPAREN LBRACE block RBRACE
 126                         (BITEM (For_i (IDENT, exp1, exp2, block),
 127                                 (FOREACHleft, RBRACEright)))
 128                 | CASE pexp matches
 129                         (BITEM (Case_i (pexp, #1 matches), (CASEleft, matchesright)))
 130                 | TRY LBRACE block RBRACE catches
 131                         (BITEM (TryCatch_i (block, catches), (TRYleft, catchesright)))
 132
 133 ifte    : ELSE LBRACE block RBRACE                              (([], SOME block), (ELSEleft, RBRACEright))
 134         | ELSE IF LPAREN exp RPAREN LBRACE block RBRACE ifte    (let val ((L, O), _) = ifte in
 135                                                                          (((exp, block) :: L, O), (ELSEleft, ifteright))
 136                                                                 end)
 137         |                                                       (([], NONE), (0, 0))
 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         | path                          (EXP (Ident_e path, (pathleft, pathright)))
 184         | INT                           (EXP (Int_e INT, (INTleft, INTright)))
 185         | NEG                           (EXP (Neg_e, (NEGleft, NEGright)))
 186         | DOLLAR                        (EXP (Param_e, (DOLLARleft, DOLLARright)))
 187         | AT IDENT                      (EXP (Template_e IDENT, (ATleft, IDENTright)))
 188         | HASH INT                      (EXP (Proj_e (Int.toString INT), (HASHleft, INTright)))
 189         | HASH IDENT                    (EXP (Proj_e IDENT, (HASHleft, IDENTright)))
 190         | LBRACK elseq RBRACK           (foldr (fn x => EXP (Cons_e x, (LBRACKleft, RBRACKright)))
 191                                                 (EXP (Ident_e ["nil"], (0, 0))) elseq)
 192
 193 exp     : apps                          (apps)
 194         | exp PLUS exp                  (EXP (Plus_e (exp1, exp2), (exp1left, exp2right)))
 195         | exp MINUS exp                 (EXP (Minus_e (exp1, exp2), (exp1left, exp2right)))
 196         | exp TIMES exp                 (EXP (Times_e (exp1, exp2), (exp1left, exp2right)))
 197         | exp DIVIDE exp                (EXP (Divide_e (exp1, exp2), (exp1left, exp2right)))
 198         | exp MOD exp                   (EXP (Mod_e (exp1, exp2), (exp1left, exp2right)))
 199         | exp EQ exp                    (EXP (Eq_e (exp1, exp2), (exp1left, exp2right)))
 200         | exp NEQ exp                   (EXP (Neq_e (exp1, exp2), (exp1left, exp2right)))
 201         | exp LT exp                    (EXP (Lt_e (exp1, exp2), (exp1left, exp2right)))
 202         | exp LTE exp                   (EXP (Lte_e (exp1, exp2), (exp1left, exp2right)))
 203         | exp GT exp                    (EXP (Gt_e (exp1, exp2), (exp1left, exp2right)))
 204         | exp GTE exp                   (EXP (Gte_e (exp1, exp2), (exp1left, exp2right)))
 205         | exp CONS exp                  (EXP (Cons_e (exp1, exp2), (exp1left, exp2right)))
 206         | exp STRCAT exp                (EXP (StrCat_e (exp1, exp2), (exp1left, exp2right)))
 207         | exp ORELSE exp                (EXP (Orelse_e (exp1, exp2), (exp1left, exp2right)))
 208         | exp ANDALSO exp               (EXP (Andalso_e (exp1, exp2), (exp1left, exp2right)))
 209
 210 matches : ppat LBRACE block RBRACE matches      (((ppat, block) :: (#1 matches), (ppatleft, matchesright)))
 211         |                                       ([], (0, 0))
 212
 213 rseq    : IDENT EQ pat COMMA rseq               ((IDENT, pat) :: rseq)
 214         | IDENT COMMA rseq                      ((IDENT, PAT (Ident_p [IDENT], (IDENTleft, IDENTright))) :: rseq)
 215         | IDENT                                 ([(IDENT, PAT (Ident_p [IDENT], (IDENTleft, IDENTright)))])
 216         | IDENT EQ pat                          ([(IDENT, pat)])
 217
 218 frseq   : IDENT EQ pat COMMA frseq              ((IDENT, pat) :: frseq)
 219         | IDENT COMMA frseq                     ((IDENT, PAT (Ident_p [IDENT], (IDENTleft, IDENTright))) :: frseq)
 220         | DOTDOTDOT                             ([])
 221
 222 ppat    : LPAREN pat RPAREN                     (PAT (unpat pat, (LPARENleft, RPARENright)))
 223         | LPAREN pseq RPAREN                    (PAT (Record_p (true, addNumbers pseq), (LPARENleft, LPARENright)))
 224         | LPAREN RPAREN                         (PAT (Record_p (true, []), (LPARENleft, RPARENright)))
 225
 226 pseq    : pat COMMA pseq                        (pat :: pseq)
 227         | pat COMMA pat                         ([pat1, pat2])
 228
 229 plseq   : pseq                                  (pseq)
 230         | pat                                   ([pat])
 231         |                                       ([])
 232
 233 pterm   : path                                  (PAT (Ident_p path, (pathleft, pathright)))
 234         | UNDER                                 (PAT (Wild_p, (UNDERleft, UNDERright)))
 235         | INT                                   (PAT (Int_p INT, (INTleft, INTright)))
 236         | STRING                                (PAT (String_p STRING, (STRINGleft, STRINGright)))
 237         | LBRACE rseq RBRACE                    (PAT (Record_p (false, sortRcs rseq), (LBRACEleft, RBRACEright)))
 238         | LBRACE RBRACE                         (PAT (Record_p (false, []), (LBRACEleft, RBRACEright)))
 239         | LBRACE frseq RBRACE                   (PAT (FlexRecord_p (sortRcs frseq), (LBRACEleft, RBRACEright)))
 240         | ppat                                  (ppat)
 241
 242 papp    : path papp                             (PAT (App_p (path, papp), (pathleft, pappright)))
 243         | pterm                                 (pterm)
 244
 245 pat     : papp CONS papp                        (PAT (Cons_p (papp1, papp2), (papp1left, papp2right)))
 246         | papp                                  (papp)
 247         | IDENT AS pat                          (PAT (As_p (IDENT, pat), (IDENTleft, patright)))
 248         | LBRACK plseq RBRACK                   (foldr (fn x => PAT (Cons_p x, (LBRACKleft, RBRACKright)))
 249                                                         (PAT (Ident_p ["nil"], (0, 0))) plseq)