Mercurial > urweb

comparison src/elaborate.sml @ 1585:d5fb78321cca

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Handle application in decompileCon
author Adam Chlipala <adam@chlipala.net>
date Wed, 02 Nov 2011 08:39:01 -0400
parents c37d8341940a
children 03ad79980b55
comparison
equal deleted inserted replaced
1584:c37d8341940a 1585:d5fb78321cca
3439 (SOME c1, SOME c2) => SOME (L.CConcat (c1, c2), loc) 3439 (SOME c1, SOME c2) => SOME (L.CConcat (c1, c2), loc)
3440 | _ => NONE) 3440 | _ => NONE)
3441 | L'.CUnit => SOME (L.CUnit, loc) 3441 | L'.CUnit => SOME (L.CUnit, loc)
3442 | L'.CUnif (nl, _, _, _, ref (SOME c)) => decompileCon env (E.mliftConInCon nl c) 3442 | L'.CUnif (nl, _, _, _, ref (SOME c)) => decompileCon env (E.mliftConInCon nl c)
3443 3443
3444 | _ => NONE 3444 | L'.CApp (f, x) =>
3445 (case (decompileCon env f, decompileCon env x) of
3446 (SOME f, SOME x) => SOME (L.CApp (f, x), loc)
3447 | _ => NONE)
3448
3449 | c => (Print.preface ("WTF?", p_con env (c, loc)); NONE)
3445 3450
3446 fun buildNeeded env sgis = 3451 fun buildNeeded env sgis =
3447 #1 (foldl (fn ((sgi, loc), (nd, env')) => 3452 #1 (foldl (fn ((sgi, loc), (nd, env')) =>
3448 (case sgi of 3453 (case sgi of
3449 L'.SgiCon (x, _, k, _) => naddCon (nd, x, k) 3454 L'.SgiCon (x, _, k, _) => naddCon (nd, x, k)
3505 let 3510 let
3506 val ds' = List.mapPartial (fn (env', (c1, c2), loc) => 3511 val ds' = List.mapPartial (fn (env', (c1, c2), loc) =>
3507 case (decompileCon env' c1, decompileCon env' c2) of 3512 case (decompileCon env' c1, decompileCon env' c2) of
3508 (SOME c1, SOME c2) => 3513 (SOME c1, SOME c2) =>
3509 SOME (L.DConstraint (c1, c2), loc) 3514 SOME (L.DConstraint (c1, c2), loc)
3510 | _ => NONE) (nconstraints nd) 3515 | _ => (Print.prefaces "BAD" [("c1", p_con env' c1),
3516 ("c2", p_con env' c2)];
3517 NONE)) (nconstraints nd)
3511 3518
3512 val ds' = 3519 val ds' =
3513 case SS.listItems (nvals nd) of 3520 case SS.listItems (nvals nd) of
3514 [] => ds' 3521 [] => ds'
3515 | xs => 3522 | xs =>