adamc@96
|
1 (* Copyright (c) 2008, Adam Chlipala
|
adamc@96
|
2 * All rights reserved.
|
adamc@96
|
3 *
|
adamc@96
|
4 * Redistribution and use in source and binary forms, with or without
|
adamc@96
|
5 * modification, are permitted provided that the following conditions are met:
|
adamc@96
|
6 *
|
adamc@96
|
7 * - Redistributions of source code must retain the above copyright notice,
|
adamc@96
|
8 * this list of conditions and the following disclaimer.
|
adamc@96
|
9 * - Redistributions in binary form must reproduce the above copyright notice,
|
adamc@96
|
10 * this list of conditions and the following disclaimer in the documentation
|
adamc@96
|
11 * and/or other materials provided with the distribution.
|
adamc@96
|
12 * - The names of contributors may not be used to endorse or promote products
|
adamc@96
|
13 * derived from this software without specific prior written permission.
|
adamc@96
|
14 *
|
adamc@96
|
15 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
adamc@96
|
16 * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
adamc@96
|
17 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
|
adamc@96
|
18 * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
|
adamc@96
|
19 * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
|
adamc@96
|
20 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
|
adamc@96
|
21 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
|
adamc@96
|
22 * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
|
adamc@96
|
23 * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
|
adamc@96
|
24 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
|
adamc@96
|
25 * POSSIBILITY OF SUCH DAMAGE.
|
adamc@96
|
26 *)
|
adamc@96
|
27
|
adamc@96
|
28 structure MonoOpt :> MONO_OPT = struct
|
adamc@96
|
29
|
adamc@96
|
30 open Mono
|
adamc@96
|
31 structure U = MonoUtil
|
adamc@96
|
32
|
adamc@96
|
33 fun typ t = t
|
adamc@96
|
34 fun decl d = d
|
adamc@96
|
35
|
adamc@107
|
36 fun attrifyInt n =
|
adamc@107
|
37 if n < 0 then
|
adamc@107
|
38 "-" ^ Int64.toString (Int64.~ n)
|
adamc@107
|
39 else
|
adamc@107
|
40 Int64.toString n
|
adamc@107
|
41
|
adamc@107
|
42 fun attrifyFloat n =
|
adamc@107
|
43 if n < 0.0 then
|
adamc@107
|
44 "-" ^ Real.toString (Real.~ n)
|
adamc@107
|
45 else
|
adamc@107
|
46 Real.toString n
|
adamc@107
|
47
|
adamc@107
|
48 val attrifyString = String.translate (fn #"\"" => """
|
adamc@135
|
49 | #"&" => "&"
|
adamc@107
|
50 | ch => if Char.isPrint ch then
|
adamc@107
|
51 str ch
|
adamc@107
|
52 else
|
adamc@107
|
53 "&#" ^ Int.toString (ord ch) ^ ";")
|
adamc@107
|
54
|
adamc@120
|
55 val urlifyInt = attrifyInt
|
adamc@120
|
56 val urlifyFloat = attrifyFloat
|
adamc@120
|
57
|
adamc@286
|
58 val htmlifyInt = attrifyInt
|
adamc@286
|
59 val htmlifyFloat = attrifyFloat
|
adamc@135
|
60 val htmlifyString = String.translate (fn ch => case ch of
|
adamc@135
|
61 #"<" => "<"
|
adamc@135
|
62 | #"&" => "&"
|
adamc@135
|
63 | _ =>
|
adamc@135
|
64 if Char.isPrint ch orelse Char.isSpace ch then
|
adamc@135
|
65 str ch
|
adamc@135
|
66 else
|
adamc@135
|
67 "&#" ^ Int.toString (ord ch) ^ ";")
|
adamc@135
|
68
|
adamc@120
|
69 fun hexIt ch =
|
adamc@120
|
70 let
|
adamc@120
|
71 val s = Int.fmt StringCvt.HEX (ord ch)
|
adamc@120
|
72 in
|
adamc@120
|
73 case size s of
|
adamc@120
|
74 0 => "00"
|
adamc@120
|
75 | 1 => "0" ^ s
|
adamc@120
|
76 | _ => s
|
adamc@120
|
77 end
|
adamc@120
|
78
|
adamc@120
|
79 val urlifyString = String.translate (fn #" " => "+"
|
adamc@120
|
80 | ch => if Char.isAlphaNum ch then
|
adamc@120
|
81 str ch
|
adamc@120
|
82 else
|
adamc@120
|
83 "%" ^ hexIt ch)
|
adamc@253
|
84
|
adamc@253
|
85
|
adamc@281
|
86 fun sqlifyInt n = attrifyInt n ^ "::int8"
|
adamc@281
|
87 fun sqlifyFloat n = attrifyFloat n ^ "::float8"
|
adamc@253
|
88
|
adamc@259
|
89 fun sqlifyString s = "E'" ^ String.translate (fn #"'" => "\\'"
|
adamc@259
|
90 | ch => str ch)
|
adamc@281
|
91 (String.toString s) ^ "'::text"
|
adamc@453
|
92
|
adamc@96
|
93 fun exp e =
|
adamc@96
|
94 case e of
|
adamc@96
|
95 EPrim (Prim.String s) =>
|
adamc@96
|
96 let
|
adamc@96
|
97 val (_, chs) =
|
adamc@96
|
98 CharVector.foldl (fn (ch, (lastSpace, chs)) =>
|
adamc@96
|
99 let
|
adamc@96
|
100 val isSpace = Char.isSpace ch
|
adamc@96
|
101 in
|
adamc@96
|
102 if isSpace andalso lastSpace then
|
adamc@96
|
103 (true, chs)
|
adamc@96
|
104 else
|
adamc@96
|
105 (isSpace, ch :: chs)
|
adamc@96
|
106 end)
|
adamc@96
|
107 (false, []) s
|
adamc@96
|
108 in
|
adamc@96
|
109 EPrim (Prim.String (String.implode (rev chs)))
|
adamc@96
|
110 end
|
adamc@96
|
111
|
adamc@96
|
112 | EStrcat ((EPrim (Prim.String s1), loc), (EPrim (Prim.String s2), _)) =>
|
adamc@96
|
113 let
|
adamc@96
|
114 val s =
|
adamc@96
|
115 if size s1 > 0 andalso size s2 > 0
|
adamc@96
|
116 andalso Char.isSpace (String.sub (s1, size s1 - 1))
|
adamc@96
|
117 andalso Char.isSpace (String.sub (s2, 0)) then
|
adamc@96
|
118 s1 ^ String.extract (s2, 1, NONE)
|
adamc@96
|
119 else
|
adamc@96
|
120 s1 ^ s2
|
adamc@96
|
121 in
|
adamc@96
|
122 EPrim (Prim.String s)
|
adamc@96
|
123 end
|
adamc@105
|
124
|
adamc@105
|
125 | EStrcat ((EPrim (Prim.String s1), loc), (EStrcat ((EPrim (Prim.String s2), _), rest), _)) =>
|
adamc@105
|
126 let
|
adamc@105
|
127 val s =
|
adamc@105
|
128 if size s1 > 0 andalso size s2 > 0
|
adamc@105
|
129 andalso Char.isSpace (String.sub (s1, size s1 - 1))
|
adamc@105
|
130 andalso Char.isSpace (String.sub (s2, 0)) then
|
adamc@105
|
131 s1 ^ String.extract (s2, 1, NONE)
|
adamc@105
|
132 else
|
adamc@105
|
133 s1 ^ s2
|
adamc@105
|
134 in
|
adamc@105
|
135 EStrcat ((EPrim (Prim.String s), loc), rest)
|
adamc@105
|
136 end
|
adamc@105
|
137
|
adamc@105
|
138 | EStrcat ((EStrcat (e1, e2), loc), e3) =>
|
adamc@105
|
139 optExp (EStrcat (e1, (EStrcat (e2, e3), loc)), loc)
|
adamc@105
|
140
|
adamc@106
|
141 | EWrite (EStrcat (e1, e2), loc) =>
|
adamc@106
|
142 ESeq ((optExp (EWrite e1, loc), loc),
|
adamc@106
|
143 (optExp (EWrite e2, loc), loc))
|
adamc@106
|
144
|
adamc@183
|
145 | ESeq ((EWrite (EPrim (Prim.String s1), _), loc),
|
adamc@183
|
146 (EWrite (EPrim (Prim.String s2), _), _)) =>
|
adamc@183
|
147 EWrite (EPrim (Prim.String (s1 ^ s2)), loc)
|
adamc@196
|
148 | ESeq ((EWrite (EPrim (Prim.String s1), _), loc),
|
adamc@196
|
149 (ESeq ((EWrite (EPrim (Prim.String s2), _), _),
|
adamc@196
|
150 e), _)) =>
|
adamc@196
|
151 ESeq ((EWrite (EPrim (Prim.String (s1 ^ s2)), loc), loc),
|
adamc@196
|
152 e)
|
adamc@183
|
153
|
adamc@286
|
154 | EFfiApp ("Basis", "htmlifyString", [(EFfiApp ("Basis", "intToString", [(EPrim (Prim.Int n), _)]), _)]) =>
|
adamc@286
|
155 EPrim (Prim.String (htmlifyInt n))
|
adamc@286
|
156 | EFfiApp ("Basis", "htmlifyString", [(EFfiApp ("Basis", "intToString", es), _)]) =>
|
adamc@286
|
157 EFfiApp ("Basis", "htmlifyInt", es)
|
adamc@320
|
158 | EFfiApp ("Basis", "htmlifyString", [(EApp ((EFfi ("Basis", "intToString"), _),
|
adamc@320
|
159 (EPrim (Prim.Int n), _)), _)]) =>
|
adamc@320
|
160 EPrim (Prim.String (htmlifyInt n))
|
adamc@320
|
161 | EFfiApp ("Basis", "htmlifyString", [(EApp ((EFfi ("Basis", "intToString"), _),
|
adamc@320
|
162 e), _)]) =>
|
adamc@320
|
163 EFfiApp ("Basis", "htmlifyInt", [e])
|
adamc@286
|
164 | EWrite (EFfiApp ("Basis", "htmlifyInt", [e]), _) =>
|
adamc@286
|
165 EFfiApp ("Basis", "htmlifyInt_w", [e])
|
adamc@286
|
166
|
adamc@286
|
167 | EFfiApp ("Basis", "htmlifyString", [(EFfiApp ("Basis", "floatToString", [(EPrim (Prim.Float n), _)]), _)]) =>
|
adamc@286
|
168 EPrim (Prim.String (htmlifyFloat n))
|
adamc@286
|
169 | EFfiApp ("Basis", "htmlifyString", [(EFfiApp ("Basis", "floatToString", es), _)]) =>
|
adamc@286
|
170 EFfiApp ("Basis", "htmlifyFloat", es)
|
adamc@320
|
171 | EFfiApp ("Basis", "htmlifyString", [(EApp ((EFfi ("Basis", "floatToString"), _),
|
adamc@320
|
172 (EPrim (Prim.Float n), _)), _)]) =>
|
adamc@320
|
173 EPrim (Prim.String (htmlifyFloat n))
|
adamc@320
|
174 | EFfiApp ("Basis", "htmlifyString", [(EApp ((EFfi ("Basis", "floatToString"), _),
|
adamc@320
|
175 e), _)]) =>
|
adamc@320
|
176 EFfiApp ("Basis", "htmlifyFloat", [e])
|
adamc@286
|
177 | EWrite (EFfiApp ("Basis", "htmlifyFloat", [e]), _) =>
|
adamc@286
|
178 EFfiApp ("Basis", "htmlifyFloat_w", [e])
|
adamc@286
|
179
|
adamc@286
|
180 | EFfiApp ("Basis", "htmlifyString", [(EFfiApp ("Basis", "boolToString",
|
adamc@286
|
181 [(ECon (Enum, PConFfi {con = "True", ...}, NONE), _)]), _)]) =>
|
adamc@286
|
182 EPrim (Prim.String "True")
|
adamc@286
|
183 | EFfiApp ("Basis", "htmlifyString", [(EFfiApp ("Basis", "boolToString",
|
adamc@286
|
184 [(ECon (Enum, PConFfi {con = "False", ...}, NONE), _)]), _)]) =>
|
adamc@286
|
185 EPrim (Prim.String "False")
|
adamc@286
|
186 | EFfiApp ("Basis", "htmlifyString", [(EFfiApp ("Basis", "boolToString", es), _)]) =>
|
adamc@286
|
187 EFfiApp ("Basis", "htmlifyBool", es)
|
adamc@320
|
188 | EFfiApp ("Basis", "htmlifyString", [(EApp ((EFfi ("Basis", "boolToString"), _),
|
adamc@320
|
189 (ECon (Enum, PConFfi {con = "True", ...}, NONE), _)), _)]) =>
|
adamc@320
|
190 EPrim (Prim.String "True")
|
adamc@320
|
191 | EFfiApp ("Basis", "htmlifyString", [(EApp ((EFfi ("Basis", "boolToString"), _),
|
adamc@320
|
192 (ECon (Enum, PConFfi {con = "False", ...}, NONE), _)), _)]) =>
|
adamc@320
|
193 EPrim (Prim.String "False")
|
adamc@320
|
194 | EFfiApp ("Basis", "htmlifyString", [(EApp ((EFfi ("Basis", "boolToString"), _),
|
adamc@320
|
195 e), _)]) =>
|
adamc@320
|
196 EFfiApp ("Basis", "htmlifyBool", [e])
|
adamc@286
|
197 | EWrite (EFfiApp ("Basis", "htmlifyBool", [e]), _) =>
|
adamc@286
|
198 EFfiApp ("Basis", "htmlifyBool_w", [e])
|
adamc@286
|
199
|
adamc@436
|
200 | EFfiApp ("Basis", "htmlifyString", [(EApp ((EFfi ("Basis", "timeToString"), _), e), _)]) =>
|
adamc@436
|
201 EFfiApp ("Basis", "htmlifyTime", [e])
|
adamc@436
|
202 | EFfiApp ("Basis", "htmlifyString_w", [(EApp ((EFfi ("Basis", "timeToString"), _), e), _)]) =>
|
adamc@436
|
203 EFfiApp ("Basis", "htmlifyTime_w", [e])
|
adamc@436
|
204 | EWrite (EFfiApp ("Basis", "htmlifyTime", [e]), _) =>
|
adamc@436
|
205 EFfiApp ("Basis", "htmlifyTime_w", [e])
|
adamc@436
|
206
|
adamc@135
|
207 | EFfiApp ("Basis", "htmlifyString", [(EPrim (Prim.String s), _)]) =>
|
adamc@135
|
208 EPrim (Prim.String (htmlifyString s))
|
adamc@135
|
209 | EWrite (EFfiApp ("Basis", "htmlifyString", [(EPrim (Prim.String s), _)]), loc) =>
|
adamc@135
|
210 EWrite (EPrim (Prim.String (htmlifyString s)), loc)
|
adamc@135
|
211 | EWrite (EFfiApp ("Basis", "htmlifyString", [e]), _) =>
|
adamc@135
|
212 EFfiApp ("Basis", "htmlifyString_w", [e])
|
adamc@196
|
213 | EFfiApp ("Basis", "htmlifyString_w", [(EPrim (Prim.String s), loc)]) =>
|
adamc@196
|
214 EWrite (EPrim (Prim.String (htmlifyString s)), loc)
|
adamc@135
|
215
|
adamc@107
|
216 | EFfiApp ("Basis", "attrifyInt", [(EPrim (Prim.Int n), _)]) =>
|
adamc@107
|
217 EPrim (Prim.String (attrifyInt n))
|
adamc@107
|
218 | EWrite (EFfiApp ("Basis", "attrifyInt", [(EPrim (Prim.Int n), _)]), loc) =>
|
adamc@107
|
219 EWrite (EPrim (Prim.String (attrifyInt n)), loc)
|
adamc@106
|
220 | EWrite (EFfiApp ("Basis", "attrifyInt", [e]), _) =>
|
adamc@106
|
221 EFfiApp ("Basis", "attrifyInt_w", [e])
|
adamc@107
|
222
|
adamc@107
|
223 | EFfiApp ("Basis", "attrifyFloat", [(EPrim (Prim.Float n), _)]) =>
|
adamc@107
|
224 EPrim (Prim.String (attrifyFloat n))
|
adamc@107
|
225 | EWrite (EFfiApp ("Basis", "attrifyFloat", [(EPrim (Prim.Float n), _)]), loc) =>
|
adamc@107
|
226 EWrite (EPrim (Prim.String (attrifyFloat n)), loc)
|
adamc@106
|
227 | EWrite (EFfiApp ("Basis", "attrifyFloat", [e]), _) =>
|
adamc@106
|
228 EFfiApp ("Basis", "attrifyFloat_w", [e])
|
adamc@107
|
229
|
adamc@107
|
230 | EFfiApp ("Basis", "attrifyString", [(EPrim (Prim.String s), _)]) =>
|
adamc@107
|
231 EPrim (Prim.String (attrifyString s))
|
adamc@107
|
232 | EWrite (EFfiApp ("Basis", "attrifyString", [(EPrim (Prim.String s), _)]), loc) =>
|
adamc@107
|
233 EWrite (EPrim (Prim.String (attrifyString s)), loc)
|
adamc@106
|
234 | EWrite (EFfiApp ("Basis", "attrifyString", [e]), _) =>
|
adamc@106
|
235 EFfiApp ("Basis", "attrifyString_w", [e])
|
adamc@106
|
236
|
adamc@120
|
237 | EFfiApp ("Basis", "urlifyInt", [(EPrim (Prim.Int n), _)]) =>
|
adamc@120
|
238 EPrim (Prim.String (urlifyInt n))
|
adamc@120
|
239 | EWrite (EFfiApp ("Basis", "urlifyInt", [(EPrim (Prim.Int n), _)]), loc) =>
|
adamc@120
|
240 EWrite (EPrim (Prim.String (urlifyInt n)), loc)
|
adamc@120
|
241 | EWrite (EFfiApp ("Basis", "urlifyInt", [e]), _) =>
|
adamc@120
|
242 EFfiApp ("Basis", "urlifyInt_w", [e])
|
adamc@120
|
243
|
adamc@120
|
244 | EFfiApp ("Basis", "urlifyFloat", [(EPrim (Prim.Float n), _)]) =>
|
adamc@120
|
245 EPrim (Prim.String (urlifyFloat n))
|
adamc@120
|
246 | EWrite (EFfiApp ("Basis", "urlifyFloat", [(EPrim (Prim.Float n), _)]), loc) =>
|
adamc@120
|
247 EWrite (EPrim (Prim.String (urlifyFloat n)), loc)
|
adamc@120
|
248 | EWrite (EFfiApp ("Basis", "urlifyFloat", [e]), _) =>
|
adamc@120
|
249 EFfiApp ("Basis", "urlifyFloat_w", [e])
|
adamc@120
|
250
|
adamc@120
|
251 | EFfiApp ("Basis", "urlifyString", [(EPrim (Prim.String s), _)]) =>
|
adamc@120
|
252 EPrim (Prim.String (urlifyString s))
|
adamc@120
|
253 | EWrite (EFfiApp ("Basis", "urlifyString", [(EPrim (Prim.String s), _)]), loc) =>
|
adamc@120
|
254 EWrite (EPrim (Prim.String (urlifyString s)), loc)
|
adamc@120
|
255 | EWrite (EFfiApp ("Basis", "urlifyString", [e]), _) =>
|
adamc@120
|
256 EFfiApp ("Basis", "urlifyString_w", [e])
|
adamc@120
|
257
|
adamc@188
|
258 | EFfiApp ("Basis", "urlifyBool", [(ECon (Enum, PConFfi {con = "True", ...}, NONE), _)]) =>
|
adamc@187
|
259 EPrim (Prim.String "1")
|
adamc@188
|
260 | EFfiApp ("Basis", "urlifyBool", [(ECon (Enum, PConFfi {con = "False", ...}, NONE), _)]) =>
|
adamc@187
|
261 EPrim (Prim.String "0")
|
adamc@188
|
262 | EWrite (EFfiApp ("Basis", "urlifyBool", [(ECon (Enum, PConFfi {con = "True", ...}, NONE), _)]), loc) =>
|
adamc@187
|
263 EWrite (EPrim (Prim.String "1"), loc)
|
adamc@188
|
264 | EWrite (EFfiApp ("Basis", "urlifyBool", [(ECon (Enum, PConFfi {con = "False", ...}, NONE), _)]), loc) =>
|
adamc@187
|
265 EWrite (EPrim (Prim.String "0"), loc)
|
adamc@187
|
266 | EWrite (EFfiApp ("Basis", "urlifyBool", [e]), _) =>
|
adamc@187
|
267 EFfiApp ("Basis", "urlifyBool_w", [e])
|
adamc@187
|
268
|
adamc@253
|
269 | EFfiApp ("Basis", "sqlifyInt", [(EPrim (Prim.Int n), _)]) =>
|
adamc@253
|
270 EPrim (Prim.String (sqlifyInt n))
|
adamc@467
|
271 | EFfiApp ("Basis", "sqlifyIntN", [(ENone _, _)]) =>
|
adamc@467
|
272 EPrim (Prim.String "NULL")
|
adamc@467
|
273 | EFfiApp ("Basis", "sqlifyIntN", [(ESome (_, (EPrim (Prim.Int n), _)), _)]) =>
|
adamc@467
|
274 EPrim (Prim.String (sqlifyInt n))
|
adamc@467
|
275
|
adamc@253
|
276 | EFfiApp ("Basis", "sqlifyFloat", [(EPrim (Prim.Float n), _)]) =>
|
adamc@253
|
277 EPrim (Prim.String (sqlifyFloat n))
|
adamc@253
|
278 | EFfiApp ("Basis", "sqlifyBool", [b as (_, loc)]) =>
|
adamc@253
|
279 optExp (ECase (b,
|
adamc@253
|
280 [((PCon (Enum, PConFfi {mod = "Basis", datatyp = "bool", con = "True", arg = NONE}, NONE), loc),
|
adamc@253
|
281 (EPrim (Prim.String "TRUE"), loc)),
|
adamc@253
|
282 ((PCon (Enum, PConFfi {mod = "Basis", datatyp = "bool", con = "False", arg = NONE}, NONE), loc),
|
adamc@253
|
283 (EPrim (Prim.String "FALSE"), loc))],
|
adamc@253
|
284 {disc = (TFfi ("Basis", "bool"), loc),
|
adamc@253
|
285 result = (TFfi ("Basis", "string"), loc)}), loc)
|
adamc@253
|
286 | EFfiApp ("Basis", "sqlifyString", [(EPrim (Prim.String n), _)]) =>
|
adamc@253
|
287 EPrim (Prim.String (sqlifyString n))
|
adamc@253
|
288
|
adamc@184
|
289 | EWrite (ECase (discE, pes, {disc, ...}), loc) =>
|
adamc@184
|
290 optExp (ECase (discE,
|
adamc@184
|
291 map (fn (p, e) => (p, (EWrite e, loc))) pes,
|
adamc@184
|
292 {disc = disc,
|
adamc@184
|
293 result = (TRecord [], loc)}), loc)
|
adamc@184
|
294
|
adamc@495
|
295 | EApp ((ECase (discE, pes, {disc, result = (TFun (_, ran), _)}), loc), arg as (ERecord [], _)) =>
|
adamc@453
|
296 let
|
adamc@453
|
297 fun doBody e =
|
adamc@453
|
298 case #1 e of
|
adamc@453
|
299 EAbs (_, _, _, body) => MonoReduce.subExpInExp (0, arg) body
|
adamc@453
|
300 | _ => (EApp (e, arg), loc)
|
adamc@453
|
301 in
|
adamc@453
|
302 optExp (ECase (discE,
|
adamc@453
|
303 map (fn (p, e) => (p, doBody e)) pes,
|
adamc@453
|
304 {disc = disc,
|
adamc@495
|
305 result = ran}), loc)
|
adamc@453
|
306 end
|
adamc@453
|
307
|
adamc@331
|
308 | EWrite (EQuery {exps, tables, state, query,
|
adamc@331
|
309 initial = (EPrim (Prim.String ""), _),
|
adamc@331
|
310 body = (EStrcat ((EPrim (Prim.String s), _),
|
adamc@331
|
311 (EStrcat ((ERel 0, _),
|
adamc@331
|
312 e'), _)), _)}, loc) =>
|
adamc@331
|
313 if CharVector.all Char.isSpace s then
|
adamc@331
|
314 EQuery {exps = exps, tables = tables, query = query,
|
adamc@331
|
315 state = (TRecord [], loc),
|
adamc@331
|
316 initial = (ERecord [], loc),
|
adamc@331
|
317 body = (optExp (EWrite e', loc), loc)}
|
adamc@331
|
318 else
|
adamc@331
|
319 e
|
adamc@331
|
320
|
adamc@334
|
321 | EWrite (EQuery {exps, tables, state, query,
|
adamc@334
|
322 initial = (EPrim (Prim.String ""), _),
|
adamc@486
|
323 body}, loc) =>
|
adamc@486
|
324 let
|
adamc@486
|
325 fun passLets (depth, (e', _), lets) =
|
adamc@486
|
326 case e' of
|
adamc@486
|
327 EStrcat ((ERel x, _), e'') =>
|
adamc@486
|
328 if x = depth then
|
adamc@486
|
329 let
|
adamc@486
|
330 val body = (optExp (EWrite e'', loc), loc)
|
adamc@486
|
331 val body = foldl (fn ((x, t, e'), e) =>
|
adamc@486
|
332 (ELet (x, t, e', e), loc))
|
adamc@486
|
333 body lets
|
adamc@486
|
334 in
|
adamc@486
|
335 EQuery {exps = exps, tables = tables, query = query,
|
adamc@486
|
336 state = (TRecord [], loc),
|
adamc@486
|
337 initial = (ERecord [], loc),
|
adamc@486
|
338 body = body}
|
adamc@486
|
339 end
|
adamc@486
|
340 else
|
adamc@486
|
341 e
|
adamc@486
|
342 | ELet (x, t, e', e'') =>
|
adamc@486
|
343 passLets (depth + 1, e'', (x, t, e') :: lets)
|
adamc@486
|
344 | _ => e
|
adamc@486
|
345 in
|
adamc@486
|
346 passLets (0, body, [])
|
adamc@486
|
347 end
|
adamc@486
|
348
|
adamc@486
|
349 (*| EWrite (EQuery {exps, tables, state, query,
|
adamc@486
|
350 initial = (EPrim (Prim.String ""), _),
|
adamc@334
|
351 body = (EStrcat ((ERel 0, _), e'), _)}, loc) =>
|
adamc@334
|
352 EQuery {exps = exps, tables = tables, query = query,
|
adamc@334
|
353 state = (TRecord [], loc),
|
adamc@334
|
354 initial = (ERecord [], loc),
|
adamc@486
|
355 body = (optExp (EWrite e', loc), loc)}*)
|
adamc@334
|
356
|
adamc@340
|
357 | EWrite (ELet (x, t, e1, e2), loc) =>
|
adamc@340
|
358 optExp (ELet (x, t, e1, (EWrite e2, loc)), loc)
|
adamc@340
|
359
|
adamc@451
|
360 | EWrite (EPrim (Prim.String ""), loc) =>
|
adamc@451
|
361 ERecord []
|
adamc@451
|
362
|
adamc@96
|
363 | _ => e
|
adamc@96
|
364
|
adamc@105
|
365 and optExp e = #1 (U.Exp.map {typ = typ, exp = exp} e)
|
adamc@105
|
366
|
adamc@96
|
367 val optimize = U.File.map {typ = typ, exp = exp, decl = decl}
|
adamc@96
|
368
|
adamc@506
|
369 val optExp = U.Exp.map {typ = typ, exp = exp}
|
adamc@506
|
370
|
adamc@96
|
371 end
|