Mercurial > urweb

comparison src/elaborate.sml @ 1865:5144e03ef603

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Potentially exponential search through where to head-normalize in [decompileCon]
author Adam Chlipala <adam@chlipala.net>
date Mon, 19 Aug 2013 12:38:43 -0400
parents 1aa9629e3a4c
children d6b0ee53dc93
comparison
equal deleted inserted replaced
1864:1aa9629e3a4c 1865:5144e03ef603
3551 3551
3552 | L'.KRel _ => NONE 3552 | L'.KRel _ => NONE
3553 | L'.KFun _ => NONE 3553 | L'.KFun _ => NONE
3554 3554
3555 fun maybeHnorm env c = 3555 fun maybeHnorm env c =
3556 hnormCon env c 3556 hnormCon env c
3557 handle E.UnboundNamed _ => c 3557 handle E.UnboundNamed _ => c
3558 3558
3559 fun decompileCon env (c as (_, loc)) = 3559 fun decompileCon env c =
3560 case #1 (maybeHnorm env c) of 3560 case decompileCon' env c of
3561 SOME v => SOME v
3562 | NONE => decompileCon' env (maybeHnorm env c)
3563
3564 and decompileCon' env (c as (_, loc)) =
3565 case #1 c of
3561 L'.CRel i => 3566 L'.CRel i =>
3562 let 3567 let
3563 val (s, _) = E.lookupCRel env i 3568 val (s, _) = E.lookupCRel env i
3564 in 3569 in
3565 SOME (L.CVar ([], s), loc) 3570 SOME (L.CVar ([], s), loc)
3617 NONE => NONE 3622 NONE => NONE
3618 | SOME cs' => SOME (L.CTuple cs', loc) 3623 | SOME cs' => SOME (L.CTuple cs', loc)
3619 end 3624 end
3620 3625
3621 | L'.CMap _ => SOME (L.CMap, loc) 3626 | L'.CMap _ => SOME (L.CMap, loc)
3627 | L'.TRecord c =>
3628 (case decompileCon env c of
3629 NONE => NONE
3630 | SOME c' => SOME (L.TRecord c', loc))
3622 3631
3623 | c => (Print.preface ("WTF?", p_con env (c, loc)); NONE) 3632 | c => (Print.preface ("WTF?", p_con env (c, loc)); NONE)
3624 3633
3625 fun buildNeeded env sgis = 3634 fun buildNeeded env sgis =
3626 #1 (foldl (fn ((sgi, loc), (nd, env')) => 3635 #1 (foldl (fn ((sgi, loc), (nd, env')) =>