comparison src/flat_util.sml @ 101:717b6f8d8505

First executable generated
author Adam Chlipala <adamc@hcoop.net>
date Thu, 10 Jul 2008 11:13:49 -0400
parents 5182f0c80d2e
children 5f04adf47f48
comparison
equal deleted inserted replaced
100:f0f59e918cac 101:717b6f8d8505
268 S.bind2 (mft ran, 268 S.bind2 (mft ran,
269 fn ran' => 269 fn ran' =>
270 S.map2 (mfe ctx e, 270 S.map2 (mfe ctx e,
271 fn e' => 271 fn e' =>
272 (DFun (n, x, dom', ran', e'), loc)))) 272 (DFun (n, x, dom', ran', e'), loc))))
273 | DPage (xts, e) =>
274 S.bind2 (ListUtil.mapfold (fn (x, t) =>
275 S.map2 (mft t,
276 fn t' =>
277 (x, t'))) xts,
278 fn xts' =>
279 S.map2 (mfe ctx e,
280 fn e' =>
281 (DPage (xts', e'), loc)))
273 in 282 in
274 mfd 283 mfd
275 end 284 end
276 285
277 fun mapfold {typ = fc, exp = fe, decl = fd} = 286 fun mapfold {typ = fc, exp = fe, decl = fd} =
306 nil => S.return2 nil 315 nil => S.return2 nil
307 | d :: ds' => 316 | d :: ds' =>
308 S.bind2 (mfd ctx d, 317 S.bind2 (mfd ctx d,
309 fn d' => 318 fn d' =>
310 let 319 let
311 val b = 320 val ctx' =
312 case #1 d' of 321 case #1 d' of
313 DVal (x, n, t, e) => NamedE (x, n, t, SOME e) 322 DVal (x, n, t, e) => bind (ctx, NamedE (x, n, t, SOME e))
314 | DFun v => F v 323 | DFun v => bind (ctx, F v)
315 val ctx' = bind (ctx, b) 324 | DPage _ => ctx
316 in 325 in
317 S.map2 (mff ctx' ds', 326 S.map2 (mff ctx' ds',
318 fn ds' => 327 fn ds' =>
319 d' :: ds') 328 d' :: ds')
320 end) 329 end)