Mercurial > urweb

comparison src/mono_reduce.sml @ 579:0094e0242100

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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