remove explicit uses of function$ in preparation for removing the type entirely

Author: cristianoc

CHANGELOG.md

@@ -31,6 +31,7 @@
 - Build with OCaml 5.2.1. https://github.com/rescript-lang/rescript-compiler/pull/7201
 - AST cleanup: Remove `Function$` entirely for function definitions. https://github.com/rescript-lang/rescript/pull/7200
 - AST cleanup: store arity in function type https://github.com/rescript-lang/rescript/pull/7195
+- AST cleanup: remove explicit uses of `function$` in preparation for removing the type entirely. https://github.com/rescript-lang/rescript/pull/7206
 
 # 12.0.0-alpha.5
 

analysis/src/CompletionBackEnd.ml

@@ -1358,12 +1358,8 @@ let rec completeTypedValue ?(typeArgContext : typeArgContext option) ~rawOpens
     in
     (* Find all functions in the module that returns type t *)
     let rec fnReturnsTypeT t =
-      match t.Types.desc with
-      | Tlink t1
-      | Tsubst t1
-      | Tpoly (t1, [])
-      | Tconstr (Pident {name = "function$"}, [t1], _) ->
-        fnReturnsTypeT t1
+      match (Ast_uncurried.remove_function_dollar t).desc with
+      | Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> fnReturnsTypeT t1
       | Tarrow _ -> (
         match TypeUtils.extractFunctionType ~env ~package:full.package t with
         | ( (Nolabel, {desc = Tconstr (Path.Pident {name = "t"}, _, _)}) :: _,

analysis/src/CompletionJsx.ml

@@ -234,12 +234,8 @@ let getJsxLabels ~componentPath ~findTypeOfValue ~package =
       | _ -> []
     in
     let rec getLabels (t : Types.type_expr) =
-      match t.desc with
-      | Tlink t1
-      | Tsubst t1
-      | Tpoly (t1, [])
-      | Tconstr (Pident {name = "function$"}, [t1], _) ->
-        getLabels t1
+      match (Ast_uncurried.remove_function_dollar t).desc with
+      | Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> getLabels t1
       | Tconstr (p, [propsType], _) when Path.name p = "React.component" -> (
         let rec getPropsType (t : Types.type_expr) =
           match t.desc with

analysis/src/CreateInterface.ml

@@ -118,12 +118,11 @@ let printSignature ~extractor ~signature =
 
   let buf = Buffer.create 10 in
 
-  let rec getComponentType (typ : Types.type_expr) =
+  let getComponentType (typ : Types.type_expr) =
     let reactElement =
       Ctype.newconstr (Pdot (Pident (Ident.create "React"), "element", 0)) []
     in
-    match typ.desc with
-    | Tconstr (Pident {name = "function$"}, [typ], _) -> getComponentType typ
+    match (Ast_uncurried.remove_function_dollar typ).desc with
     | Tarrow
         (_, {desc = Tconstr (Path.Pident propsId, typeArgs, _)}, retType, _, _)
       when Ident.name propsId = "props" ->

analysis/src/SignatureHelp.ml

@@ -104,25 +104,13 @@ let findFunctionType ~currentFile ~debug ~path ~pos =
 (* Extracts all parameters from a parsed function signature *)
 let extractParameters ~signature ~typeStrForParser ~labelPrefixLen =
   match signature with
-  | [
-   ( {
-       Parsetree.psig_desc =
-         Psig_value {pval_type = {ptyp_desc = Ptyp_arrow _} as expr};
-     }
-   | {
-       psig_desc =
-         Psig_value
-           {
-             pval_type =
-               {
-                 ptyp_desc =
-                   Ptyp_constr
-                     ( {txt = Lident "function$"},
-                       [({ptyp_desc = Ptyp_arrow _} as expr)] );
-               };
-           };
-     } );
-  ] ->
+  | [{Parsetree.psig_desc = Psig_value {pval_type = expr}}]
+    when match
+           (Ast_uncurried.core_type_remove_function_dollar expr).ptyp_desc
+         with
+         | Ptyp_arrow _ -> true
+         | _ -> false ->
+    let expr = Ast_uncurried.core_type_remove_function_dollar expr in
     let rec extractParams expr params =
       match expr with
       | {

analysis/src/TypeUtils.ml

@@ -34,9 +34,8 @@ let findTypeViaLoc ~full ~debug (loc : Location.t) =
   | Some {locType = Typed (_, typExpr, _)} -> Some typExpr
   | _ -> None
 
-let rec pathFromTypeExpr (t : Types.type_expr) =
-  match t.desc with
-  | Tconstr (Pident {name = "function$"}, [t], _) -> pathFromTypeExpr t
+let pathFromTypeExpr (t : Types.type_expr) =
+  match (Ast_uncurried.remove_function_dollar t).desc with
   | Tconstr (path, _typeArgs, _)
   | Tlink {desc = Tconstr (path, _typeArgs, _)}
   | Tsubst {desc = Tconstr (path, _typeArgs, _)}
@@ -238,13 +237,11 @@ let rec extractObjectType ~env ~package (t : Types.type_expr) =
     | _ -> None)
   | _ -> None
 
-let rec extractFunctionType ~env ~package typ =
+let extractFunctionType ~env ~package typ =
   let rec loop ~env acc (t : Types.type_expr) =
-    match t.desc with
+    match (Ast_uncurried.remove_function_dollar 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], _) ->
-      extractFunctionType ~env ~package t
     | Tconstr (path, typeArgs, _) -> (
       match References.digConstructor ~env ~package path with
       | Some
@@ -277,14 +274,12 @@ let maybeSetTypeArgCtx ?typeArgContextFromTypeManifest ~typeParams ~typeArgs env
     typeArgContext
 
 (* TODO(env-stuff) Maybe this could be removed entirely if we can guarantee that we don't have to look up functions from in here. *)
-let rec extractFunctionType2 ?typeArgContext ~env ~package typ =
+let extractFunctionType2 ?typeArgContext ~env ~package typ =
   let rec loop ?typeArgContext ~env acc (t : Types.type_expr) =
-    match t.desc with
+    match (Ast_uncurried.remove_function_dollar t).desc with
     | 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], _) ->
-      extractFunctionType2 ?typeArgContext ~env ~package t
     | Tconstr (path, typeArgs, _) -> (
       match References.digConstructor ~env ~package path with
       | Some
@@ -317,7 +312,7 @@ let rec extractType ?(printOpeningDebug = true)
       Printf.printf "[extract_type]--> %s"
         (debugLogTypeArgContext typeArgContext));
   let instantiateType = instantiateType2 in
-  match t.desc with
+  match (Ast_uncurried.remove_function_dollar t).desc with
   | Tlink t1 | Tsubst t1 | Tpoly (t1, []) ->
     extractType ?typeArgContext ~printOpeningDebug:false ~env ~package t1
   | Tconstr (Path.Pident {name = "option"}, [payloadTypeExpr], _) ->
@@ -334,13 +329,6 @@ let rec extractType ?(printOpeningDebug = true)
     Some (Tstring env, typeArgContext)
   | Tconstr (Path.Pident {name = "exn"}, [], _) ->
     Some (Texn env, typeArgContext)
-  | Tconstr (Pident {name = "function$"}, [t], _) -> (
-    match extractFunctionType2 ?typeArgContext t ~env ~package with
-    | args, tRet, typeArgContext when args <> [] ->
-      Some
-        ( Tfunction {env; args; typ = t; uncurried = true; returnType = tRet},
-          typeArgContext )
-    | _args, _tRet, _typeArgContext -> None)
   | Tarrow _ -> (
     match extractFunctionType2 ?typeArgContext t ~env ~package with
     | args, tRet, typeArgContext when args <> [] ->
@@ -906,11 +894,8 @@ let rec resolveNestedPatternPath (typ : innerType) ~env ~full ~nested =
 let getArgs ~env (t : Types.type_expr) ~full =
   let rec getArgsLoop ~env (t : Types.type_expr) ~full ~currentArgumentPosition
       =
-    match t.desc with
-    | Tlink t1
-    | Tsubst t1
-    | Tpoly (t1, [])
-    | Tconstr (Pident {name = "function$"}, [t1], _) ->
+    match (Ast_uncurried.remove_function_dollar t).desc with
+    | Tlink t1 | Tsubst t1 | Tpoly (t1, []) ->
       getArgsLoop ~full ~env ~currentArgumentPosition t1
     | Tarrow (Labelled l, tArg, tRet, _, _) ->
       (SharedTypes.Completable.Labelled l, tArg)

compiler/frontend/ast_core_type.ml

@@ -124,10 +124,10 @@ let get_uncurry_arity (ty : t) =
   | _ -> None
 
 let get_curry_arity (ty : t) =
-  if Ast_uncurried.core_type_is_uncurried_fun ty then
-    let arity, _ = Ast_uncurried.core_type_extract_uncurried_fun ty in
-    arity
-  else get_uncurry_arity_aux ty 0
+  match Ast_uncurried.core_type_remove_function_dollar ty with
+  | {ptyp_desc = Ptyp_arrow (_, _, _, Some arity)} -> arity
+  | _ -> get_uncurry_arity_aux ty 0
+
 let is_arity_one ty = get_curry_arity ty = 1
 
 type param_type = {
@@ -138,12 +138,20 @@ type param_type = {
 }
 
 let mk_fn_type (new_arg_types_ty : param_type list) (result : t) : t =
-  Ext_list.fold_right new_arg_types_ty result (fun {label; ty; attr; loc} acc ->
-      {
-        ptyp_desc = Ptyp_arrow (label, ty, acc, None);
-        ptyp_loc = loc;
-        ptyp_attributes = attr;
-      })
+  let t =
+    Ext_list.fold_right new_arg_types_ty result
+      (fun {label; ty; attr; loc} acc ->
+        {
+          ptyp_desc = Ptyp_arrow (label, ty, acc, None);
+          ptyp_loc = loc;
+          ptyp_attributes = attr;
+        })
+  in
+  match t.ptyp_desc with
+  | Ptyp_arrow (l, t1, t2, _arity) ->
+    let arity = List.length new_arg_types_ty in
+    {t with ptyp_desc = Ptyp_arrow (l, t1, t2, Some arity)}
+  | _ -> t
 
 let list_of_arrow (ty : t) : t * param_type list =
   let rec aux (ty : t) acc =

compiler/frontend/ast_core_type_class_type.ml

@@ -65,28 +65,20 @@ let default_typ_mapper = Bs_ast_mapper.default_mapper.typ
 *)
 
 let typ_mapper (self : Bs_ast_mapper.mapper) (ty : Parsetree.core_type) =
-  match ty with
-  | {
-   ptyp_attributes;
-   ptyp_desc =
-     ( Ptyp_arrow (label, args, body, _)
-     | Ptyp_constr
-         (* function$<...> is re-wrapped around only in case Nothing below *)
-         ( {txt = Lident "function$"},
-           [{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
-   *)
-   ptyp_loc = loc;
-  } -> (
-    match fst (Ast_attributes.process_attributes_rev ptyp_attributes) with
+  let loc = ty.ptyp_loc in
+  match (Ast_uncurried.core_type_remove_function_dollar ty).ptyp_desc with
+  | Ptyp_arrow (label, args, body, _)
+  (* let it go without regard label names,
+     it will report error later when the label is not empty
+  *) -> (
+    match fst (Ast_attributes.process_attributes_rev ty.ptyp_attributes) with
     | Meth_callback _ ->
       Ast_typ_uncurry.to_method_callback_type loc self label args body
     | Method _ ->
       (* Treat @meth as making the type uncurried, for backwards compatibility *)
       Ast_typ_uncurry.to_uncurry_type loc self label args body
     | Nothing -> Bs_ast_mapper.default_mapper.typ self ty)
-  | {ptyp_desc = Ptyp_object (methods, closed_flag); ptyp_loc = loc} ->
+  | Ptyp_object (methods, closed_flag) ->
     let ( +> ) attr (typ : Parsetree.core_type) =
       {typ with ptyp_attributes = attr :: typ.ptyp_attributes}
     in

compiler/frontend/ast_derive_abstract.ml

@@ -105,18 +105,25 @@ let handle_tdcl light (tdcl : Parsetree.type_declaration) :
           let is_optional = Ast_attributes.has_bs_optional pld_attributes in
 
           let maker, acc =
+            let arity =
+              if List.length labels = List.length label_declarations - 1 then
+                (* toplevel type *)
+                Some ((if has_optional_field then 2 else 1) + List.length labels)
+              else None
+            in
             if is_optional then
               let optional_type = Ast_core_type.lift_option_type pld_type in
-              ( Ast_compatible.opt_arrow ~loc:pld_loc ~arity:None label_name
-                  pld_type maker,
+              ( Ast_compatible.opt_arrow ~loc:pld_loc ~arity label_name pld_type
+                  maker,
                 Val.mk ~loc:pld_loc
                   (if light then pld_name
                    else {pld_name with txt = pld_name.txt ^ "Get"})
                   ~attrs:get_optional_attrs ~prim
-                  (Ast_compatible.arrow ~loc ~arity:None core_type optional_type)
+                  (Ast_compatible.arrow ~loc ~arity:(Some 1) core_type
+                     optional_type)
                 :: acc )
             else
-              ( Ast_compatible.label_arrow ~loc:pld_loc ~arity:None label_name
+              ( Ast_compatible.label_arrow ~loc:pld_loc ~arity label_name
                   pld_type maker,
                 Val.mk ~loc:pld_loc
                   (if light then pld_name
@@ -127,14 +134,14 @@ let handle_tdcl light (tdcl : Parsetree.type_declaration) :
                      External_ffi_types.ffi_bs_as_prims
                        [External_arg_spec.dummy] Return_identity
                        (Js_get {js_get_name = prim_as_name; js_get_scopes = []}))
-                  (Ast_compatible.arrow ~loc ~arity:None core_type pld_type)
+                  (Ast_compatible.arrow ~loc ~arity:(Some 1) core_type pld_type)
                 :: acc )
           in
           let is_current_field_mutable = pld_mutable = Mutable in
           let acc =
             if is_current_field_mutable then
               let setter_type =
-                Ast_compatible.arrow ~arity:None core_type
+                Ast_compatible.arrow ~arity:(Some 2) core_type
                   (Ast_compatible.arrow ~arity:None pld_type (* setter *)
                      (Ast_literal.type_unit ()))
               in

compiler/frontend/ast_derive_js_mapper.ml

@@ -67,7 +67,7 @@ let erase_type_str =
   Str.primitive
     (Val.mk ~prim:["%identity"]
        {loc = noloc; txt = erase_type_lit}
-       (Ast_compatible.arrow ~arity:None any any))
+       (Ast_compatible.arrow ~arity:(Some 1) any any))
 
 let unsafe_index = "_index"