Mercurial > urweb

comparison src/shake.sml @ 100:f0f59e918cac

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
page declaration, up through monoize
author Adam Chlipala <adamc@hcoop.net>
date Thu, 10 Jul 2008 10:11:35 -0400
parents 02f42e9a1825
children 813e5a52063d
comparison
equal deleted inserted replaced
99:5182f0c80d2e 100:f0f59e918cac
40 con : IS.set, 40 con : IS.set,
41 exp : IS.set 41 exp : IS.set
42 } 42 }
43 43
44 fun shake file = 44 fun shake file =
45 case List.foldl (fn ((DVal ("main", n, t, e), _), _) => SOME (n, t, e) 45 let
46 | (_, s) => s) NONE file of 46 val (page_cs, page_es) = List.foldl
47 NONE => [] 47 (fn ((DPage (c, e), _), (cs, es)) => (c :: cs, e :: es)
48 | SOME (main, mainT, body) => 48 | (_, acc) => acc) ([], []) file
49 let
50 val (cdef, edef) = foldl (fn ((DCon (_, n, _, c), _), (cdef, edef)) => (IM.insert (cdef, n, c), edef)
51 | ((DVal (_, n, t, e), _), (cdef, edef)) => (cdef, IM.insert (edef, n, (t, e))))
52 (IM.empty, IM.empty) file
53 49
54 fun kind (_, s) = s 50 val (cdef, edef) = foldl (fn ((DCon (_, n, _, c), _), (cdef, edef)) => (IM.insert (cdef, n, c), edef)
51 | ((DVal (_, n, t, e), _), (cdef, edef)) => (cdef, IM.insert (edef, n, (t, e)))
52 | ((DPage _, _), acc) => acc)
53 (IM.empty, IM.empty) file
55 54
56 fun con (c, s) = 55 fun kind (_, s) = s
57 case c of
58 CNamed n =>
59 if IS.member (#con s, n) then
60 s
61 else
62 let
63 val s' = {con = IS.add (#con s, n),
64 exp = #exp s}
65 in
66 case IM.find (cdef, n) of
67 NONE => s'
68 | SOME c => shakeCon s' c
69 end
70 | _ => s
71 56
72 and shakeCon s = U.Con.fold {kind = kind, con = con} s 57 fun con (c, s) =
58 case c of
59 CNamed n =>
60 if IS.member (#con s, n) then
61 s
62 else
63 let
64 val s' = {con = IS.add (#con s, n),
65 exp = #exp s}
66 in
67 case IM.find (cdef, n) of
68 NONE => s'
69 | SOME c => shakeCon s' c
70 end
71 | _ => s
73 72
74 fun exp (e, s) = 73 and shakeCon s = U.Con.fold {kind = kind, con = con} s
75 case e of
76 ENamed n =>
77 if IS.member (#exp s, n) then
78 s
79 else
80 let
81 val s' = {exp = IS.add (#exp s, n),
82 con = #con s}
83 in
84 case IM.find (edef, n) of
85 NONE => s'
86 | SOME (t, e) => shakeExp (shakeCon s' t) e
87 end
88 | _ => s
89 74
90 and shakeExp s = U.Exp.fold {kind = kind, con = con, exp = exp} s 75 fun exp (e, s) =
76 case e of
77 ENamed n =>
78 if IS.member (#exp s, n) then
79 s
80 else
81 let
82 val s' = {exp = IS.add (#exp s, n),
83 con = #con s}
84 in
85 case IM.find (edef, n) of
86 NONE => s'
87 | SOME (t, e) => shakeExp (shakeCon s' t) e
88 end
89 | _ => s
91 90
92 val s = {con = IS.empty, 91 and shakeExp s = U.Exp.fold {kind = kind, con = con, exp = exp} s
93 exp = IS.singleton main} 92
94 93 val s = {con = IS.empty, exp = IS.empty}
95 val s = U.Con.fold {kind = kind, con = con} s mainT 94
96 val s = U.Exp.fold {kind = kind, con = con, exp = exp} s body 95 val s = foldl (fn (c, s) => U.Con.fold {kind = kind, con = con} s c) s page_cs
97 in 96 val s = foldl (fn (e, s) => U.Exp.fold {kind = kind, con = con, exp = exp} s e) s page_es
98 List.filter (fn (DCon (_, n, _, _), _) => IS.member (#con s, n) 97 in
99 | (DVal (_, n, _, _), _) => IS.member (#exp s, n)) file 98 List.filter (fn (DCon (_, n, _, _), _) => IS.member (#con s, n)
100 end 99 | (DVal (_, n, _, _), _) => IS.member (#exp s, n)
100 | (DPage _, _) => true) file
101 end
101 102
102 end 103 end