Mercurial > urweb
changeset 1277:1e6a4f9d3e4a
More generous wildification, covering map-records
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Sun, 13 Jun 2010 10:55:20 -0400 |
| parents | 5b5c0b552f59 |
| children | cd8d2c73ccf4 |
| files | lib/ur/basis.urs src/elaborate.sml |
| diffstat | 2 files changed, 23 insertions(+), 8 deletions(-) [+] |
line wrap: on
line diff
--- a/lib/ur/basis.urs Sat Jun 05 09:42:37 2010 -0400 +++ b/lib/ur/basis.urs Sun Jun 13 10:55:20 2010 -0400 @@ -588,6 +588,7 @@ 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] [] []
--- 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