From 760ea275ff60358b2c3cf61588cfd5dde27c4e0e Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adamc@hcoop.net>
Date: Sun, 13 Jun 2010 10:55:20 -0400
Subject: More generous wildification, covering map-records

---
 lib/ur/basis.urs  |  1 +
 src/elaborate.sml | 30 ++++++++++++++++++++++--------
 2 files changed, 23 insertions(+), 8 deletions(-)

diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs
index f2dffd38..f6141bc7 100644
--- a/lib/ur/basis.urs
+++ b/lib/ur/basis.urs
@@ -588,6 +588,7 @@ val useMore : ctx ::: {Unit} -> use1 ::: {Type} -> use2 ::: {Type}
 con xhtml = xml [Html]
 con page = xhtml [] []
 con xbody = xml [Body] [] []
+con xtable = xml [Body, Table] [] []
 con xtr = xml [Body, Tr] [] []
 con xform = xml [Body, Form] [] []
 
diff --git a/src/elaborate.sml b/src/elaborate.sml
index f219e2f2..505699bd 100644
--- a/src/elaborate.sml
+++ b/src/elaborate.sml
@@ -3281,15 +3281,29 @@ and wildifyStr env (str, sgn) =
                                       | 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
-- 
cgit v1.2.3