Mercurial > urweb
comparison src/shake.sml @ 1080:a4979e31e4bf
Another try at reasonable Especialize, this time with a custom traversal
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Sun, 20 Dec 2009 15:17:43 -0500 |
parents | 0657e5adc938 |
children | 72670131dace |
comparison
equal
deleted
inserted
replaced
1079:d069b193ed6b | 1080:a4979e31e4bf |
---|---|
127 end | 127 end |
128 | _ => s | 128 | _ => s |
129 | 129 |
130 and shakeCon s = U.Con.fold {kind = kind, con = con} s | 130 and shakeCon s = U.Con.fold {kind = kind, con = con} s |
131 | 131 |
132 (*val () = print "=====\nSHAKE\n=====\n" | |
133 val current = ref 0*) | |
134 | |
132 fun exp (e, s) = | 135 fun exp (e, s) = |
133 let | 136 let |
134 fun check n = | 137 fun check n = |
135 if IS.member (#exp s, n) then | 138 if IS.member (#exp s, n) then |
136 s | 139 s |
137 else | 140 else |
138 let | 141 let |
139 val s' = {exp = IS.add (#exp s, n), | 142 val s' = {exp = IS.add (#exp s, n), |
140 con = #con s} | 143 con = #con s} |
141 in | 144 in |
142 (*print ("Need " ^ Int.toString n ^ "\n");*) | 145 (*print ("Need " ^ Int.toString n ^ " <-- " ^ Int.toString (!current) ^ "\n");*) |
143 case IM.find (edef, n) of | 146 case IM.find (edef, n) of |
144 NONE => s' | 147 NONE => s' |
145 | SOME (ns, t, e) => | 148 | SOME (ns, t, e) => |
146 let | 149 let |
150 (*val old = !current | |
151 val () = current := n*) | |
147 val s' = shakeExp (shakeCon s' t) e | 152 val s' = shakeExp (shakeCon s' t) e |
148 in | 153 in |
154 (*current := old;*) | |
149 foldl (fn (n, s') => exp (ENamed n, s')) s' ns | 155 foldl (fn (n, s') => exp (ENamed n, s')) s' ns |
150 end | 156 end |
151 end | 157 end |
152 in | 158 in |
153 case e of | 159 case e of |
163 val s = IS.foldl (fn (n, s) => | 169 val s = IS.foldl (fn (n, s) => |
164 case IM.find (edef, n) of | 170 case IM.find (edef, n) of |
165 NONE => raise Fail "Shake: Couldn't find 'val'" | 171 NONE => raise Fail "Shake: Couldn't find 'val'" |
166 | SOME (ns, t, e) => | 172 | SOME (ns, t, e) => |
167 let | 173 let |
174 (*val () = current := n*) | |
168 val s = shakeExp (shakeCon s t) e | 175 val s = shakeExp (shakeCon s t) e |
169 in | 176 in |
170 foldl (fn (n, s) => exp (ENamed n, s)) s ns | 177 foldl (fn (n, s) => exp (ENamed n, s)) s ns |
171 end) s usedE | 178 end) s usedE |
172 | 179 |