diff src/elaborate.sml @ 1277:1e6a4f9d3e4a

More generous wildification, covering map-records
author Adam Chlipala <adamc@hcoop.net>
date Sun, 13 Jun 2010 10:55:20 -0400
parents 74150edf1134
children b4480a56cab7
line wrap: on
line diff
--- a/src/elaborate.sml	Sat Jun 05 09:42:37 2010 -0400
+++ b/src/elaborate.sml	Sun Jun 13 10:55:20 2010 -0400
@@ -3281,15 +3281,29 @@
                                       | L'.SgiConstraint cs => naddConstraint (nd, (env', cs, loc))
                                       | L'.SgiVal (x, _, t) =>
                                         let
-                                            val t = normClassConstraint env' t
+                                            fun should t =
+                                                let
+                                                    val t = normClassConstraint env' t
+                                                in
+                                                    case #1 t of
+                                                        L'.CApp (f, _) => isClassOrFolder env' f
+                                                      | L'.TRecord t =>
+                                                        (case hnormCon env' t of
+                                                             (L'.CApp (f, _), _) =>
+                                                             (case hnormCon env' f of
+                                                                  (L'.CApp (f, cl), loc) =>
+                                                                  (case hnormCon env' f of
+                                                                       (L'.CMap _, _) => isClassOrFolder env' cl
+                                                                     | _ => false)
+                                                                | _ => false)
+                                                           | _ => false)
+                                                      | _ => false
+                                                end
                                          in
-                                            case #1 t of
-                                                L'.CApp (f, _) =>
-                                                if isClassOrFolder env' f then
-                                                    naddVal (nd, x)
-                                                else
-                                                    nd
-                                              | _ => nd
+                                            if should t then
+                                                naddVal (nd, x)
+                                            else
+                                                nd
                                         end
                                       | L'.SgiStr (x, _, s) =>
                                         (case #1 (hnormSgn env' s) of