| 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) |