comparison src/mono_util.sml @ 100:f0f59e918cac

page declaration, up through monoize
author Adam Chlipala <adamc@hcoop.net>
date Thu, 10 Jul 2008 10:11:35 -0400
parents 82aaa1c406d3
children 5f04adf47f48
comparison
equal deleted inserted replaced
99:5182f0c80d2e 100:f0f59e918cac
203 S.bind2 (mft t, 203 S.bind2 (mft t,
204 fn t' => 204 fn t' =>
205 S.map2 (mfe ctx e, 205 S.map2 (mfe ctx e,
206 fn e' => 206 fn e' =>
207 (DVal (x, n, t', e'), loc))) 207 (DVal (x, n, t', e'), loc)))
208 | DPage (xts, e) =>
209 S.bind2 (ListUtil.mapfold (fn (x, t) =>
210 S.map2 (mft t,
211 fn t' =>
212 (x, t'))) xts,
213 fn xts' =>
214 S.map2 (mfe ctx e,
215 fn e' =>
216 (DPage (xts', e'), loc)))
208 in 217 in
209 mfd 218 mfd
210 end 219 end
211 220
212 fun mapfold {typ = fc, exp = fe, decl = fd} = 221 fun mapfold {typ = fc, exp = fe, decl = fd} =
237 nil => S.return2 nil 246 nil => S.return2 nil
238 | d :: ds' => 247 | d :: ds' =>
239 S.bind2 (mfd ctx d, 248 S.bind2 (mfd ctx d,
240 fn d' => 249 fn d' =>
241 let 250 let
242 val b = 251 val ctx' =
243 case #1 d' of 252 case #1 d' of
244 DVal (x, n, t, e) => NamedE (x, n, t, SOME e) 253 DVal (x, n, t, e) => bind (ctx, NamedE (x, n, t, SOME e))
245 val ctx' = bind (ctx, b) 254 | DPage _ => ctx
246 in 255 in
247 S.map2 (mff ctx' ds', 256 S.map2 (mff ctx' ds',
248 fn ds' => 257 fn ds' =>
249 d' :: ds') 258 d' :: ds')
250 end) 259 end)