Commit | Line | Data |
---|---|---|
c0a3b488 AC |
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 | |
8291a2b9 AC |
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 | |
c0a3b488 AC |
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 | |
8291a2b9 | 49 | | ANDALSO | ORELSE |
c0a3b488 | 50 | | IDENT of string | DOT | DOTDOT | DOTDOTDOT | COMMA | COLON | CARET | TILDE | UNDER |
8291a2b9 | 51 | | INT of int | STRING of string | CHAR of string | REAL of real |
c0a3b488 AC |
52 | |
53 | %nonterm | |
54 | file of block | |
55 | | block of block | |
56 | | exp of exp | |
8291a2b9 | 57 | | cases of (pat * exp) list |
c0a3b488 AC |
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 | |
8291a2b9 | 67 | | elseOpt of block option |
c0a3b488 AC |
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 | ||
8291a2b9 | 111 | catch : pat ARROW block (pat, block) |
c0a3b488 | 112 | |
8291a2b9 AC |
113 | catches : catches BAR catch (catch::catches) |
114 | | catch ([catch]) | |
c0a3b488 AC |
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))) | |
8291a2b9 AC |
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 | |
c0a3b488 | 126 | (BITEM (Foreach_i (IDENT, exp, block), |
8291a2b9 AC |
127 | (FOREACHleft, ENDright))) |
128 | | FOREACH IDENT IN exp DOTDOT exp DO block END | |
c0a3b488 | 129 | (BITEM (For_i (IDENT, exp1, exp2, block), |
8291a2b9 AC |
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) | |
c0a3b488 AC |
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))) | |
8291a2b9 | 183 | | REAL (EXP (Real_e REAL, (REALleft, REALright))) |
c0a3b488 AC |
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))) | |
8291a2b9 AC |
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) | |
c0a3b488 | 217 | |
8291a2b9 AC |
218 | matches : matches BAR pat ARROW block (((pat, block) :: (#1 matches), (matchesleft, blockright))) |
219 | | pat ARROW block ([(pat, block)], (patleft, blockright)) | |
c0a3b488 AC |
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))) | |
8291a2b9 AC |
245 | | CHAR (PAT (Char_p CHAR, (CHARleft, CHARright))) |
246 | | REAL (PAT (Real_p REAL, (REALleft, REALright))) | |
c0a3b488 AC |
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) |