Mercurial > urweb

comparison src/mono_reduce.sml @ 1963:fec7beec96c7

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Make that purity analysis a bit more lax again
author Adam Chlipala <adam@chlipala.net>
date Sun, 19 Jan 2014 14:31:55 -0500
parents 16c219c74426
children b15a4c2cb542
comparison
equal deleted inserted replaced
1962:16c219c74426 1963:fec7beec96c7
43 fun simpleTypeImpure tsyms = 43 fun simpleTypeImpure tsyms =
44 U.Typ.exists (fn TFun _ => true 44 U.Typ.exists (fn TFun _ => true
45 | TDatatype (n, _) => IS.member (tsyms, n) 45 | TDatatype (n, _) => IS.member (tsyms, n)
46 | _ => false) 46 | _ => false)
47 47
48 fun simpleImpure (tsyms, syms) = 48 fun simpleImpure isGlobal (tsyms, syms) =
49 U.Exp.existsB {typ = fn _ => false, 49 U.Exp.existsB {typ = fn _ => false,
50 exp = fn (env, e) => 50 exp = fn (env, e) =>
51 case e of 51 case e of
52 EWrite _ => true 52 EWrite _ => true
53 | EQuery _ => true 53 | EQuery _ => true
63 let 63 let
64 val (_, t, _) = E.lookupERel env n 64 val (_, t, _) = E.lookupERel env n
65 in 65 in
66 simpleTypeImpure tsyms t 66 simpleTypeImpure tsyms t
67 end 67 end
68 | EApp _ => true 68 | EApp _ => not isGlobal
69 | _ => false, 69 | _ => false,
70 bind = fn (env, b) => 70 bind = fn (env, b) =>
71 case b of 71 case b of
72 U.Exp.RelE (x, t) => E.pushERel env x t NONE 72 U.Exp.RelE (x, t) => E.pushERel env x t NONE
73 | _ => env} 73 | _ => env}
324 let 324 let
325 fun remaining e = 325 fun remaining e =
326 case #1 e of 326 case #1 e of
327 ENamed n => IM.find (absCounts, n) 327 ENamed n => IM.find (absCounts, n)
328 | EApp (e, arg) => 328 | EApp (e, arg) =>
329 if simpleImpure (timpures, impures) env arg then 329 if simpleImpure true (timpures, impures) env arg then
330 NONE 330 NONE
331 else 331 else
332 (case remaining e of 332 (case remaining e of
333 NONE => NONE 333 NONE => NONE
334 | SOME n => if n > 0 then 334 | SOME n => if n > 0 then
351 timpures, 351 timpures,
352 impures, 352 impures,
353 absCounts) 353 absCounts)
354 | DVal (_, n, _, e, _) => 354 | DVal (_, n, _, e, _) =>
355 (timpures, 355 (timpures,
356 if simpleImpure (timpures, impures) E.empty e then 356 if simpleImpure true (timpures, impures) E.empty e then
357 IS.add (impures, n) 357 IS.add (impures, n)
358 else 358 else
359 impures, 359 impures,
360 IM.insert (absCounts, n, countAbs E.empty e)) 360 IM.insert (absCounts, n, countAbs E.empty e))
361 | DValRec vis => 361 | DValRec vis =>
362 (timpures, 362 (timpures,
363 if List.exists (fn (_, _, _, e, _) => simpleImpure (timpures, impures) E.empty e) vis then 363 if List.exists (fn (_, _, _, e, _) => simpleImpure true (timpures, impures) E.empty e) vis then
364 foldl (fn ((_, n, _, _, _), impures) => 364 foldl (fn ((_, n, _, _, _), impures) =>
365 IS.add (impures, n)) impures vis 365 IS.add (impures, n)) impures vis
366 else 366 else
367 impures, 367 impures,
368 foldl (fn ((x, n, _, e, _), absCounts) => 368 foldl (fn ((x, n, _, e, _), absCounts) =>
531 ("s", p_events s)];*) 531 ("s", p_events s)];*)
532 s 532 s
533 end 533 end
534 534
535 val impure = fn env => fn e => 535 val impure = fn env => fn e =>
536 simpleImpure (timpures, impures) env e andalso impure e 536 simpleImpure false (timpures, impures) env e andalso impure e
537 andalso not (List.null (summarize ~1 e)) 537 andalso not (List.null (summarize ~1 e))
538 538
539 fun passive (e : exp) = 539 fun passive (e : exp) =
540 case #1 e of 540 case #1 e of
541 EPrim _ => true 541 EPrim _ => true