Mercurial > urweb
diff src/elaborate.sml @ 721:9864b64b1700
Classes as optional arguments to Basis.tag
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Sun, 12 Apr 2009 14:19:15 -0400 |
parents | acb8537f58f0 |
children | 059074c8d2fc |
line wrap: on
line diff
--- a/src/elaborate.sml Sun Apr 12 12:31:54 2009 -0400 +++ b/src/elaborate.sml Sun Apr 12 14:19:15 2009 -0400 @@ -1493,26 +1493,28 @@ end | _ => (c, loc) -fun normClassKey envs c = +fun normClassKey env c = let - val c = hnormCon envs c + val c = hnormCon env c in case #1 c of L'.CApp (c1, c2) => let - val c1 = normClassKey envs c1 - val c2 = normClassKey envs c2 + val c1 = normClassKey env c1 + val c2 = normClassKey env c2 in (L'.CApp (c1, c2), #2 c) end - | _ => c + | L'.CRecord (k, xcs) => (L'.CRecord (k, map (fn (x, c) => (normClassKey env x, + normClassKey env c)) xcs), #2 c) + | _ => unmodCon env c end fun normClassConstraint env (c, loc) = case c of L'.CApp (f, x) => let - val f = unmodCon env f + val f = normClassKey env f val x = normClassKey env x in (L'.CApp (f, x), loc) @@ -1526,7 +1528,7 @@ end | L'.TCFun (expl, x, k, c1) => (L'.TCFun (expl, x, k, normClassConstraint env c1), loc) | L'.CUnif (_, _, _, ref (SOME c)) => normClassConstraint env c - | _ => (c, loc) + | _ => unmodCon env (c, loc) fun elabExp (env, denv) (eAll as (e, loc)) = let @@ -2047,6 +2049,7 @@ let val (c', ck, gs') = elabCon (env, denv) c + val old = c' val c' = normClassConstraint env c' val (env', n) = E.pushENamed env x c' in