Remove explicit uses of function$ from the analysis.

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/ml/ast_uncurried.ml

@@ -87,7 +87,7 @@ let uncurried_type_get_arity_opt ~env typ =
   | Tconstr (Pident {name = "function$"}, [t], _) -> Some (tarrow_to_arity t)
   | _ -> None
 
-let remove_uncurried_type ?env typ =
+let remove_function_dollar ?env typ =
   match
     (match env with
     | Some env -> Ctype.expand_head env typ
@@ -96,3 +96,8 @@ let remove_uncurried_type ?env typ =
   with
   | Tconstr (Pident {name = "function$"}, [t], _) -> t
   | _ -> typ
+
+let core_type_remove_function_dollar (typ : Parsetree.core_type) =
+  match typ.ptyp_desc with
+  | Ptyp_constr ({txt = Lident "function$"}, [t]) -> t
+  | _ -> typ

compiler/ml/typecore.ml

@@ -3528,7 +3528,7 @@ and type_application ?type_clash_context total_app env funct (sargs : sargs) :
   in
   let has_uncurried_type funct =
     let t = funct.exp_type in
-    let inner_t = Ast_uncurried.remove_uncurried_type ~env t in
+    let inner_t = Ast_uncurried.remove_function_dollar ~env t in
     if force_tvar then Some (List.length sargs, inner_t)
     else
       match (Ctype.repr inner_t).desc with
@@ -3544,7 +3544,7 @@ and type_application ?type_clash_context total_app env funct (sargs : sargs) :
       unify_exp env funct uncurried_typ
     else if
       Ast_uncurried.tarrow_to_arity_opt
-        (Ast_uncurried.remove_uncurried_type ~env funct.exp_type)
+        (Ast_uncurried.remove_function_dollar ~env funct.exp_type)
       = None
     then
       raise
@@ -4280,10 +4280,10 @@ let report_error env ppf error =
   let error =
     match error with
     | Expr_type_clash ((t1, s1) :: (t2, s2) :: trace, type_clash_context) ->
-      let s1 = Ast_uncurried.remove_uncurried_type s1 in
-      let s2 = Ast_uncurried.remove_uncurried_type s2 in
-      let t1 = Ast_uncurried.remove_uncurried_type t1 in
-      let t2 = Ast_uncurried.remove_uncurried_type t2 in
+      let s1 = Ast_uncurried.remove_function_dollar s1 in
+      let s2 = Ast_uncurried.remove_function_dollar s2 in
+      let t1 = Ast_uncurried.remove_function_dollar t1 in
+      let t2 = Ast_uncurried.remove_function_dollar t2 in
       Expr_type_clash ((t1, s1) :: (t2, s2) :: trace, type_clash_context)
     | _ -> error
   in

tests/analysis_tests/tests/src/expected/Completion.res.txt

@@ -1822,8 +1822,14 @@ Resolved opens 2 Completion Completion
 ContextPath Value[withCallback](~a)
 ContextPath Value[withCallback]
 Path withCallback
-Found type for function int
-[]
+Found type for function (~b: int) => int
+[{
+    "label": "b",
+    "kind": 4,
+    "tags": [],
+    "detail": "int",
+    "documentation": null
+  }]
 
 Complete src/Completion.res 332:21
 posCursor:[332:21] posNoWhite:[332:20] Found expr:[332:3->332:21]