diff options
| -rw-r--r-- | typing/btype.ml | 12 | ||||
| -rw-r--r-- | typing/printtyp.ml | 9 |
2 files changed, 13 insertions, 8 deletions
diff --git a/typing/btype.ml b/typing/btype.ml index 027fb819f..2e95c4d95 100644 --- a/typing/btype.ml +++ b/typing/btype.ml @@ -126,17 +126,19 @@ let hash_variant s = if !accu > 0x3FFFFFFF then !accu - (1 lsl 31) else !accu let proxy ty = - let ty = repr ty in - match ty.desc with - | Tvariant row -> row_more row + let ty0 = repr ty in + match ty0.desc with + | Tvariant row when not (static_row row) -> + row_more row | Tobject (ty, _) -> let rec proxy_obj ty = match ty.desc with Tfield (_, _, _, ty) | Tlink ty -> proxy_obj ty - | Tvar | Tnil | Tunivar -> ty + | Tvar | Tunivar | Tconstr _ -> ty + | Tnil -> ty0 | _ -> assert false in proxy_obj ty - | _ -> ty + | _ -> ty0 (**********************************) diff --git a/typing/printtyp.ml b/typing/printtyp.ml index 0acb411db..e6f800252 100644 --- a/typing/printtyp.ml +++ b/typing/printtyp.ml @@ -207,7 +207,7 @@ let aliased = ref ([] : type_expr list) let delayed = ref ([] : type_expr list) let add_delayed t = - if not (List.mem_assq t !names) then delayed := t :: !delayed + if not (List.memq t !delayed) then delayed := t :: !delayed let is_aliased ty = List.memq (proxy ty) !aliased let add_alias ty = @@ -227,7 +227,8 @@ let namable_row row = let rec mark_loops_rec visited ty = let ty = repr ty in let px = proxy ty in - if List.memq px visited then add_alias px else + (* if List.memq px !aliased then () else : need also consider delayed *) + if List.memq px visited then aliased := px :: !aliased else let visited = px :: visited in match ty.desc with | Tvar -> () @@ -375,9 +376,11 @@ let rec tree_of_typexp sch ty = let tyl = List.map repr tyl in (* let tyl = List.filter is_aliased tyl in *) if tyl = [] then tree_of_typexp sch ty else begin + let old_delayed = !delayed in List.iter add_delayed tyl; let tl = List.map name_of_type tyl in - Otyp_poly (tl, tree_of_typexp sch ty) + let tr = Otyp_poly (tl, tree_of_typexp sch ty) in + delayed := old_delayed; tr end | Tunivar -> Otyp_var (false, name_of_type ty) |