Mercurial > urweb
changeset 348:b88f4297167f
Improved inference of records of tuples
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Sat, 04 Oct 2008 19:56:59 -0400 |
| parents | 58eeeb3cbf40 |
| children | beb72f8a7218 |
| files | src/elaborate.sml tests/crud1.ur |
| diffstat | 2 files changed, 25 insertions(+), 8 deletions(-) [+] |
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
--- a/tests/crud1.ur Sat Oct 04 16:15:13 2008 -0400 +++ b/tests/crud1.ur Sat Oct 04 19:56:59 2008 -0400 @@ -1,13 +1,6 @@ table t1 : {Id : int, A : int, B : string, C : float, D : bool} open Crud.Make(struct - con cols :: {(Type * Type)} = [ - A = (int, string), - B = (string, string), - C = (float, string), - D = (bool, bool) - ] - val tab = t1 val title = "Crud1"