Mercurial > urweb
comparison src/mono_reduce.sml @ 579:0094e0242100
Propagated a source change into a dynamic document element
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Tue, 30 Dec 2008 15:53:04 -0500 |
parents | 1e589a60b86f |
children | 7c3c21eb5b4c |
comparison
equal
deleted
inserted
replaced
578:1e589a60b86f | 579:0094e0242100 |
---|---|
54 | ESome (_, e) => impure e | 54 | ESome (_, e) => impure e |
55 | EFfi _ => false | 55 | EFfi _ => false |
56 | EFfiApp ("Basis", "set_cookie", _) => true | 56 | EFfiApp ("Basis", "set_cookie", _) => true |
57 | EFfiApp ("Basis", "new_client_source", _) => true | 57 | EFfiApp ("Basis", "new_client_source", _) => true |
58 | EFfiApp ("Basis", "set_client_source", _) => true | 58 | EFfiApp ("Basis", "set_client_source", _) => true |
59 | EFfiApp ("Basis", "alert", _) => true | |
59 | EFfiApp _ => false | 60 | EFfiApp _ => false |
60 | EApp ((EFfi _, _), _) => false | 61 | EApp ((EFfi _, _), _) => false |
61 | EApp _ => true | 62 | EApp _ => true |
62 | 63 |
63 | EUnop (_, e) => impure e | 64 | EUnop (_, e) => impure e |
251 absCounts vis | 252 absCounts vis |
252 | _ => absCounts) | 253 | _ => absCounts) |
253 IM.empty file | 254 IM.empty file |
254 | 255 |
255 fun summarize d (e, _) = | 256 fun summarize d (e, _) = |
256 case e of | 257 let |
257 EPrim _ => [] | 258 val s = |
258 | ERel n => if n = d then [UseRel] else [] | 259 case e of |
259 | ENamed _ => [] | 260 EPrim _ => [] |
260 | ECon (_, _, NONE) => [] | 261 | ERel n => if n = d then [UseRel] else [] |
261 | ECon (_, _, SOME e) => summarize d e | 262 | ENamed _ => [] |
262 | ENone _ => [] | 263 | ECon (_, _, NONE) => [] |
263 | ESome (_, e) => summarize d e | 264 | ECon (_, _, SOME e) => summarize d e |
264 | EFfi _ => [] | 265 | ENone _ => [] |
265 | EFfiApp ("Basis", "set_cookie", _) => [Unsure] | 266 | ESome (_, e) => summarize d e |
266 | EFfiApp ("Basis", "new_client_source", _) => [Unsure] | 267 | EFfi _ => [] |
267 | EFfiApp ("Basis", "set_client_source", _) => [Unsure] | 268 | EFfiApp ("Basis", "set_cookie", es) => List.concat (map (summarize d) es) @ [Unsure] |
268 | EFfiApp (_, _, es) => List.concat (map (summarize d) es) | 269 | EFfiApp ("Basis", "new_client_source", es) => List.concat (map (summarize d) es) @ [Unsure] |
269 | EApp ((EFfi _, _), e) => summarize d e | 270 | EFfiApp ("Basis", "set_client_source", es) => List.concat (map (summarize d) es) @ [Unsure] |
270 | EApp _ => | 271 | EFfiApp ("Basis", "alert", es) => List.concat (map (summarize d) es) @ [Unsure] |
271 let | 272 | EFfiApp (_, _, es) => List.concat (map (summarize d) es) |
272 fun unravel (e, ls) = | 273 | EApp ((EFfi _, _), e) => summarize d e |
273 case e of | 274 | EApp _ => |
274 ENamed n => | 275 let |
275 let | 276 fun unravel (e, ls) = |
276 val ls = rev ls | 277 case e of |
277 in | 278 ENamed n => |
278 case IM.find (absCounts, n) of | 279 let |
279 NONE => [Unsure] | 280 val ls = rev ls |
280 | SOME len => | 281 in |
281 if length ls < len then | 282 case IM.find (absCounts, n) of |
282 ls | 283 NONE => [Unsure] |
283 else | 284 | SOME len => |
284 [Unsure] | 285 if length ls < len then |
285 end | 286 ls |
286 | ERel n => List.revAppend (ls, | 287 else |
287 if n = d then | 288 [Unsure] |
288 [UseRel, Unsure] | 289 end |
289 else | 290 | ERel n => List.revAppend (ls, |
290 [Unsure]) | 291 if n = d then |
291 | EApp (f, x) => | 292 [UseRel, Unsure] |
292 unravel (#1 f, summarize d x @ ls) | 293 else |
293 | _ => [Unsure] | 294 [Unsure]) |
294 in | 295 | EApp (f, x) => |
295 unravel (e, []) | 296 unravel (#1 f, summarize d x @ ls) |
296 end | 297 | _ => [Unsure] |
297 | 298 in |
298 | EAbs _ => [] | 299 unravel (e, []) |
299 | 300 end |
300 | EUnop (_, e) => summarize d e | 301 |
301 | EBinop (_, e1, e2) => summarize d e1 @ summarize d e2 | 302 | EAbs (_, _, _, e) => List.filter (fn UseRel => true |
302 | 303 | _ => false) (summarize (d + 1) e) |
303 | ERecord xets => List.concat (map (summarize d o #2) xets) | 304 |
304 | EField (e, _) => summarize d e | 305 | EUnop (_, e) => summarize d e |
305 | 306 | EBinop (_, e1, e2) => summarize d e1 @ summarize d e2 |
306 | ECase (e, pes, _) => | 307 |
307 let | 308 | ERecord xets => List.concat (map (summarize d o #2) xets) |
308 val lss = map (fn (p, e) => summarize (d + patBinds p) e) pes | 309 | EField (e, _) => summarize d e |
309 in | 310 |
310 case lss of | 311 | ECase (e, pes, _) => |
311 [] => raise Fail "Empty pattern match" | 312 let |
312 | ls :: lss => | 313 val lss = map (fn (p, e) => summarize (d + patBinds p) e) pes |
313 if List.all (fn ls' => ls' = ls) lss then | 314 in |
314 summarize d e @ ls | 315 case lss of |
315 else | 316 [] => raise Fail "Empty pattern match" |
316 [Unsure] | 317 | ls :: lss => |
317 end | 318 if List.all (fn ls' => ls' = ls) lss then |
318 | EStrcat (e1, e2) => summarize d e1 @ summarize d e2 | 319 summarize d e @ ls |
319 | 320 else |
320 | EError (e, _) => summarize d e @ [Unsure] | 321 [Unsure] |
321 | 322 end |
322 | EWrite e => summarize d e @ [WritePage] | 323 | EStrcat (e1, e2) => summarize d e1 @ summarize d e2 |
323 | 324 |
324 | ESeq (e1, e2) => summarize d e1 @ summarize d e2 | 325 | EError (e, _) => summarize d e @ [Unsure] |
325 | ELet (_, _, e1, e2) => summarize d e1 @ summarize (d + 1) e2 | 326 |
326 | 327 | EWrite e => summarize d e @ [WritePage] |
327 | EClosure (_, es) => List.concat (map (summarize d) es) | 328 |
328 | 329 | ESeq (e1, e2) => summarize d e1 @ summarize d e2 |
329 | EQuery {query, body, initial, ...} => | 330 | ELet (_, _, e1, e2) => summarize d e1 @ summarize (d + 1) e2 |
330 List.concat [summarize d query, | 331 |
331 summarize (d + 2) body, | 332 | EClosure (_, es) => List.concat (map (summarize d) es) |
332 summarize d initial, | 333 |
333 [ReadDb]] | 334 | EQuery {query, body, initial, ...} => |
334 | 335 List.concat [summarize d query, |
335 | EDml e => summarize d e @ [WriteDb] | 336 summarize (d + 2) body, |
336 | ENextval e => summarize d e @ [WriteDb] | 337 summarize d initial, |
337 | EUnurlify (e, _) => summarize d e | 338 [ReadDb]] |
338 | EJavaScript (_, e, _) => summarize d e | 339 |
339 | ESignalReturn e => summarize d e | 340 | EDml e => summarize d e @ [WriteDb] |
340 | ESignalBind (e1, e2) => summarize d e1 @ summarize d e2 | 341 | ENextval e => summarize d e @ [WriteDb] |
341 | ESignalSource e => summarize d e | 342 | EUnurlify (e, _) => summarize d e |
343 | EJavaScript (_, e, _) => summarize d e | |
344 | ESignalReturn e => summarize d e | |
345 | ESignalBind (e1, e2) => summarize d e1 @ summarize d e2 | |
346 | ESignalSource e => summarize d e | |
347 in | |
348 (*Print.prefaces "Summarize" | |
349 [("e", MonoPrint.p_exp MonoEnv.empty (e, ErrorMsg.dummySpan)), | |
350 ("d", Print.PD.string (Int.toString d)), | |
351 ("s", p_events s)];*) | |
352 s | |
353 end | |
342 | 354 |
343 fun exp env e = | 355 fun exp env e = |
344 let | 356 let |
345 (*val () = Print.prefaces "exp" [("e", MonoPrint.p_exp env (e, ErrorMsg.dummySpan))]*) | 357 (*val () = Print.prefaces "exp" [("e", MonoPrint.p_exp env (e, ErrorMsg.dummySpan))]*) |
346 | 358 |