Mercurial > urweb

comparison src/mono_reduce.sml @ 1983:0ff4f64b4309

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merge in upstream
author Patrick Hurst <phurst@mit.edu>
date Wed, 29 Jan 2014 18:29:43 -0500
parents fec7beec96c7
children b15a4c2cb542
comparison
equal deleted inserted replaced
1982:2b95ecdd94eb 1983:0ff4f64b4309
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 _ => not isGlobal
68 | _ => false, 69 | _ => false,
69 bind = fn (env, b) => 70 bind = fn (env, b) =>
70 case b of 71 case b of
71 U.Exp.RelE (x, t) => E.pushERel env x t NONE 72 U.Exp.RelE (x, t) => E.pushERel env x t NONE
72 | _ => env} 73 | _ => env}
323 let 324 let
324 fun remaining e = 325 fun remaining e =
325 case #1 e of 326 case #1 e of
326 ENamed n => IM.find (absCounts, n) 327 ENamed n => IM.find (absCounts, n)
327 | EApp (e, arg) => 328 | EApp (e, arg) =>
328 if simpleImpure (timpures, impures) env arg then 329 if simpleImpure true (timpures, impures) env arg then
329 NONE 330 NONE
330 else 331 else
331 (case remaining e of 332 (case remaining e of
332 NONE => NONE 333 NONE => NONE
333 | SOME n => if n > 0 then 334 | SOME n => if n > 0 then
350 timpures, 351 timpures,
351 impures, 352 impures,
352 absCounts) 353 absCounts)
353 | DVal (_, n, _, e, _) => 354 | DVal (_, n, _, e, _) =>
354 (timpures, 355 (timpures,
355 if simpleImpure (timpures, impures) E.empty e then 356 if simpleImpure true (timpures, impures) E.empty e then
356 IS.add (impures, n) 357 IS.add (impures, n)
357 else 358 else
358 impures, 359 impures,
359 IM.insert (absCounts, n, countAbs E.empty e)) 360 IM.insert (absCounts, n, countAbs E.empty e))
360 | DValRec vis => 361 | DValRec vis =>
361 (timpures, 362 (timpures,
362 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
363 foldl (fn ((_, n, _, _, _), impures) => 364 foldl (fn ((_, n, _, _, _), impures) =>
364 IS.add (impures, n)) impures vis 365 IS.add (impures, n)) impures vis
365 else 366 else
366 impures, 367 impures,
367 foldl (fn ((x, n, _, e, _), absCounts) => 368 foldl (fn ((x, n, _, e, _), absCounts) =>
530 ("s", p_events s)];*) 531 ("s", p_events s)];*)
531 s 532 s
532 end 533 end
533 534
534 val impure = fn env => fn e => 535 val impure = fn env => fn e =>
535 simpleImpure (timpures, impures) env e andalso impure e 536 simpleImpure false (timpures, impures) env e andalso impure e
536 andalso not (List.null (summarize ~1 e)) 537 andalso not (List.null (summarize ~1 e))
537 538
538 fun passive (e : exp) = 539 fun passive (e : exp) =
539 case #1 e of 540 case #1 e of
540 EPrim _ => true 541 EPrim _ => true