Mercurial > urweb

comparison src/core_util.sml @ 127:4eb68ed31145

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Reducing (non-mutual) 'val rec'
author Adam Chlipala <adamc@hcoop.net>
date Thu, 17 Jul 2008 10:43:16 -0400
parents fd98dd10dce7
children 7420fa18d657
comparison
equal deleted inserted replaced
126:76a4d69719d8 127:4eb68ed31145
383 | DVal vi => 383 | DVal vi =>
384 S.map2 (mfvi ctx vi, 384 S.map2 (mfvi ctx vi,
385 fn vi' => 385 fn vi' =>
386 (DVal vi', loc)) 386 (DVal vi', loc))
387 | DValRec vis => 387 | DValRec vis =>
388 S.map2 (ListUtil.mapfold (mfvi ctx) vis, 388 let
389 fn vis' => 389 val ctx = foldl (fn ((x, n, t, e, s), ctx) => bind (ctx, NamedE (x, n, t, NONE, s)))
390 (DValRec vis', loc)) 390 ctx vis
391 in
392 S.map2 (ListUtil.mapfold (mfvi ctx) vis,
393 fn vis' =>
394 (DValRec vis', loc))
395 end
391 | DExport _ => S.return2 dAll 396 | DExport _ => S.return2 dAll
392 397
393 and mfvi ctx (x, n, t, e, s) = 398 and mfvi ctx (x, n, t, e, s) =
394 S.bind2 (mfc ctx t, 399 S.bind2 (mfc ctx t,
395 fn t' => 400 fn t' =>
443 val ctx' = 448 val ctx' =
444 case #1 d' of 449 case #1 d' of
445 DCon (x, n, k, c) => bind (ctx, NamedC (x, n, k, SOME c)) 450 DCon (x, n, k, c) => bind (ctx, NamedC (x, n, k, SOME c))
446 | DVal (x, n, t, e, s) => bind (ctx, NamedE (x, n, t, SOME e, s)) 451 | DVal (x, n, t, e, s) => bind (ctx, NamedE (x, n, t, SOME e, s))
447 | DValRec vis => 452 | DValRec vis =>
448 foldl (fn ((x, n, t, e, s), ctx) => bind (ctx, NamedE (x, n, t, SOME e, s))) 453 foldl (fn ((x, n, t, e, s), ctx) => bind (ctx, NamedE (x, n, t, NONE, s)))
449 ctx vis 454 ctx vis
450 | DExport _ => ctx 455 | DExport _ => ctx
451 in 456 in
452 S.map2 (mff ctx' ds', 457 S.map2 (mff ctx' ds',
453 fn ds' => 458 fn ds' =>