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'