Mercurial > urweb

comparison src/core_untangle.sml @ 455:d4a81273d4b1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Nested demo
author Adam Chlipala <adamc@hcoop.net>
date Tue, 04 Nov 2008 09:33:35 -0500
parents 9163f8014f9b
children 23a88d81a1b5
comparison
equal deleted inserted replaced
454:9163f8014f9b 455:d4a81273d4b1
43 43
44 | _ => s 44 | _ => s
45 45
46 fun untangle file = 46 fun untangle file =
47 let 47 let
48 val edefs = foldl (fn ((d, _), edefs) =>
49 case d of
50 DVal (_, n, _, e, _) => IM.insert (edefs, n, e)
51 | DValRec vis =>
52 foldl (fn ((_, n, _, e, _), edefs) =>
53 IM.insert (edefs, n, e)) edefs vis
54 | _ => edefs)
55 IM.empty file
56
48 fun decl (dAll as (d, loc)) = 57 fun decl (dAll as (d, loc)) =
49 case d of 58 case d of
50 DValRec vis => 59 DValRec vis =>
51 let 60 let
52 val thisGroup = foldl (fn ((_, n, _, _, _), thisGroup) => 61 val thisGroup = foldl (fn ((_, n, _, _, _), thisGroup) =>
53 IS.add (thisGroup, n)) IS.empty vis 62 IS.add (thisGroup, n)) IS.empty vis
54 63
64 val expUsed = U.Exp.fold {con = default,
65 kind = default,
66 exp = exp} IS.empty
67
55 val used = foldl (fn ((_, n, _, e, _), used) => 68 val used = foldl (fn ((_, n, _, e, _), used) =>
56 let 69 let
57 val usedHere = U.Exp.fold {con = default, 70 val usedHere = expUsed e
58 kind = default,
59 exp = exp} IS.empty e
60 in 71 in
61 IM.insert (used, n, IS.intersection (usedHere, thisGroup)) 72 IM.insert (used, n, usedHere)
62 end) 73 end)
63 IM.empty vis 74 IM.empty vis
75
76 fun expand used =
77 IS.foldl (fn (n, used) =>
78 case IM.find (edefs, n) of
79 NONE => used
80 | SOME e =>
81 let
82 val usedHere = expUsed e
83 in
84 if IS.isEmpty (IS.difference (usedHere, used)) then
85 used
86 else
87 expand (IS.union (usedHere, used))
88 end)
89 used used
90
91 val used = IM.map (fn s => IS.intersection (expand s, thisGroup)) used
64 92
65 fun p_graph reachable = 93 fun p_graph reachable =
66 IM.appi (fn (n, reachableHere) => 94 IM.appi (fn (n, reachableHere) =>
67 (print (Int.toString n); 95 (print (Int.toString n);
68 print ":"; 96 print ":";