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