Mercurial > urweb

comparison src/core_util.sml @ 125:fd98dd10dce7

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Corifying (non-mutual) 'val rec'
author Adam Chlipala <adamc@hcoop.net>
date Thu, 17 Jul 2008 10:23:04 -0400
parents 3739af9e727a
children 4eb68ed31145
comparison
equal deleted inserted replaced
124:541282b81454 125:fd98dd10dce7
378 S.bind2 (mfk k, 378 S.bind2 (mfk k,
379 fn k' => 379 fn k' =>
380 S.map2 (mfc ctx c, 380 S.map2 (mfc ctx c,
381 fn c' => 381 fn c' =>
382 (DCon (x, n, k', c'), loc))) 382 (DCon (x, n, k', c'), loc)))
383 | DVal (x, n, t, e, s) => 383 | DVal vi =>
384 S.bind2 (mfc ctx t, 384 S.map2 (mfvi ctx vi,
385 fn t' => 385 fn vi' =>
386 S.map2 (mfe ctx e, 386 (DVal vi', loc))
387 fn e' => 387 | DValRec vis =>
388 (DVal (x, n, t', e', s), loc))) 388 S.map2 (ListUtil.mapfold (mfvi ctx) vis,
389 fn vis' =>
390 (DValRec vis', loc))
389 | DExport _ => S.return2 dAll 391 | DExport _ => S.return2 dAll
392
393 and mfvi ctx (x, n, t, e, s) =
394 S.bind2 (mfc ctx t,
395 fn t' =>
396 S.map2 (mfe ctx e,
397 fn e' =>
398 (x, n, t', e', s)))
390 in 399 in
391 mfd 400 mfd
392 end 401 end
393 402
394 fun mapfold {kind = fk, con = fc, exp = fe, decl = fd} = 403 fun mapfold {kind = fk, con = fc, exp = fe, decl = fd} =
433 let 442 let
434 val ctx' = 443 val ctx' =
435 case #1 d' of 444 case #1 d' of
436 DCon (x, n, k, c) => bind (ctx, NamedC (x, n, k, SOME c)) 445 DCon (x, n, k, c) => bind (ctx, NamedC (x, n, k, SOME c))
437 | DVal (x, n, t, e, s) => bind (ctx, NamedE (x, n, t, SOME e, s)) 446 | DVal (x, n, t, e, s) => bind (ctx, NamedE (x, n, t, SOME e, s))
447 | DValRec vis =>
448 foldl (fn ((x, n, t, e, s), ctx) => bind (ctx, NamedE (x, n, t, SOME e, s)))
449 ctx vis
438 | DExport _ => ctx 450 | DExport _ => ctx
439 in 451 in
440 S.map2 (mff ctx' ds', 452 S.map2 (mff ctx' ds',
441 fn ds' => 453 fn ds' =>
442 d' :: ds') 454 d' :: ds')