Mercurial > urweb
changeset 913:b26823138bf8
Fix structure wildification to take concrete con decls into account
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Tue, 25 Aug 2009 17:12:21 -0400 |
| parents | 771449d8b411 |
| children | 782f0b4eea67 |
| files | src/elaborate.sml |
| diffstat | 1 files changed, 14 insertions(+), 3 deletions(-) [+] |
line wrap: on
line diff
--- a/src/elaborate.sml Tue Aug 25 15:19:00 2009 -0400 +++ b/src/elaborate.sml Tue Aug 25 17:12:21 2009 -0400 @@ -3086,6 +3086,7 @@ (SOME c1, SOME c2) => SOME (L.CConcat (c1, c2), loc) | _ => NONE) | L'.CUnit => SOME (L.CUnit, loc) + | L'.CUnif (_, _, _, ref (SOME c)) => decompileCon env c | _ => NONE @@ -3094,7 +3095,9 @@ let val (needed, constraints, neededV) = case sgi of - L'.SgiConAbs (x, _, k) => (SM.insert (neededC, x, k), constraints, neededV) + L'.SgiCon (x, _, k, c) => (SM.insert (neededC, x, (k, SOME c)), + constraints, neededV) + | L'.SgiConAbs (x, _, k) => (SM.insert (neededC, x, (k, NONE)), constraints, neededV) | L'.SgiConstraint cs => (neededC, (env', cs, loc) :: constraints, neededV) | L'.SgiVal (x, _, t) => @@ -3154,15 +3157,23 @@ [] => ds' | xs => let - val ds'' = map (fn (x, k) => + val ds'' = map (fn (x, (k, co)) => let val k = case decompileKind k of NONE => (L.KWild, #2 str) | SOME k => k + val cwild = (L.CWild k, #2 str) + val c = + case co of + NONE => cwild + | SOME c => + case decompileCon env c of + NONE => cwild + | SOME c' => c' in - (L.DCon (x, NONE, cwild), #2 str) + (L.DCon (x, NONE, c), #2 str) end) xs in ds'' @ ds'