Skip to content

Commit 8bbace5

Browse files
zthzth
committed
various uncurried fixes
1 parent eab5d85 commit 8bbace5

29 files changed

+372
-272
lines changed

‎analysis/src/CompletionBackEnd.ml

+13-3
Original file line numberDiff line numberDiff line change
@@ -1133,7 +1133,14 @@ let getOpens ~debug ~rawOpens ~package ~env =
11331133
if debug && packageOpens <> [] then
11341134
Printf.printf "%s\n"
11351135
("Package opens "
1136-
^ String.concat " " (packageOpens |> List.map pathToString));
1136+
^ String.concat " "
1137+
(packageOpens
1138+
|> List.map (fun p ->
1139+
p
1140+
|> List.map (fun name ->
1141+
(* Unify formatting between curried and uncurried *)
1142+
if name = "PervasivesU" then "Pervasives" else name)
1143+
|> pathToString)));
11371144
let resolvedOpens =
11381145
resolveOpens ~env (List.rev (packageOpens @ rawOpens)) ~package
11391146
in
@@ -1147,8 +1154,11 @@ let getOpens ~debug ~rawOpens ~package ~env =
11471154
|> List.map (fun (e : QueryEnv.t) ->
11481155
let name = Uri.toString e.file.uri in
11491156

1150-
if Utils.startsWith name "pervasives." then
1151-
Filename.chop_extension name
1157+
(* Unify formatting between curried and uncurried *)
1158+
if
1159+
name = "pervasives.res" || name = "pervasives.resi"
1160+
|| name = "pervasivesU.res" || name = "pervasivesU.resi"
1161+
then "pervasives"
11521162
else name)));
11531163
(* Last open takes priority *)
11541164
List.rev resolvedOpens

‎analysis/src/CompletionFrontEnd.ml

+11-10
Original file line numberDiff line numberDiff line change
@@ -148,7 +148,7 @@ let rec exprToContextPath (e : Parsetree.expression) =
148148
(match exprs with
149149
| [] -> None
150150
| exp :: _ -> exprToContextPath exp))
151-
| Pexp_ident {txt = Lident "|."} -> None
151+
| Pexp_ident {txt = Lident ("|." | "|.u")} -> None
152152
| Pexp_ident {txt} -> Some (CPId (Utils.flattenLongIdent txt, Value))
153153
| Pexp_field (e1, {txt = Lident name}) -> (
154154
match exprToContextPath e1 with
@@ -162,7 +162,7 @@ let rec exprToContextPath (e : Parsetree.expression) =
162162
| None -> None
163163
| Some contexPath -> Some (CPObj (contexPath, txt)))
164164
| Pexp_apply
165-
( {pexp_desc = Pexp_ident {txt = Lident "|."}},
165+
( {pexp_desc = Pexp_ident {txt = Lident ("|." | "|.u")}},
166166
[
167167
(_, lhs);
168168
(_, {pexp_desc = Pexp_apply (d, args); pexp_loc; pexp_attributes});
@@ -175,7 +175,7 @@ let rec exprToContextPath (e : Parsetree.expression) =
175175
pexp_attributes;
176176
}
177177
| Pexp_apply
178-
( {pexp_desc = Pexp_ident {txt = Lident "|."}},
178+
( {pexp_desc = Pexp_ident {txt = Lident ("|." | "|.u")}},
179179
[(_, lhs); (_, {pexp_desc = Pexp_ident id; pexp_loc; pexp_attributes})]
180180
) ->
181181
(* Transform away pipe with identifier *)
@@ -211,13 +211,13 @@ let completePipeChain (exp : Parsetree.expression) =
211211
(* When the left side of the pipe we're completing is a function application.
212212
Example: someArray->Js.Array2.map(v => v + 2)-> *)
213213
| Pexp_apply
214-
( {pexp_desc = Pexp_ident {txt = Lident "|."}},
214+
( {pexp_desc = Pexp_ident {txt = Lident ("|." | "|.u")}},
215215
[_; (_, {pexp_desc = Pexp_apply (d, _)})] ) ->
216216
exprToContextPath exp |> Option.map (fun ctxPath -> (ctxPath, d.pexp_loc))
217217
(* When the left side of the pipe we're completing is an identifier application.
218218
Example: someArray->filterAllTheGoodStuff-> *)
219219
| Pexp_apply
220-
( {pexp_desc = Pexp_ident {txt = Lident "|."}},
220+
( {pexp_desc = Pexp_ident {txt = Lident ("|." | "|.u")}},
221221
[_; (_, {pexp_desc = Pexp_ident _; pexp_loc})] ) ->
222222
exprToContextPath exp |> Option.map (fun ctxPath -> (ctxPath, pexp_loc))
223223
| _ -> None
@@ -813,7 +813,7 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor ~text =
813813
scope := oldScope);
814814
resetCurrentCtxPath oldCtxPath
815815
| Pexp_apply
816-
( {pexp_desc = Pexp_ident {txt = Lident "|."; loc = opLoc}},
816+
( {pexp_desc = Pexp_ident {txt = Lident ("|." | "|.u"); loc = opLoc}},
817817
[
818818
(_, lhs);
819819
(_, {pexp_desc = Pexp_extension _; pexp_loc = {loc_ghost = true}});
@@ -911,7 +911,7 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor ~text =
911911
| _ -> Cpath (CPId (compNamePath, Module)))
912912
else iterateJsxProps ~iterator jsxProps
913913
| Pexp_apply
914-
( {pexp_desc = Pexp_ident {txt = Lident "|."}},
914+
( {pexp_desc = Pexp_ident {txt = Lident ("|." | "|.u")}},
915915
[
916916
(_, lhs);
917917
(_, {pexp_desc = Pexp_ident {txt = Longident.Lident id; loc}});
@@ -920,13 +920,13 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor ~text =
920920
(* Case foo->id *)
921921
setPipeResult ~lhs ~id |> ignore
922922
| Pexp_apply
923-
( {pexp_desc = Pexp_ident {txt = Lident "|."; loc = opLoc}},
923+
( {pexp_desc = Pexp_ident {txt = Lident ("|." | "|.u"); loc = opLoc}},
924924
[(_, lhs); _] )
925925
when Loc.end_ opLoc = posCursor ->
926926
(* Case foo-> *)
927927
setPipeResult ~lhs ~id:"" |> ignore
928928
| Pexp_apply
929-
( {pexp_desc = Pexp_ident {txt = Lident "|."}},
929+
( {pexp_desc = Pexp_ident {txt = Lident ("|." | "|.u")}},
930930
[_; (_, {pexp_desc = Pexp_apply (funExpr, args)})] )
931931
when (* Normally named arg completion fires when the cursor is right after the expression.
932932
E.g in foo(~<---there
@@ -957,7 +957,8 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor ~text =
957957
argCompletable |> iterateFnArguments ~isPipe:true ~args ~iterator;
958958
resetCurrentCtxPath oldCtxPath)
959959
| Some argCompletable -> setResult argCompletable)
960-
| Pexp_apply ({pexp_desc = Pexp_ident {txt = Lident "|."}}, [_; _]) ->
960+
| Pexp_apply
961+
({pexp_desc = Pexp_ident {txt = Lident ("|." | "|.u")}}, [_; _]) ->
961962
(* Ignore any other pipe. *)
962963
()
963964
| Pexp_apply (funExpr, args)

‎analysis/src/CompletionJsx.ml

+5-1
Original file line numberDiff line numberDiff line change
@@ -731,7 +731,11 @@ let getJsxLabels ~componentPath ~findTypeOfValue ~package =
731731
in
732732
let rec getLabels (t : Types.type_expr) =
733733
match t.desc with
734-
| Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> getLabels t1
734+
| Tlink t1
735+
| Tsubst t1
736+
| Tpoly (t1, [])
737+
| Tconstr (Pident {name = "function$"}, [t1; _], _) ->
738+
getLabels t1
735739
| Tarrow
736740
( Nolabel,
737741
{

‎analysis/src/CreateInterface.ml

+6-2
Original file line numberDiff line numberDiff line change
@@ -164,11 +164,13 @@ let printSignature ~extractor ~signature =
164164

165165
let buf = Buffer.create 10 in
166166

167-
let getComponentTypeV3 (typ : Types.type_expr) =
167+
let rec getComponentTypeV3 (typ : Types.type_expr) =
168168
let reactElement =
169169
Ctype.newconstr (Pdot (Pident (Ident.create "React"), "element", 0)) []
170170
in
171171
match typ.desc with
172+
| Tconstr (Pident {name = "function$"}, [typ; _], _) ->
173+
getComponentTypeV3 typ
172174
| Tarrow (_, {desc = Tobject (tObj, _)}, retType, _) -> Some (tObj, retType)
173175
| Tconstr
174176
( Pdot (Pident {name = "React"}, "component", _),
@@ -183,11 +185,13 @@ let printSignature ~extractor ~signature =
183185
| _ -> None
184186
in
185187

186-
let getComponentTypeV4 (typ : Types.type_expr) =
188+
let rec getComponentTypeV4 (typ : Types.type_expr) =
187189
let reactElement =
188190
Ctype.newconstr (Pdot (Pident (Ident.create "React"), "element", 0)) []
189191
in
190192
match typ.desc with
193+
| Tconstr (Pident {name = "function$"}, [typ; _], _) ->
194+
getComponentTypeV4 typ
191195
| Tarrow (_, {desc = Tconstr (Path.Pident propsId, typeArgs, _)}, retType, _)
192196
when Ident.name propsId = "props" ->
193197
Some (typeArgs, retType)

‎analysis/src/Packages.ml

+5-1
Original file line numberDiff line numberDiff line change
@@ -82,7 +82,11 @@ let newBsPackage ~rootPath =
8282
| None -> []
8383
in
8484
let opens =
85-
["Pervasives"; "JsxModules"] :: opens_from_namespace
85+
[
86+
(if uncurried then "PervasivesU" else "Pervasives");
87+
"JsxModules";
88+
]
89+
:: opens_from_namespace
8690
|> List.rev_append opens_from_bsc_flags
8791
|> List.map (fun path -> path @ ["place holder"])
8892
in

‎analysis/src/TypeUtils.ml

+8-3
Original file line numberDiff line numberDiff line change
@@ -198,12 +198,14 @@ let getBuiltinFromTypePath path =
198198
| Path.Pident id when Ident.name id = "result" -> Some Result
199199
| Path.Pident id when Ident.name id = "lazy_t" -> Some Lazy
200200
| Path.Pident id when Ident.name id = "char" -> Some Char
201-
| Pdot (Pident id, "result", _) when Ident.name id = "Pervasives" ->
201+
| Pdot (Pident id, "result", _)
202+
when Ident.name id = "Pervasives" || Ident.name id = "PervasivesU" ->
202203
Some Result
203204
| _ -> None
204205

205-
let pathFromTypeExpr (t : Types.type_expr) =
206+
let rec pathFromTypeExpr (t : Types.type_expr) =
206207
match t.desc with
208+
| Tconstr (Pident {name = "function$"}, [t; _], _) -> pathFromTypeExpr t
207209
| Tconstr (path, _typeArgs, _)
208210
| Tlink {desc = Tconstr (path, _typeArgs, _)}
209211
| Tsubst {desc = Tconstr (path, _typeArgs, _)}
@@ -513,7 +515,10 @@ let getArgs ~env (t : Types.type_expr) ~full =
513515
let rec getArgsLoop ~env (t : Types.type_expr) ~full ~currentArgumentPosition
514516
=
515517
match t.desc with
516-
| Tlink t1 | Tsubst t1 | Tpoly (t1, []) ->
518+
| Tlink t1
519+
| Tsubst t1
520+
| Tpoly (t1, [])
521+
| Tconstr (Pident {name = "function$"}, [t1; _], _) ->
517522
getArgsLoop ~full ~env ~currentArgumentPosition t1
518523
| Tarrow (Labelled l, tArg, tRet, _) ->
519524
(SharedTypes.Completable.Labelled l, tArg)

‎analysis/src/Xform.ml

+4-1
Original file line numberDiff line numberDiff line change
@@ -195,7 +195,10 @@ module AddTypeAnnotation = struct
195195
in
196196
let rec processFunction ~argNum (e : Parsetree.expression) =
197197
match e.pexp_desc with
198-
| Pexp_fun (argLabel, _, pat, e) ->
198+
| Pexp_fun (argLabel, _, pat, e)
199+
| Pexp_construct
200+
( {txt = Lident "Function$"},
201+
Some {pexp_desc = Pexp_fun (argLabel, _, pat, e)} ) ->
199202
let isUnlabeledOnlyArg =
200203
argNum = 1 && argLabel = Nolabel
201204
&&

‎analysis/tests/bsconfig.json

+1
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
{
2+
"uncurried": true,
23
"name": "test",
34
"reanalyze": {
45
"analysis": ["dce"]

‎analysis/tests/package-lock.json

+10-7
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎analysis/tests/package.json

+1-1
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,6 @@
88
"@rescript/react": "^0.11.0-rc.3"
99
},
1010
"dependencies": {
11-
"rescript": "^11.0.0-alpha.1"
11+
"rescript": "^11.0.0-rc.1"
1212
}
1313
}

‎analysis/tests/src/expected/Auto.res.txt

+1-1
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,3 @@
11
Hover src/Auto.res 2:13
2-
{"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"}}
2+
{"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"}}
33

0 commit comments

Comments
 (0)