Mercurial > urweb
changeset 327:3a57f3b3a3f8
Fix bug in subsignature check for con synonyms
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Thu, 11 Sep 2008 18:36:20 -0400 |
| parents | 950320f33232 |
| children | 58f1260f293f |
| files | src/elaborate.sml tests/crud.ur |
| diffstat | 2 files changed, 12 insertions(+), 3 deletions(-) [+] |
line wrap: on
line diff
--- a/src/elaborate.sml Thu Sep 11 18:32:41 2008 -0400 +++ b/src/elaborate.sml Thu Sep 11 18:36:20 2008 -0400 @@ -2478,7 +2478,16 @@ fun found (x', n1, k1, c1) = if x = x' then let - fun good () = SOME (E.pushCNamedAs env x n2 k2 (SOME c2), denv) + fun good () = + let + val env = E.pushCNamedAs env x n2 k2 (SOME c2) + val env = if n1 = n2 then + env + else + E.pushCNamedAs env x n1 k1 (SOME c1) + in + SOME (env, denv) + end in (case unifyCons (env, denv) c1 c2 of [] => good ()
--- a/tests/crud.ur Thu Sep 11 18:32:41 2008 -0400 +++ b/tests/crud.ur Thu Sep 11 18:36:20 2008 -0400 @@ -7,7 +7,7 @@ val title : string - val cols : $(Top.mapTT (fn t => {Show : t -> xbody}) cols) + val cols : colMeta cols end) = struct open constraints M @@ -22,7 +22,7 @@ {fold [fn cols :: {Type} => $cols -> colMeta cols -> xtr] (fn (nm :: Name) (t :: Type) (rest :: {Type}) acc => [[nm] ~ rest] => - fn (r : $([nm = t] ++ rest)) cols => + fn r cols => <tr> <td>{cols.nm.Show r.nm}</td> {acc (r -- nm) (cols -- nm)}