Mercurial > urweb
comparison src/elaborate.sml @ 646:fb2a0e76dcef
ListEdit demo, minus prose
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Tue, 10 Mar 2009 12:44:40 -0400 |
parents | 6302b10dbe0e |
children | ae374df5ccbd |
comparison
equal
deleted
inserted
replaced
645:1b571a05874c | 646:fb2a0e76dcef |
---|---|
702 andalso consEq env (c1, c2) | 702 andalso consEq env (c1, c2) |
703 andalso consEq env (x1, x2)) | 703 andalso consEq env (x1, x2)) |
704 (#fields s1, #fields s2) | 704 (#fields s1, #fields s2) |
705 (*val () = eprefaces "Summaries2" [("#1", p_summary env {fields = fs1, unifs = #unifs s1, others = #others s1}), | 705 (*val () = eprefaces "Summaries2" [("#1", p_summary env {fields = fs1, unifs = #unifs s1, others = #others s1}), |
706 ("#2", p_summary env {fields = fs2, unifs = #unifs s2, others = #others s2})]*) | 706 ("#2", p_summary env {fields = fs2, unifs = #unifs s2, others = #others s2})]*) |
707 | |
707 val (unifs1, unifs2) = eatMatching (fn ((_, r1), (_, r2)) => r1 = r2) (#unifs s1, #unifs s2) | 708 val (unifs1, unifs2) = eatMatching (fn ((_, r1), (_, r2)) => r1 = r2) (#unifs s1, #unifs s2) |
709 fun eatMost unifs = | |
710 case unifs of | |
711 (_, r) :: (rest as _ :: _) => (r := SOME (L'.CRecord (k, []), loc); | |
712 eatMost rest) | |
713 | _ => unifs | |
714 val unifs1 = eatMost unifs1 | |
715 val unifs2 = eatMost unifs2 | |
716 | |
708 val (others1, others2) = eatMatching (consEq env) (#others s1, #others s2) | 717 val (others1, others2) = eatMatching (consEq env) (#others s1, #others s2) |
709 (*val () = eprefaces "Summaries3" [("#1", p_summary env {fields = fs1, unifs = unifs1, others = others1}), | 718 (*val () = eprefaces "Summaries3" [("#1", p_summary env {fields = fs1, unifs = unifs1, others = others1}), |
710 ("#2", p_summary env {fields = fs2, unifs = unifs2, others = others2})]*) | 719 ("#2", p_summary env {fields = fs2, unifs = unifs2, others = others2})]*) |
711 | 720 |
712 fun unifFields (fs, others, unifs) = | 721 fun unifFields (fs, others, unifs) = |
759 else | 768 else |
760 (fs1, fs2, others1, others2) | 769 (fs1, fs2, others1, others2) |
761 | _ => (fs1, fs2, others1, others2) | 770 | _ => (fs1, fs2, others1, others2) |
762 | 771 |
763 (*val () = eprefaces "Summaries5" [("#1", p_summary env {fields = fs1, unifs = unifs1, others = others1}), | 772 (*val () = eprefaces "Summaries5" [("#1", p_summary env {fields = fs1, unifs = unifs1, others = others1}), |
764 ("#2", p_summary env {fields = fs2, unifs = unifs2, others = others2})]*) | 773 ("#2", p_summary env {fields = fs2, unifs = unifs2, others = others2})]*) |
765 | 774 |
766 val clear = case (fs1, others1, fs2, others2) of | 775 val clear = case (fs1, others1, fs2, others2) of |
767 ([], [], [], []) => true | 776 ([], [], [], []) => true |
768 | _ => false | 777 | _ => false |
769 val empty = (L'.CRecord (k, []), dummy) | 778 val empty = (L'.CRecord (k, []), dummy) |