diff options
author | Adam Chlipala <adamc@hcoop.net> | 2010-06-13 10:55:20 -0400 |
---|---|---|
committer | Adam Chlipala <adamc@hcoop.net> | 2010-06-13 10:55:20 -0400 |
commit | 760ea275ff60358b2c3cf61588cfd5dde27c4e0e (patch) | |
tree | 59064e362b29f62b3790517e3bb247a63ad369c7 | |
parent | a447259a4463af8331b4a47e660fd00bd5d03ef8 (diff) |
More generous wildification, covering map-records
-rw-r--r-- | lib/ur/basis.urs | 1 | ||||
-rw-r--r-- | 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 |