Support for annotations on _

ocaml/parsing/jane_syntax.ml

@@ -503,7 +503,8 @@ module Layouts = struct
   include Ext
 
   type nonrec core_type =
-    | Ltyp_var of { name : string; layout : Asttypes.layout_annotation }
+    | Ltyp_var of { name : string option
+                  ; layout : Asttypes.layout_annotation }
     | Ltyp_alias of { aliased_type : core_type
                     ; name : string option
                     ; layout : Asttypes.layout_annotation }
@@ -587,7 +588,10 @@ module Layouts = struct
       | Ltyp_var { name; layout } ->
         let payload = encode_layout_as_payload layout in
         Ast_of.wrap_jane_syntax ["var"] ~payload @@
-        Ast_helper.Typ.var ~loc ~attrs name
+        begin match name with
+        | None -> Ast_helper.Typ.any ~loc ~attrs ()
+        | Some name -> Ast_helper.Typ.var ~loc ~attrs name
+        end
       | Ltyp_alias { aliased_type; name; layout } ->
         let payload = encode_layout_as_payload layout in
         let has_name, inner_typ = match name with
@@ -611,8 +615,10 @@ module Layouts = struct
     let lty = match names with
       | [ "var" ] ->
          begin match typ.ptyp_desc with
+         | Ptyp_any ->
+           Ltyp_var { name = None; layout }
          | Ptyp_var name ->
-           Ltyp_var { name; layout }
+           Ltyp_var { name = Some name; layout }
          | _ -> Desugaring_error.raise ~loc (Unexpected_wrapped_type typ)
          end
       | [ "alias"; "anon" ] ->

ocaml/parsing/jane_syntax.mli

@@ -131,7 +131,11 @@ end
 (** The ASTs for layouts. *)
 module Layouts : sig
   type nonrec core_type =
-    | Ltyp_var of { name : string; layout : Asttypes.layout_annotation }
+    (* ['a : immediate] or [_ : float64] *)
+    | Ltyp_var of { name : string option
+                  ; layout : Asttypes.layout_annotation }
+
+    (* [ty as ('a : immediate)] *)
     | Ltyp_alias of { aliased_type : Parsetree.core_type
                     ; name : string option
                     ; layout : Asttypes.layout_annotation }

ocaml/parsing/parser.mly

@@ -3956,8 +3956,11 @@ atomic_type:
   )
   { $1 } /* end mktyp group */
   | LPAREN QUOTE name=ident COLON layout=layout_annotation RPAREN
-    { Jane_syntax.Layouts.type_of ~loc:(make_loc $sloc) ~attrs:[] @@
-      Ltyp_var { name; layout } }
+      { Jane_syntax.Layouts.type_of ~loc:(make_loc $sloc) ~attrs:[] @@
+        Ltyp_var { name = Some name; layout } }
+  | LPAREN UNDERSCORE COLON layout=layout_annotation RPAREN
+      { Jane_syntax.Layouts.type_of ~loc:(make_loc $sloc) ~attrs:[] @@
+        Ltyp_var { name = None; layout } }
 
 
 (* This is the syntax of the actual type parameters in an application of

ocaml/parsing/pprintast.ml

@@ -450,7 +450,9 @@ and core_type1_jane_syntax ctxt attrs f (x : Jane_syntax.Core_type.t) =
   if has_non_curry_attr attrs then core_type_jane_syntax ctxt attrs f x
   else
     match x with
-    | Jtyp_layout (Ltyp_var { name; layout }) ->
+    | Jtyp_layout (Ltyp_var { name = None; layout }) ->
+      pp f "(_ :@;%a)" layout_annotation layout
+    | Jtyp_layout (Ltyp_var { name = Some name; layout }) ->
       pp f "(%a@;:@;%a)" tyvar name layout_annotation layout
     | _ -> paren true (core_type_jane_syntax ctxt attrs) f x
 

ocaml/testsuite/tests/typing-layouts/annots.ml

@@ -64,15 +64,33 @@ Error: Bad layout annotation:
 (* Test 2: Annotation on type parameter *)
 
 type ('a : immediate) t2_imm
+type (_ : immediate) t2_imm'
 type t = int t2_imm
 type t = bool t2_imm
 ;;
 [%%expect {|
 type ('a : immediate) t2_imm
+type (_ : immediate) t2_imm'
 type t = int t2_imm
 type t = bool t2_imm
 |}]
 
+module M1 : sig
+  type ('a : immediate) t
+end = struct
+  type (_ : immediate) t
+end
+
+module M2 : sig
+  type (_ : immediate) t
+end = struct
+  type ('a : immediate) t
+end
+
+[%%expect {|
+success
+|}]
+
 type t = string t2_imm
 ;;
 [%%expect {|
@@ -135,6 +153,27 @@ type ('a : immediate) t = 'a t2_imm
 type ('a : immediate) t = 'a t2_imm
 |}]
 
+let f : (_ : value) t2_imm -> unit = fun _ -> ()
+let g : (_ : immediate) t2_imm -> unit = fun _ -> ()
+
+[%%expect {|
+success
+|}]
+
+let f : (_ : immediate) -> unit = fun _ -> ()
+let g : (_ : value) -> unit = fun _ -> ()
+
+[%%expect {|
+success
+|}]
+
+let f : (_ : immediate) -> (_ : value) = fun _ -> assert false
+let g : (_ : value) -> (_ : immediate) = fun _ -> assert false
+
+[%%expect {|
+success
+|}]
+
 (********************************************)
 (* Test 3: Annotation on types in functions *)
 

ocaml/typing/layouts.ml

@@ -262,6 +262,7 @@ module Layout = struct
     | Constructor_type_parameter of Path.t * string
     | Univar of string
     | Type_variable of string
+    | Type_wildcard of Location.t
     | Type
 
   type creation_reason =
@@ -584,6 +585,8 @@ module Layout = struct
             name
       | Type_variable name ->
           fprintf ppf "the type variable %s" name
+      | Type_wildcard loc ->
+          fprintf ppf "the wildcard _ at %a" Location.print_loc loc
       | Type ->
           fprintf ppf "a type"
 
@@ -1018,6 +1021,8 @@ module Layout = struct
           fprintf ppf "Univar %S" name
       | Type_variable name ->
           fprintf ppf "Type_variable %S" name
+      | Type_wildcard loc ->
+          fprintf ppf "Type_wildcard (%a)" Location.print_loc loc
       | Type ->
           fprintf ppf "Type"
 

ocaml/typing/layouts.mli

@@ -105,6 +105,7 @@ module Layout : sig
     | Constructor_type_parameter of Path.t * string
     | Univar of string
     | Type_variable of string
+    | Type_wildcard of Location.t
     | Type (* CR layouts: this should really carry a type_expr *)
 
    type value_creation_reason =

ocaml/typing/printtyped.ml

@@ -216,9 +216,8 @@ let rec core_type i ppf x =
   attributes i ppf x.ctyp_attributes;
   let i = i+1 in
   match x.ctyp_desc with
-  | Ttyp_any -> line i ppf "Ttyp_any\n";
   | Ttyp_var (s, layout) ->
-      line i ppf "Ttyp_var %s\n" s;
+      line i ppf "Ttyp_var %s\n" (Option.value ~default:"_" s);
       option i layout_annotation ppf layout
   | Ttyp_arrow (l, ct1, ct2) ->
       line i ppf "Ttyp_arrow\n";

ocaml/typing/tast_iterator.ml

@@ -458,7 +458,6 @@ let class_type_field sub {ctf_desc; _} =
 let typ sub {ctyp_desc; ctyp_env; _} =
   sub.env sub ctyp_env;
   match ctyp_desc with
-  | Ttyp_any   -> ()
   | Ttyp_var (_, layout) ->
       Option.iter (sub.layout_annotation sub) layout
   | Ttyp_arrow (_, ct1, ct2) ->

ocaml/typing/tast_mapper.ml

@@ -692,7 +692,6 @@ let typ sub x =
   let ctyp_env = sub.env sub x.ctyp_env in
   let ctyp_desc =
     match x.ctyp_desc with
-    | Ttyp_any
     | Ttyp_var (_,None) as d -> d
     | Ttyp_var (s, Some layout) ->
         Ttyp_var (s, Some (sub.layout_annotation sub layout))

ocaml/typing/typeclass.ml

@@ -325,7 +325,9 @@ let rec class_type_field env sign self_scope ctf =
                  Ctype.newvar (Layout.value ~why:Object_field)
                in
                add_method loc env lab priv virt expected_ty sign;
-               let returned_cty = ctyp Ttyp_any (Ctype.newty Tnil) env loc in
+               let returned_cty =
+                 ctyp (Ttyp_var (None, None)) (Ctype.newty Tnil) env loc
+               in
                delayed_meth_specs :=
                  Warnings.mk_lazy (fun () ->
                    let cty = transl_simple_type_univars env sty' in

ocaml/typing/typedtree.ml

@@ -522,8 +522,7 @@ and core_type =
    }
 
 and core_type_desc =
-    Ttyp_any
-  | Ttyp_var of string * const_layout option
+  | Ttyp_var of string option * const_layout option
   | Ttyp_arrow of arg_label * core_type * core_type
   | Ttyp_tuple of core_type list
   | Ttyp_constr of Path.t * Longident.t loc * core_type list

ocaml/typing/typedtree.mli

@@ -719,8 +719,7 @@ and core_type =
    }
 
 and core_type_desc =
-    Ttyp_any
-  | Ttyp_var of string * const_layout option
+  | Ttyp_var of string option * const_layout option
   | Ttyp_arrow of arg_label * core_type * core_type
   | Ttyp_tuple of core_type list
   | Ttyp_constr of Path.t * Longident.t loc * core_type list

ocaml/typing/typemod.ml

@@ -505,8 +505,8 @@ let () = Env.check_well_formed_module := check_well_formed_module
 let type_decl_is_alias sdecl = (* assuming no explicit constraint *)
   let eq_vars x y =
     match Jane_syntax.Core_type.of_ast x, Jane_syntax.Core_type.of_ast y with
-    | Some (Jtyp_layout (Ltyp_var { name = nx; layout = lx }), _attrsx),
-      Some (Jtyp_layout (Ltyp_var { name = ny; layout = ly }), _attrsy) ->
+    | Some (Jtyp_layout (Ltyp_var { name = Some nx; layout = lx }), _attrsx),
+      Some (Jtyp_layout (Ltyp_var { name = Some ny; layout = ly }), _attrsy) ->
       String.equal nx ny &&
       Location.compare_txt Layout.equal_const lx ly
     | (Some _, _) | (_, Some _) -> false

ocaml/typing/typetexp.ml

@@ -435,7 +435,7 @@ let transl_type_param env styp layout =
   match styp.ptyp_desc with
     Ptyp_any ->
       let ty = new_global_var ~name:"_" layout in
-        { ctyp_desc = Ttyp_any; ctyp_type = ty; ctyp_env = env;
+        { ctyp_desc = Ttyp_var (None, None); ctyp_type = ty; ctyp_env = env;
           ctyp_loc = loc; ctyp_attributes = styp.ptyp_attributes; }
   | Ptyp_var name ->
       let ty =
@@ -447,7 +447,8 @@ let transl_type_param env styp layout =
           TyVarEnv.add name v;
           v
       in
-        { ctyp_desc = Ttyp_var (name, None); ctyp_type = ty; ctyp_env = env;
+        { ctyp_desc = Ttyp_var (Some name, None);
+          ctyp_type = ty; ctyp_env = env;
           ctyp_loc = loc; ctyp_attributes = styp.ptyp_attributes; }
   | _ -> assert false
 
@@ -505,12 +506,11 @@ and transl_type_aux env policy mode styp =
   match styp.ptyp_desc with
     Ptyp_any ->
       let ty =
-        TyVarEnv.new_anon_var styp.ptyp_loc env
-          (Layout.any ~why:Wildcard) policy
+        TyVarEnv.new_anon_var loc env (Layout.any ~why:Wildcard) policy
       in
-      ctyp Ttyp_any ty
+      ctyp (Ttyp_var (None, None)) ty
   | Ptyp_var name ->
-      let desc, typ = transl_type_var env policy mode styp.ptyp_loc name None in
+      let desc, typ = transl_type_var env policy styp.ptyp_loc name None in
       ctyp desc typ
   | Ptyp_arrow _ ->
       let args, ret, ret_mode = extract_params styp in
@@ -863,12 +863,16 @@ and transl_type_aux_jst env policy mode _attrs loc :
 
 and transl_type_aux_jst_layout env policy mode loc :
       Jane_syntax.Layouts.core_type -> _ = function
-  | Ltyp_var { name; layout } ->
-    transl_type_var env policy mode loc name (Some layout)
+  | Ltyp_var { name = None; layout } ->
+    let tlayout = Layout.of_annotation ~context:(Type_wildcard loc) layout in
+    Ttyp_var (None, Some layout.txt),
+    TyVarEnv.new_anon_var loc env tlayout policy
+  | Ltyp_var { name = Some name; layout } ->
+    transl_type_var env policy loc name (Some layout)
   | Ltyp_alias { aliased_type; name; layout } ->
     transl_type_alias env policy mode loc aliased_type name (Some layout)
 
-and transl_type_var env policy _mode loc name layout_annot_opt =
+and transl_type_var env policy loc name layout_annot_opt =
   let print_name = "'" ^ name in
   if not (valid_tyvar_name name) then
     raise (Error (loc, env, Invalid_variable_name print_name));
@@ -894,7 +898,7 @@ and transl_type_var env policy _mode loc name layout_annot_opt =
       TyVarEnv.remember_used name ty loc;
       ty
   in
-  Ttyp_var (name, Option.map Location.get_txt layout_annot_opt), ty
+  Ttyp_var (Some name, Option.map Location.get_txt layout_annot_opt), ty
 
 and transl_type_alias env policy mode alias_loc styp name_opt layout_annot_opt =
   let cty = match name_opt with

ocaml/typing/untypeast.ml

@@ -908,8 +908,8 @@ let core_type sub ct =
     ptyp_desc
   in
   let desc = match ct.ctyp_desc with
-      Ttyp_any -> Ptyp_any
-    | Ttyp_var (s, None) -> Ptyp_var s
+    | Ttyp_var (None, None) -> Ptyp_any
+    | Ttyp_var (Some s, None) -> Ptyp_var s
     | Ttyp_var (name, Some layout) ->
         Jane_syntax.Layouts.type_of ~loc ~attrs:[]
           (Ltyp_var { name; layout = mkloc layout loc }) |>