Mercurial > urweb
diff src/elaborate.sml @ 348:b88f4297167f
Improved inference of records of tuples
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Sat, 04 Oct 2008 19:56:59 -0400 |
| parents | b85e6ba56618 |
| children | beb72f8a7218 |
line wrap: on
line diff
--- a/src/elaborate.sml Sat Oct 04 16:15:13 2008 -0400 +++ b/src/elaborate.sml Sat Oct 04 19:56:59 2008 -0400 @@ -689,10 +689,15 @@ ([], [], [], []) else (fs1, fs2, others1, others2) + | (_, [], [], [other2]) => + if isGuessable (other2, fs1) then + ([], [], [], []) + else + (fs1, fs2, others1, others2) | _ => (fs1, fs2, others1, others2) (*val () = eprefaces "Summaries5" [("#1", p_summary env {fields = fs1, unifs = unifs1, others = others1}), - ("#2", p_summary env {fields = fs2, unifs = unifs2, others = others2})]*) + ("#2", p_summary env {fields = fs2, unifs = unifs2, others = others2})]*) val clear = case (fs1, others1, fs2, others2) of ([], [], [], []) => true @@ -889,6 +894,25 @@ gs' @ gs end) [] (cs1, cs2)) handle ListPair.UnequalLengths => err CIncompatible) + + | (L'.CProj ((L'.CUnif (_, _, _, ref (SOME c1)), loc), n1), _) => + unifyCons' (env, denv) (L'.CProj (c1, n1), loc) c2All + | (_, L'.CProj ((L'.CUnif (_, _, _, ref (SOME c2)), loc), n2)) => + unifyCons' (env, denv) c1All (L'.CProj (c2, n2), loc) + | (L'.CProj ((L'.CUnif (_, (L'.KTuple ks, _), _, r), loc), n), _) => + let + val us = map (fn k => cunif (loc, k)) ks + in + r := SOME (L'.CTuple us, loc); + unifyCons' (env, denv) (List.nth (us, n - 1)) c2All + end + | (_, L'.CProj ((L'.CUnif (_, (L'.KTuple ks, _), _, r), loc), n)) => + let + val us = map (fn k => cunif (loc, k)) ks + in + r := SOME (L'.CTuple us, loc); + unifyCons' (env, denv) c1All (List.nth (us, n - 1)) + end | (L'.CProj (c1, n1), L'.CProj (c2, n2)) => if n1 = n2 then unifyCons' (env, denv) c1 c2