Mercurial > urweb
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) |