Fix bug and print locally-abstract type layouts more eagerly

Signed-off-by: Nick Roberts <[email protected]>

src/analysis/type_utils.ml

@@ -215,15 +215,13 @@ let print_type_with_decl ~verbosity env ppf typ =
         Env.with_cmis @@ fun () ->
         Env.find_type path env
       in
-      (* Print expression in addition to the type declaration
-         only if it is parameterized. *)
-      let print_expr = params <> [] in
+      let is_abstract = Btype.type_kind_is_abstract decl in
+      (* Print expression only if it is parameterized or abstract *)
+      let print_expr = is_abstract || params <> [] in
       if print_expr then
         Printtyp.type_scheme env ppf typ;
-      (* Jane Street only: print the declaration even if it's
-         abstract, because this gives us a place to print
-         the inferred layout annotation.
-      *)
+      (* If not abstract, also print the declaration *)
+      if not is_abstract then
         begin
           (* Separator if expression was printed *)
           if print_expr then

src/ocaml/typing/ctype.ml

@@ -1341,7 +1341,7 @@ let get_new_abstract_name env s =
   let index = Misc.find_first_mono check in
   name index
 
-let new_local_type ?(loc = Location.none) ?manifest_and_scope jkind =
+let new_local_type ?(loc = Location.none) ?manifest_and_scope jkind ~jkind_annot =
   let manifest, expansion_scope =
     match manifest_and_scope with
       None -> None, Btype.lowest_level
@@ -1352,7 +1352,7 @@ let new_local_type ?(loc = Location.none) ?manifest_and_scope jkind =
     type_arity = 0;
     type_kind = Type_abstract Abstract_def;
     type_jkind = jkind;
-    type_jkind_annotation = None;
+    type_jkind_annotation = jkind_annot;
     type_private = Public;
     type_manifest = manifest;
     type_variance = [];
@@ -1389,7 +1389,7 @@ let instance_constructor existential_treatment cstr =
               | Tvariant _ -> Jkind.value ~why:Row_variable (* Existential row variable *)
               | _ -> assert false
             in
-            let decl = new_local_type jkind in
+            let decl = new_local_type jkind ~jkind_annot:None in
             let name = existential_name cstr existential in
             let (id, new_env) =
               Env.enter_type (get_new_abstract_name !env name) decl !env
@@ -2629,7 +2629,7 @@ let reify env t =
   let fresh_constr_scope = get_gadt_equations_level () in
   let create_fresh_constr lev name jkind =
     let name = match name with Some s -> "$'"^s | _ -> "$" in
-    let decl = new_local_type jkind in
+    let decl = new_local_type jkind ~jkind_annot:None in
     let (id, new_env) =
       Env.enter_type (get_new_abstract_name !env name) decl !env
         ~scope:fresh_constr_scope in
@@ -2981,7 +2981,8 @@ let jkind_of_abstract_type_declaration env p =
        which guards the case of unify3 that reaches this function.  Would be
        nice to eliminate the duplication, but is seems tricky to do so without
        complicating unify3. *)
-    (Env.find_type p env).type_jkind
+    let typ = Env.find_type p env in
+    typ.type_jkind, typ.type_jkind_annotation
   with
     Not_found -> assert false
 
@@ -3021,10 +3022,13 @@ let add_gadt_equation env source destination =
     (* Recording the actual jkind here is required, not just for efficiency.
        When we check the jkind later, we may not be able to see the local
        equation because of its scope. *)
-    let jkind = jkind_of_abstract_type_declaration !env source in
+    let jkind, jkind_annot =
+      jkind_of_abstract_type_declaration !env source
+    in
     add_jkind_equation ~reason:(Gadt_equation source) env destination jkind;
     let decl =
       new_local_type ~manifest_and_scope:(destination, expansion_scope) jkind
+        ~jkind_annot
     in
     env := Env.add_local_type source decl !env;
     cleanup_abbrev ()

src/ocaml/typing/ctype.mli

@@ -181,7 +181,7 @@ val instance_list: type_expr list -> type_expr list
         (* Take an instance of a list of type schemes *)
 val new_local_type:
         ?loc:Location.t -> ?manifest_and_scope:(type_expr * int) ->
-        Jkind.t -> type_declaration
+        Jkind.t -> jkind_annot:Jkind.annotation option -> type_declaration
 val existential_name: constructor_description -> type_expr -> string
 
 type existential_treatment =

src/ocaml/typing/typecore.ml

@@ -1444,6 +1444,7 @@ let solve_constructor_annotation tps env name_list sty ty_args ty_ex =
             annotations on explicitly quantified vars in gadt constructors.
             See: https://github.com/ocaml/ocaml/pull/9584/ *)
         let decl = new_local_type ~loc:name.loc
+                     ~jkind_annot:None
                      (Jkind.value ~why:Existential_type_variable) in
         let (id, new_env) =
           Env.enter_type ~scope:expansion_scope name.txt decl !env in
@@ -7771,7 +7772,7 @@ and type_newtype ~loc ~env ~expected_mode ~rue ~attributes
   (* Use [with_local_level] just for scoping *)
   let body, ety, id = with_local_level begin fun () ->
     (* Create a fake abstract type declaration for name. *)
-    let decl = new_local_type ~loc jkind in
+    let decl = new_local_type ~loc jkind ~jkind_annot in
     let scope = create_scope () in
     let (id, new_env) = Env.enter_type ~scope name decl env in
 

tests/test-dirs/type-enclosing/jane-street.t/run.t

@@ -113,12 +113,12 @@ to print everything on one line.
   let f0 (x : t0) = x
           ^
   With verbosity 0: "t0"
-  With verbosity 1: "type t0 = int"
+  With verbosity 1: "int"
 
   let f1 (x : t1) = x
           ^
   With verbosity 0: "t1"
-  With verbosity 1: "type t1 = int"
+  With verbosity 1: "int"
 
   let f2 (x : t2) = x
           ^
@@ -209,17 +209,17 @@ to print everything on one line.
   let poly1 (type a)           (x : a) = x
                                ^
   With verbosity 0: "a"
-  With verbosity 1: "type a"
+  With verbosity 1: "a"
 
   let poly2 (type a : value)   (x : a) = x
                                ^
   With verbosity 0: "a"
-  With verbosity 1: "type a"
+  With verbosity 1: "a"
 
   let poly3 (type a : float64) (x : a) = x
                                ^
   With verbosity 0: "a"
-  With verbosity 1: "type a"
+  With verbosity 1: "a"
 
   let poly4 (type (a : immediate) (b : value)) (f : a -> b -> _) = f
                                                ^
@@ -237,12 +237,12 @@ to print everything on one line.
 
   let poly2 (type a : value)   (x : a) = x
                                     ^
-  With verbosity 0: "type a"
-  With verbosity 1: "type a"
+  With verbosity 0: "type a : value"
+  With verbosity 1: "type a : value"
 
   let poly3 (type a : float64) (x : a) = x
                                     ^
-  With verbosity 0: "type a"
+  With verbosity 0: "type a : float64"
   With verbosity 1: "type a : float64"
 
 

tests/test-dirs/type-enclosing/variants.t/run.t

@@ -85,7 +85,7 @@
         "line": 4,
         "col": 5
       },
-      "type": "type more = [ `A | `B | `C ]",
+      "type": "[ `A | `B | `C ]",
       "tail": "no"
     }
   ]
@@ -195,7 +195,7 @@ FIXME: Not satisfying, expected core not more
         "line": 9,
         "col": 7
       },
-      "type": "type more = [ `A | `B | `C ]",
+      "type": "[ `A | `B | `C ]",
       "tail": "no"
     },
     {