Mercurial > urweb
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