Mercurial > urweb
diff src/elaborate.sml @ 2211:ef766ef6e242
Merge.
author | Ziv Scully <ziv@mit.edu> |
---|---|
date | Sat, 13 Sep 2014 19:16:07 -0400 |
parents | 459ccbf8cd08 |
children | 834b438d57f3 |
line wrap: on
line diff
--- a/src/elaborate.sml Sat May 31 22:23:25 2014 -0400 +++ b/src/elaborate.sml Sat Sep 13 19:16:07 2014 -0400 @@ -1,4 +1,4 @@ -(* Copyright (c) 2008-2013, Adam Chlipala +(* Copyright (c) 2008-2014, Adam Chlipala * All rights reserved. * * Redistribution and use in source and binary forms, with or without @@ -1191,6 +1191,12 @@ (L'.CProj (c1, n1), _) => projSpecial1 (c1, n1, isRecord') | (_, L'.CProj (c2, n2)) => projSpecial2 (c2, n2, isRecord') | _ => isRecord' () + + fun maybeIsRecord c = + case c of + L'.CRecord _ => isRecord () + | L'.CConcat _ => isRecord () + | _ => err COccursCheckFailed in (*eprefaces "unifyCons''" [("c1", p_con env c1All), ("c2", p_con env c2All)];*) @@ -1220,26 +1226,29 @@ else err (fn _ => TooLifty (loc1, loc2)) - | (L'.CUnif (0, _, _, _, r as ref (L'.Unknown f)), _) => + | (L'.CUnif (0, _, k1, _, r as ref (L'.Unknown f)), _) => + (unifyKinds env k1 (kindof env c2All); + if occursCon r c2All then + maybeIsRecord c2 + else if f c2All then + r := L'.Known c2All + else + err CScope) + | (_, L'.CUnif (0, _, k2, _, r as ref (L'.Unknown f))) => + (unifyKinds env (kindof env c1All) k2; + if occursCon r c1All then + maybeIsRecord c1 + else if f c1All then + r := L'.Known c1All + else + err CScope) + + | (L'.CUnif (nl, _, k1, _, r as ref (L'.Unknown f)), _) => if occursCon r c2All then - err COccursCheckFailed - else if f c2All then - r := L'.Known c2All + maybeIsRecord c2 else - err CScope - | (_, L'.CUnif (0, _, _, _, r as ref (L'.Unknown f))) => - if occursCon r c1All then - err COccursCheckFailed - else if f c1All then - r := L'.Known c1All - else - err CScope - - | (L'.CUnif (nl, _, _, _, r as ref (L'.Unknown f)), _) => - if occursCon r c2All then - err COccursCheckFailed - else - (let + (unifyKinds env k1 (kindof env c2All); + let val sq = squish nl c2All in if f sq then @@ -1248,11 +1257,12 @@ err CScope end handle CantSquish => err (fn _ => TooDeep)) - | (_, L'.CUnif (nl, _, _, _, r as ref (L'.Unknown f))) => + | (_, L'.CUnif (nl, _, k2, _, r as ref (L'.Unknown f))) => if occursCon r c1All then - err COccursCheckFailed + maybeIsRecord c1 else - (let + (unifyKinds env (kindof env c1All) k2; + let val sq = squish nl c1All in if f sq then