various uncurried fixes

Author: zth

analysis/src/CompletionBackEnd.ml

@@ -1125,7 +1125,14 @@ let getOpens ~debug ~rawOpens ~package ~env =
   if debug && packageOpens <> [] then
     Printf.printf "%s\n"
       ("Package opens "
-      ^ String.concat " " (packageOpens |> List.map pathToString));
+      ^ String.concat " "
+          (packageOpens
+          |> List.map (fun p ->
+                 p
+                 |> List.map (fun name ->
+                        (* Unify formatting between curried and uncurried *)
+                        if name = "PervasivesU" then "Pervasives" else name)
+                 |> pathToString)));
   let resolvedOpens =
     resolveOpens ~env (List.rev (packageOpens @ rawOpens)) ~package
   in
@@ -1139,8 +1146,11 @@ let getOpens ~debug ~rawOpens ~package ~env =
           |> List.map (fun (e : QueryEnv.t) ->
                  let name = Uri.toString e.file.uri in
 
-                 if Utils.startsWith name "pervasives." then
-                   Filename.chop_extension name
+                 (* Unify formatting between curried and uncurried *)
+                 if
+                   name = "pervasives.res" || name = "pervasives.resi"
+                   || name = "pervasivesU.res" || name = "pervasivesU.resi"
+                 then "pervasives"
                  else name)));
   (* Last open takes priority *)
   List.rev resolvedOpens

analysis/src/CompletionFrontEnd.ml

@@ -148,7 +148,7 @@ let rec exprToContextPath (e : Parsetree.expression) =
          (match exprs with
          | [] -> None
          | exp :: _ -> exprToContextPath exp))
-  | Pexp_ident {txt = Lident "|."} -> None
+  | Pexp_ident {txt = Lident ("|." | "|.u")} -> None
   | Pexp_ident {txt} -> Some (CPId (Utils.flattenLongIdent txt, Value))
   | Pexp_field (e1, {txt = Lident name}) -> (
     match exprToContextPath e1 with
@@ -162,7 +162,7 @@ let rec exprToContextPath (e : Parsetree.expression) =
     | None -> None
     | Some contexPath -> Some (CPObj (contexPath, txt)))
   | Pexp_apply
-      ( {pexp_desc = Pexp_ident {txt = Lident "|."}},
+      ( {pexp_desc = Pexp_ident {txt = Lident ("|." | "|.u")}},
         [
           (_, lhs);
           (_, {pexp_desc = Pexp_apply (d, args); pexp_loc; pexp_attributes});
@@ -175,7 +175,7 @@ let rec exprToContextPath (e : Parsetree.expression) =
         pexp_attributes;
       }
   | Pexp_apply
-      ( {pexp_desc = Pexp_ident {txt = Lident "|."}},
+      ( {pexp_desc = Pexp_ident {txt = Lident ("|." | "|.u")}},
         [(_, lhs); (_, {pexp_desc = Pexp_ident id; pexp_loc; pexp_attributes})]
       ) ->
     (* Transform away pipe with identifier *)
@@ -211,13 +211,13 @@ let completePipeChain (exp : Parsetree.expression) =
   (* When the left side of the pipe we're completing is a function application.
      Example: someArray->Js.Array2.map(v => v + 2)-> *)
   | Pexp_apply
-      ( {pexp_desc = Pexp_ident {txt = Lident "|."}},
+      ( {pexp_desc = Pexp_ident {txt = Lident ("|." | "|.u")}},
         [_; (_, {pexp_desc = Pexp_apply (d, _)})] ) ->
     exprToContextPath exp |> Option.map (fun ctxPath -> (ctxPath, d.pexp_loc))
     (* When the left side of the pipe we're completing is an identifier application.
        Example: someArray->filterAllTheGoodStuff-> *)
   | Pexp_apply
-      ( {pexp_desc = Pexp_ident {txt = Lident "|."}},
+      ( {pexp_desc = Pexp_ident {txt = Lident ("|." | "|.u")}},
         [_; (_, {pexp_desc = Pexp_ident _; pexp_loc})] ) ->
     exprToContextPath exp |> Option.map (fun ctxPath -> (ctxPath, pexp_loc))
   | _ -> None
@@ -792,7 +792,7 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor ~text =
              scope := oldScope);
       resetCurrentCtxPath oldCtxPath
     | Pexp_apply
-        ( {pexp_desc = Pexp_ident {txt = Lident "|."; loc = opLoc}},
+        ( {pexp_desc = Pexp_ident {txt = Lident ("|." | "|.u"); loc = opLoc}},
           [
             (_, lhs);
             (_, {pexp_desc = Pexp_extension _; pexp_loc = {loc_ghost = true}});
@@ -890,7 +890,7 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor ~text =
               | _ -> Cpath (CPId (compNamePath, Module)))
           else iterateJsxProps ~iterator jsxProps
         | Pexp_apply
-            ( {pexp_desc = Pexp_ident {txt = Lident "|."}},
+            ( {pexp_desc = Pexp_ident {txt = Lident ("|." | "|.u")}},
               [
                 (_, lhs);
                 (_, {pexp_desc = Pexp_ident {txt = Longident.Lident id; loc}});
@@ -899,13 +899,13 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor ~text =
           (* Case foo->id *)
           setPipeResult ~lhs ~id |> ignore
         | Pexp_apply
-            ( {pexp_desc = Pexp_ident {txt = Lident "|."; loc = opLoc}},
+            ( {pexp_desc = Pexp_ident {txt = Lident ("|." | "|.u"); loc = opLoc}},
               [(_, lhs); _] )
           when Loc.end_ opLoc = posCursor ->
           (* Case foo-> *)
           setPipeResult ~lhs ~id:"" |> ignore
         | Pexp_apply
-            ( {pexp_desc = Pexp_ident {txt = Lident "|."}},
+            ( {pexp_desc = Pexp_ident {txt = Lident ("|." | "|.u")}},
               [_; (_, {pexp_desc = Pexp_apply (funExpr, args)})] )
           when (* Normally named arg completion fires when the cursor is right after the expression.
                   E.g in foo(~<---there
@@ -936,7 +936,8 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor ~text =
               argCompletable |> iterateFnArguments ~isPipe:true ~args ~iterator;
               resetCurrentCtxPath oldCtxPath)
           | Some argCompletable -> setResult argCompletable)
-        | Pexp_apply ({pexp_desc = Pexp_ident {txt = Lident "|."}}, [_; _]) ->
+        | Pexp_apply
+            ({pexp_desc = Pexp_ident {txt = Lident ("|." | "|.u")}}, [_; _]) ->
           (* Ignore any other pipe. *)
           ()
         | Pexp_apply (funExpr, args)

analysis/src/CompletionJsx.ml

@@ -731,7 +731,11 @@ let getJsxLabels ~componentPath ~findTypeOfValue ~package =
     in
     let rec getLabels (t : Types.type_expr) =
       match t.desc with
-      | Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> getLabels t1
+      | Tlink t1
+      | Tsubst t1
+      | Tpoly (t1, [])
+      | Tconstr (Pident {name = "function$"}, [t1; _], _) ->
+        getLabels t1
       | Tarrow
           ( Nolabel,
             {

analysis/src/CreateInterface.ml

@@ -164,11 +164,13 @@ let printSignature ~extractor ~signature =
 
   let buf = Buffer.create 10 in
 
-  let getComponentTypeV3 (typ : Types.type_expr) =
+  let rec getComponentTypeV3 (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; _], _) ->
+      getComponentTypeV3 typ
     | Tarrow (_, {desc = Tobject (tObj, _)}, retType, _) -> Some (tObj, retType)
     | Tconstr
         ( Pdot (Pident {name = "React"}, "component", _),
@@ -183,11 +185,13 @@ let printSignature ~extractor ~signature =
     | _ -> None
   in
 
-  let getComponentTypeV4 (typ : Types.type_expr) =
+  let rec getComponentTypeV4 (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; _], _) ->
+      getComponentTypeV4 typ
     | Tarrow (_, {desc = Tconstr (Path.Pident propsId, typeArgs, _)}, retType, _)
       when Ident.name propsId = "props" ->
       Some (typeArgs, retType)

analysis/src/Packages.ml

@@ -82,7 +82,11 @@ let newBsPackage ~rootPath =
                | None -> []
              in
              let opens =
-               ["Pervasives"; "JsxModules"] :: opens_from_namespace
+               [
+                 (if uncurried then "PervasivesU" else "Pervasives");
+                 "JsxModules";
+               ]
+               :: opens_from_namespace
                |> List.rev_append opens_from_bsc_flags
                |> List.map (fun path -> path @ ["place holder"])
              in

analysis/src/TypeUtils.ml

@@ -198,12 +198,14 @@ let getBuiltinFromTypePath path =
   | Path.Pident id when Ident.name id = "result" -> Some Result
   | Path.Pident id when Ident.name id = "lazy_t" -> Some Lazy
   | Path.Pident id when Ident.name id = "char" -> Some Char
-  | Pdot (Pident id, "result", _) when Ident.name id = "Pervasives" ->
+  | Pdot (Pident id, "result", _)
+    when Ident.name id = "Pervasives" || Ident.name id = "PervasivesU" ->
     Some Result
   | _ -> None
 
-let pathFromTypeExpr (t : Types.type_expr) =
+let rec pathFromTypeExpr (t : Types.type_expr) =
   match t.desc with
+  | Tconstr (Pident {name = "function$"}, [t; _], _) -> pathFromTypeExpr t
   | Tconstr (path, _typeArgs, _)
   | Tlink {desc = Tconstr (path, _typeArgs, _)}
   | Tsubst {desc = Tconstr (path, _typeArgs, _)}
@@ -513,7 +515,10 @@ 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, []) ->
+    | Tlink t1
+    | Tsubst t1
+    | Tpoly (t1, [])
+    | Tconstr (Pident {name = "function$"}, [t1; _], _) ->
       getArgsLoop ~full ~env ~currentArgumentPosition t1
     | Tarrow (Labelled l, tArg, tRet, _) ->
       (SharedTypes.Completable.Labelled l, tArg)

analysis/src/Xform.ml

@@ -195,7 +195,10 @@ module AddTypeAnnotation = struct
     in
     let rec processFunction ~argNum (e : Parsetree.expression) =
       match e.pexp_desc with
-      | Pexp_fun (argLabel, _, pat, e) ->
+      | Pexp_fun (argLabel, _, pat, e)
+      | Pexp_construct
+          ( {txt = Lident "Function$"},
+            Some {pexp_desc = Pexp_fun (argLabel, _, pat, e)} ) ->
         let isUnlabeledOnlyArg =
           argNum = 1 && argLabel = Nolabel
           &&

analysis/tests/bsconfig.json

@@ -1,4 +1,5 @@
 {
+  "uncurried": true,
   "name": "test",
   "reanalyze": {
     "analysis": ["dce"]

analysis/tests/package-lock.json

@@ -8,6 +8,6 @@
     "@rescript/react": "^0.11.0-rc.3"
   },
   "dependencies": {
-    "rescript": "^11.0.0-alpha.1"
+    "rescript": "^11.0.0-rc.1"
   }
 }

analysis/tests/package.json

@@ -1,3 +1,3 @@
 Hover src/Auto.res 2:13
-{"contents": {"kind": "markdown", "value": "```rescript\n(Belt.List.t<'a>, 'a => 'b) => Belt.List.t<'b>\n```\n\n---\n\n```\n \n```\n```rescript\ntype Belt.List.t<'a> = list<'a>\n```\nGo to: [Type definition](command:rescript-vscode.go_to_location?%5B%22belt_List.mli%22%2C34%2C0%5D)\n\n\n\n  Returns a new list with `f` applied to each element of `someList`.\n\n  ```res example\n  list{1, 2}->Belt.List.map(x => x + 1) // list{3, 4}\n  ```\n"}}
+{"contents": {"kind": "markdown", "value": "```rescript\n(. Belt.List.t<'a>, (. 'a) => 'b) => Belt.List.t<'b>\n```\n\n---\n\n```\n \n```\n```rescript\ntype Belt.List.t<'a> = list<'a>\n```\nGo to: [Type definition](command:rescript-vscode.go_to_location?%5B%22belt_List.resi%22%2C35%2C0%5D)\n\n\n\n  Returns a new list with `f` applied to each element of `someList`.\n\n  ```res example\n  list{1, 2}->Belt.List.map(x => x + 1) // list{3, 4}\n  ```\n"}}