comparison src/core_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 275aaeb73f1f
children 5f04adf47f48
comparison
equal deleted inserted replaced
99:5182f0c80d2e 100:f0f59e918cac
374 S.bind2 (mfc ctx t, 374 S.bind2 (mfc ctx t,
375 fn t' => 375 fn t' =>
376 S.map2 (mfe ctx e, 376 S.map2 (mfe ctx e,
377 fn e' => 377 fn e' =>
378 (DVal (x, n, t', e'), loc))) 378 (DVal (x, n, t', e'), loc)))
379 | DPage (c, e) =>
380 S.bind2 (mfc ctx c,
381 fn c' =>
382 S.map2 (mfe ctx e,
383 fn e' =>
384 (DPage (c', e'), loc)))
379 in 385 in
380 mfd 386 mfd
381 end 387 end
382 388
383 fun mapfold {kind = fk, con = fc, exp = fe, decl = fd} = 389 fun mapfold {kind = fk, con = fc, exp = fe, decl = fd} =
410 nil => S.return2 nil 416 nil => S.return2 nil
411 | d :: ds' => 417 | d :: ds' =>
412 S.bind2 (mfd ctx d, 418 S.bind2 (mfd ctx d,
413 fn d' => 419 fn d' =>
414 let 420 let
415 val b = 421 val ctx' =
416 case #1 d' of 422 case #1 d' of
417 DCon (x, n, k, c) => NamedC (x, n, k, SOME c) 423 DCon (x, n, k, c) => bind (ctx, NamedC (x, n, k, SOME c))
418 | DVal (x, n, t, e) => NamedE (x, n, t, SOME e) 424 | DVal (x, n, t, e) => bind (ctx, NamedE (x, n, t, SOME e))
419 val ctx' = bind (ctx, b) 425 | DPage _ => ctx
420 in 426 in
421 S.map2 (mff ctx' ds', 427 S.map2 (mff ctx' ds',
422 fn ds' => 428 fn ds' =>
423 d' :: ds') 429 d' :: ds')
424 end) 430 end)