comparison src/elab_env.sml @ 1575:287604b4a08d

Improved unification of record literals in type class resolution
author Adam Chlipala <adam@chlipala.net>
date Sat, 15 Oct 2011 10:19:50 -0400
parents 96353138f016
children 6c00d8af6239
comparison
equal deleted inserted replaced
1574:644558d9c756 1575:287604b4a08d
543 543
544 | (CName s1, CName s2) => if s1 = s2 then () else raise Unify 544 | (CName s1, CName s2) => if s1 = s2 then () else raise Unify
545 545
546 | (CRecord (k1, xcs1), CRecord (k2, xcs2)) => 546 | (CRecord (k1, xcs1), CRecord (k2, xcs2)) =>
547 (unifyKinds (k1, k2); 547 (unifyKinds (k1, k2);
548 ListPair.appEq (fn ((x1, c1), (x2, c2)) => (eqCons (x1, x2); eqCons (c1, c2))) (xcs1, xcs2) 548 if length xcs1 <> length xcs2 then
549 handle ListPair.UnequalLengths => raise Unify) 549 raise Unify
550 else
551 List.app (fn (x1, c1) =>
552 if List.exists (fn (x2, c2) => (eqCons (x1, x2); eqCons (c1, c2); true) handle Unify => false) xcs2 then
553 ()
554 else
555 raise Unify) xcs1)
550 | (CConcat (f1, x1), CConcat (f2, x2)) => (eqCons (f1, f2); eqCons (x1, x2)) 556 | (CConcat (f1, x1), CConcat (f2, x2)) => (eqCons (f1, f2); eqCons (x1, x2))
551 | (CMap (d1, r1), CMap (d2, r2)) => (unifyKinds (d1, d2); unifyKinds (r1, r2)) 557 | (CMap (d1, r1), CMap (d2, r2)) => (unifyKinds (d1, d2); unifyKinds (r1, r2))
552 558
553 | (CUnit, CUnit) => () 559 | (CUnit, CUnit) => ()
554 560
604 610
605 | (CName s1, CName s2) => if s1 = s2 then () else raise Unify 611 | (CName s1, CName s2) => if s1 = s2 then () else raise Unify
606 612
607 | (CRecord (k1, xcs1), CRecord (k2, xcs2)) => 613 | (CRecord (k1, xcs1), CRecord (k2, xcs2)) =>
608 (unifyKinds (k1, k2); 614 (unifyKinds (k1, k2);
609 ListPair.appEq (fn ((x1, c1), (x2, c2)) => (unify d (x1, x2); unify d (c1, c2))) (xcs1, xcs2) 615 if length xcs1 <> length xcs2 then
610 handle ListPair.UnequalLengths => raise Unify) 616 raise Unify
617 else
618 app (fn (x1, c1) =>
619 if List.exists (fn (x2, c2) => (unify d (x1, x2); unify d (c1, c2); true) handle Unify => false) xcs2 then
620 ()
621 else
622 raise Unify) xcs1)
611 | (CConcat (f1, x1), CConcat (f2, x2)) => (unify d (f1, f2); unify d (x1, x2)) 623 | (CConcat (f1, x1), CConcat (f2, x2)) => (unify d (f1, f2); unify d (x1, x2))
612 | (CMap (d1, r1), CMap (d2, r2)) => (unifyKinds (d1, d2); unifyKinds (r1, r2)) 624 | (CMap (d1, r1), CMap (d2, r2)) => (unifyKinds (d1, d2); unifyKinds (r1, r2))
613 625
614 | (CUnit, CUnit) => () 626 | (CUnit, CUnit) => ()
615 627