Remove the arity parameter of type function$.

Author: cristianoc

analysis/src/CompletionBackEnd.ml

@@ -1362,7 +1362,7 @@ let rec completeTypedValue ?(typeArgContext : typeArgContext option) ~rawOpens
       | Tlink t1
       | Tsubst t1
       | Tpoly (t1, [])
-      | Tconstr (Pident {name = "function$"}, [t1; _], _) ->
+      | Tconstr (Pident {name = "function$"}, [t1], _) ->
         fnReturnsTypeT t1
       | Tarrow _ -> (
         match TypeUtils.extractFunctionType ~env ~package:full.package t with

analysis/src/CompletionJsx.ml

@@ -238,7 +238,7 @@ let getJsxLabels ~componentPath ~findTypeOfValue ~package =
       | Tlink t1
       | Tsubst t1
       | Tpoly (t1, [])
-      | Tconstr (Pident {name = "function$"}, [t1; _], _) ->
+      | Tconstr (Pident {name = "function$"}, [t1], _) ->
         getLabels t1
       | Tconstr (p, [propsType], _) when Path.name p = "React.component" -> (
         let rec getPropsType (t : Types.type_expr) =

analysis/src/CreateInterface.ml

@@ -123,7 +123,7 @@ let printSignature ~extractor ~signature =
       Ctype.newconstr (Pdot (Pident (Ident.create "React"), "element", 0)) []
     in
     match typ.desc with
-    | Tconstr (Pident {name = "function$"}, [typ; _], _) -> getComponentType typ
+    | Tconstr (Pident {name = "function$"}, [typ], _) -> getComponentType typ
     | Tarrow
         (_, {desc = Tconstr (Path.Pident propsId, typeArgs, _)}, retType, _, _)
       when Ident.name propsId = "props" ->

analysis/src/SignatureHelp.ml

@@ -118,7 +118,7 @@ let extractParameters ~signature ~typeStrForParser ~labelPrefixLen =
                  ptyp_desc =
                    Ptyp_constr
                      ( {txt = Lident "function$"},
-                       [({ptyp_desc = Ptyp_arrow _} as expr); _] );
+                       [({ptyp_desc = Ptyp_arrow _} as expr)] );
                };
            };
      } );

analysis/src/TypeUtils.ml

@@ -36,7 +36,7 @@ let findTypeViaLoc ~full ~debug (loc : Location.t) =
 
 let rec pathFromTypeExpr (t : Types.type_expr) =
   match t.desc with
-  | Tconstr (Pident {name = "function$"}, [t; _], _) -> pathFromTypeExpr t
+  | Tconstr (Pident {name = "function$"}, [t], _) -> pathFromTypeExpr t
   | Tconstr (path, _typeArgs, _)
   | Tlink {desc = Tconstr (path, _typeArgs, _)}
   | Tsubst {desc = Tconstr (path, _typeArgs, _)}
@@ -243,7 +243,7 @@ let rec extractFunctionType ~env ~package typ =
     match t.desc with
     | Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> loop ~env acc t1
     | Tarrow (label, tArg, tRet, _, _) -> loop ~env ((label, tArg) :: acc) tRet
-    | Tconstr (Pident {name = "function$"}, [t; _], _) ->
+    | Tconstr (Pident {name = "function$"}, [t], _) ->
       extractFunctionType ~env ~package t
     | Tconstr (path, typeArgs, _) -> (
       match References.digConstructor ~env ~package path with
@@ -283,7 +283,7 @@ let rec extractFunctionType2 ?typeArgContext ~env ~package typ =
     | Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> loop ?typeArgContext ~env acc t1
     | Tarrow (label, tArg, tRet, _, _) ->
       loop ?typeArgContext ~env ((label, tArg) :: acc) tRet
-    | Tconstr (Pident {name = "function$"}, [t; _], _) ->
+    | Tconstr (Pident {name = "function$"}, [t], _) ->
       extractFunctionType2 ?typeArgContext ~env ~package t
     | Tconstr (path, typeArgs, _) -> (
       match References.digConstructor ~env ~package path with
@@ -334,7 +334,7 @@ let rec extractType ?(printOpeningDebug = true)
     Some (Tstring env, typeArgContext)
   | Tconstr (Path.Pident {name = "exn"}, [], _) ->
     Some (Texn env, typeArgContext)
-  | Tconstr (Pident {name = "function$"}, [t; _], _) -> (
+  | Tconstr (Pident {name = "function$"}, [t], _) -> (
     match extractFunctionType2 ?typeArgContext t ~env ~package with
     | args, tRet, typeArgContext when args <> [] ->
       Some
@@ -910,7 +910,7 @@ let getArgs ~env (t : Types.type_expr) ~full =
     | Tlink t1
     | Tsubst t1
     | Tpoly (t1, [])
-    | Tconstr (Pident {name = "function$"}, [t1; _], _) ->
+    | Tconstr (Pident {name = "function$"}, [t1], _) ->
       getArgsLoop ~full ~env ~currentArgumentPosition t1
     | Tarrow (Labelled l, tArg, tRet, _, _) ->
       (SharedTypes.Completable.Labelled l, tArg)

compiler/frontend/ast_core_type_class_type.ml

@@ -73,7 +73,7 @@ let typ_mapper (self : Bs_ast_mapper.mapper) (ty : Parsetree.core_type) =
      | Ptyp_constr
          (* function$<...> is re-wrapped around only in case Nothing below *)
          ( {txt = Lident "function$"},
-           [{ptyp_desc = Ptyp_arrow (label, args, body, _)}; _] ) );
+           [{ptyp_desc = Ptyp_arrow (label, args, body, _)}] ) );
    (* let it go without regard label names,
       it will report error later when the label is not empty
    *)

compiler/frontend/ast_external_process.ml

@@ -935,21 +935,16 @@ let handle_attributes (loc : Bs_loc.t) (type_annotation : Parsetree.core_type)
   let prim_name_with_source = {name = prim_name; source = External} in
   let type_annotation, build_uncurried_type =
     match type_annotation.ptyp_desc with
-    | Ptyp_constr (({txt = Lident "function$"; _} as lid), [t; arity_]) ->
+    | Ptyp_constr (({txt = Lident "function$"; _} as lid), [t]) ->
       ( t,
         fun ~arity (x : Parsetree.core_type) ->
-          let t_arity =
-            match arity with
-            | Some arity -> Ast_uncurried.arity_type ~loc arity
-            | None -> arity_
-          in
           let x =
             match x.ptyp_desc with
             | Ptyp_arrow (l, t1, t2, _) ->
               {x with ptyp_desc = Ptyp_arrow (l, t1, t2, arity)}
             | _ -> x
           in
-          {x with Parsetree.ptyp_desc = Ptyp_constr (lid, [x; t_arity])} )
+          {x with Parsetree.ptyp_desc = Ptyp_constr (lid, [x])} )
     | _ -> (type_annotation, fun ~arity:_ x -> x)
   in
   let result_type, arg_types_ty =

compiler/gentype/TranslateTypeExprFromTypes.ml

@@ -231,8 +231,7 @@ let translate_constr ~config ~params_translation ~(path : Path.t) ~type_env =
     {param_translation with type_ = Promise param_translation.type_}
   | (["Js"; "Dict"; "t"] | ["Dict"; "t"] | ["dict"]), [param_translation] ->
     {param_translation with type_ = Dict param_translation.type_}
-  | ["function$"], [arg; _arity] ->
-    {dependencies = arg.dependencies; type_ = arg.type_}
+  | ["function$"], [arg] -> {dependencies = arg.dependencies; type_ = arg.type_}
   | _ -> default_case ()
 
 type process_variant = {

compiler/ml/ast_mapper_from0.ml

@@ -123,7 +123,7 @@ module T = struct
         let fun_t =
           {fun_t with ptyp_desc = Ptyp_arrow (lbl, t1, t2, Some arity)}
         in
-        {typ0 with ptyp_desc = Ptyp_constr (lid, [fun_t; t_arity])}
+        {typ0 with ptyp_desc = Ptyp_constr (lid, [fun_t])}
       | _ -> typ0)
     | Ptyp_object (l, o) ->
       object_ ~loc ~attrs (List.map (object_field sub) l) o

compiler/ml/ast_mapper_to0.ml

@@ -101,6 +101,17 @@ module T = struct
     | Ptyp_arrow (lab, t1, t2, _) ->
       arrow ~loc ~attrs lab (sub.typ sub t1) (sub.typ sub t2)
     | Ptyp_tuple tyl -> tuple ~loc ~attrs (List.map (sub.typ sub) tyl)
+    | Ptyp_constr
+        ( ({txt = Lident "function$"} as lid),
+          [({ptyp_desc = Ptyp_arrow (_, _, _, Some arity)} as t_arg)] ) ->
+      let encode_arity_string arity = "Has_arity" ^ string_of_int arity in
+      let arity_type ~loc arity =
+        Ast_helper0.Typ.variant ~loc
+          [Rtag ({txt = encode_arity_string arity; loc}, [], true, [])]
+          Closed None
+      in
+      constr ~loc ~attrs (map_loc sub lid)
+        [sub.typ sub t_arg; arity_type ~loc:Location.none arity]
     | Ptyp_constr (lid, tl) ->
       constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl)
     | Ptyp_object (l, o) ->