clean-up moregeneral_row

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@4982 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

1 files changed, 22 insertions, 12 deletions

diff --git a/typing/ctype.ml b/typing/ctype.ml
index e338eb9bb..0f268c12f 100644
--- a/typing/ctype.ml
+++ b/typing/ctype.ml
@@ -1932,16 +1932,24 @@ and moregen_row inst_nongen type_pairs env row1 row2 =
   if r1 <> [] || row1.row_closed && (not row2.row_closed || r2 <> []) 
   then raise (Unify []);
   let rm1 = repr row1.row_more and rm2 = repr row2.row_more in
-  let ext =
-    if not (static_row row2) then 
-      if rm1.desc <> Tunivar then moregen_occur env rm1.level rm2 else
-      if rm2.desc <> Tunivar then raise (Unify []);
-    if r2 = [] then rm2 else
-    let ty = newty2 generic_level (Tvariant{row2 with row_fields = r2}) in
-    moregen_occur env rm1.level ty;
-    ty
+  let univ =
+    match rm1.desc, rm2.desc with
+      Tunivar, Tunivar ->
+        unify_univar rm1 rm2 !univar_pairs;
+        true
+    | Tunivar, _ | _, Tunivar ->
+        raise (Unify [])
+    | _ ->
+        if not (static_row row2) then moregen_occur env rm1.level rm2;
+        let ext =
+          if r2 = [] then rm2 else
+          let row_ext = {row2 with row_fields = r2} in
+          iter_row (moregen_occur env rm1.level) row_ext;
+          newty2 rm1.level (Tvariant row_ext)
+        in
+        if ext != rm1 then rm1.desc <- Tlink ext;
+        false
   in
-  if ext != rm1 then rm1.desc <- Tlink ext;
   List.iter
     (fun (l,f1,f2) ->
       let f1 = row_field_repr f1 and f2 = row_field_repr f2 in
@@ -1950,7 +1958,7 @@ and moregen_row inst_nongen type_pairs env row1 row2 =
         Rpresent(Some t1), Rpresent(Some t2) ->
           moregen inst_nongen type_pairs env t1 t2
       | Rpresent None, Rpresent None -> ()
-      | Reither(false, tl1, _, e1), Rpresent(Some t2) ->
+      | Reither(false, tl1, _, e1), Rpresent(Some t2) when not univ ->
           e1 := Some f2;
           List.iter (fun t1 -> moregen inst_nongen type_pairs env t1 t2) tl1
       | Reither(c1, tl1, _, e1), Reither(c2, tl2, m2, e2) ->
@@ -1965,8 +1973,10 @@ and moregen_row inst_nongen type_pairs env row1 row2 =
           | [] ->
               if tl1 <> [] then raise (Unify [])
           end
-      | Reither(true, [], _, e1), Rpresent None -> e1 := Some f2
-      | Reither(_, _, _, e1), Rabsent -> e1 := Some f2
+      | Reither(true, [], _, e1), Rpresent None when not univ ->
+          e1 := Some f2
+      | Reither(_, _, _, e1), Rabsent when not univ ->
+          e1 := Some f2
       | Rabsent, Rabsent -> ()
       | _ -> raise (Unify []))
     pairs