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