Skip to content

Commit 6f24778

Browse files
cristianoccristianoc
authored
Remove function$ entirely. (rescript-lang#7208)
1 parent b2ebcc0 commit 6f24778

File tree

82 files changed

+476
-658
lines changed

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

82 files changed

+476
-658
lines changed

‎CHANGELOG.md

+1
Original file line numberDiff line numberDiff line change
@@ -32,6 +32,7 @@
3232
- AST cleanup: Remove `Function$` entirely for function definitions. https://github.com/rescript-lang/rescript/pull/7200
3333
- AST cleanup: store arity in function type https://github.com/rescript-lang/rescript/pull/7195
3434
- AST cleanup: remove explicit uses of `function$` in preparation for removing the type entirely. https://github.com/rescript-lang/rescript/pull/7206
35+
- AST cleanup: remove `function$` entirely. https://github.com/rescript-lang/rescript/pull/7208
3536

3637
# 12.0.0-alpha.5
3738

‎analysis/src/CompletionBackEnd.ml

+1-1
Original file line numberDiff line numberDiff line change
@@ -1358,7 +1358,7 @@ let rec completeTypedValue ?(typeArgContext : typeArgContext option) ~rawOpens
13581358
in
13591359
(* Find all functions in the module that returns type t *)
13601360
let rec fnReturnsTypeT t =
1361-
match (Ast_uncurried.remove_function_dollar t).desc with
1361+
match t.Types.desc with
13621362
| Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> fnReturnsTypeT t1
13631363
| Tarrow _ -> (
13641364
match TypeUtils.extractFunctionType ~env ~package:full.package t with

‎analysis/src/CompletionJsx.ml

+1-1
Original file line numberDiff line numberDiff line change
@@ -234,7 +234,7 @@ let getJsxLabels ~componentPath ~findTypeOfValue ~package =
234234
| _ -> []
235235
in
236236
let rec getLabels (t : Types.type_expr) =
237-
match (Ast_uncurried.remove_function_dollar t).desc with
237+
match t.desc with
238238
| Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> getLabels t1
239239
| Tconstr (p, [propsType], _) when Path.name p = "React.component" -> (
240240
let rec getPropsType (t : Types.type_expr) =

‎analysis/src/CreateInterface.ml

+1-1
Original file line numberDiff line numberDiff line change
@@ -122,7 +122,7 @@ let printSignature ~extractor ~signature =
122122
let reactElement =
123123
Ctype.newconstr (Pdot (Pident (Ident.create "React"), "element", 0)) []
124124
in
125-
match (Ast_uncurried.remove_function_dollar typ).desc with
125+
match typ.desc with
126126
| Tarrow
127127
(_, {desc = Tconstr (Path.Pident propsId, typeArgs, _)}, retType, _, _)
128128
when Ident.name propsId = "props" ->

‎analysis/src/SignatureHelp.ml

+1-4
Original file line numberDiff line numberDiff line change
@@ -105,12 +105,9 @@ let findFunctionType ~currentFile ~debug ~path ~pos =
105105
let extractParameters ~signature ~typeStrForParser ~labelPrefixLen =
106106
match signature with
107107
| [{Parsetree.psig_desc = Psig_value {pval_type = expr}}]
108-
when match
109-
(Ast_uncurried.core_type_remove_function_dollar expr).ptyp_desc
110-
with
108+
when match expr.ptyp_desc with
111109
| Ptyp_arrow _ -> true
112110
| _ -> false ->
113-
let expr = Ast_uncurried.core_type_remove_function_dollar expr in
114111
let rec extractParams expr params =
115112
match expr with
116113
| {

‎analysis/src/TypeUtils.ml

+5-5
Original file line numberDiff line numberDiff line change
@@ -35,7 +35,7 @@ let findTypeViaLoc ~full ~debug (loc : Location.t) =
3535
| _ -> None
3636

3737
let pathFromTypeExpr (t : Types.type_expr) =
38-
match (Ast_uncurried.remove_function_dollar t).desc with
38+
match t.desc with
3939
| Tconstr (path, _typeArgs, _)
4040
| Tlink {desc = Tconstr (path, _typeArgs, _)}
4141
| Tsubst {desc = Tconstr (path, _typeArgs, _)}
@@ -239,7 +239,7 @@ let rec extractObjectType ~env ~package (t : Types.type_expr) =
239239

240240
let extractFunctionType ~env ~package typ =
241241
let rec loop ~env acc (t : Types.type_expr) =
242-
match (Ast_uncurried.remove_function_dollar t).desc with
242+
match t.desc with
243243
| Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> loop ~env acc t1
244244
| Tarrow (label, tArg, tRet, _, _) -> loop ~env ((label, tArg) :: acc) tRet
245245
| Tconstr (path, typeArgs, _) -> (
@@ -276,7 +276,7 @@ let maybeSetTypeArgCtx ?typeArgContextFromTypeManifest ~typeParams ~typeArgs env
276276
(* 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. *)
277277
let extractFunctionType2 ?typeArgContext ~env ~package typ =
278278
let rec loop ?typeArgContext ~env acc (t : Types.type_expr) =
279-
match (Ast_uncurried.remove_function_dollar t).desc with
279+
match t.desc with
280280
| Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> loop ?typeArgContext ~env acc t1
281281
| Tarrow (label, tArg, tRet, _, _) ->
282282
loop ?typeArgContext ~env ((label, tArg) :: acc) tRet
@@ -312,7 +312,7 @@ let rec extractType ?(printOpeningDebug = true)
312312
Printf.printf "[extract_type]--> %s"
313313
(debugLogTypeArgContext typeArgContext));
314314
let instantiateType = instantiateType2 in
315-
match (Ast_uncurried.remove_function_dollar t).desc with
315+
match t.desc with
316316
| Tlink t1 | Tsubst t1 | Tpoly (t1, []) ->
317317
extractType ?typeArgContext ~printOpeningDebug:false ~env ~package t1
318318
| Tconstr (Path.Pident {name = "option"}, [payloadTypeExpr], _) ->
@@ -894,7 +894,7 @@ let rec resolveNestedPatternPath (typ : innerType) ~env ~full ~nested =
894894
let getArgs ~env (t : Types.type_expr) ~full =
895895
let rec getArgsLoop ~env (t : Types.type_expr) ~full ~currentArgumentPosition
896896
=
897-
match (Ast_uncurried.remove_function_dollar t).desc with
897+
match t.desc with
898898
| Tlink t1 | Tsubst t1 | Tpoly (t1, []) ->
899899
getArgsLoop ~full ~env ~currentArgumentPosition t1
900900
| Tarrow (Labelled l, tArg, tRet, _, _) ->

‎compiler/frontend/ast_core_type.ml

+3-3
Original file line numberDiff line numberDiff line change
@@ -124,8 +124,8 @@ let get_uncurry_arity (ty : t) =
124124
| _ -> None
125125

126126
let get_curry_arity (ty : t) =
127-
match Ast_uncurried.core_type_remove_function_dollar ty with
128-
| {ptyp_desc = Ptyp_arrow (_, _, _, Some arity)} -> arity
127+
match ty.ptyp_desc with
128+
| Ptyp_arrow (_, _, _, Some arity) -> arity
129129
| _ -> get_uncurry_arity_aux ty 0
130130

131131
let is_arity_one ty = get_curry_arity ty = 1
@@ -156,7 +156,7 @@ let mk_fn_type (new_arg_types_ty : param_type list) (result : t) : t =
156156
let list_of_arrow (ty : t) : t * param_type list =
157157
let rec aux (ty : t) acc =
158158
match ty.ptyp_desc with
159-
| Ptyp_arrow (label, t1, t2, _) ->
159+
| Ptyp_arrow (label, t1, t2, arity) when arity = None || acc = [] ->
160160
aux t2
161161
(({label; ty = t1; attr = ty.ptyp_attributes; loc = ty.ptyp_loc}
162162
: param_type)

‎compiler/frontend/ast_core_type_class_type.ml

+1-1
Original file line numberDiff line numberDiff line change
@@ -66,7 +66,7 @@ let default_typ_mapper = Bs_ast_mapper.default_mapper.typ
6666

6767
let typ_mapper (self : Bs_ast_mapper.mapper) (ty : Parsetree.core_type) =
6868
let loc = ty.ptyp_loc in
69-
match (Ast_uncurried.core_type_remove_function_dollar ty).ptyp_desc with
69+
match ty.ptyp_desc with
7070
| Ptyp_arrow (label, args, body, _)
7171
(* let it go without regard label names,
7272
it will report error later when the label is not empty

‎compiler/frontend/ast_derive_js_mapper.ml

+2-5
Original file line numberDiff line numberDiff line change
@@ -129,9 +129,7 @@ let app1 = Ast_compatible.app1
129129

130130
let app2 = Ast_compatible.app2
131131

132-
let ( ->~ ) a b =
133-
Ast_uncurried.uncurried_type ~loc:Location.none ~arity:1
134-
(Ast_compatible.arrow ~arity:(Some 1) a b)
132+
let ( ->~ ) a b = Ast_compatible.arrow ~arity:(Some 1) a b
135133

136134
let raise_when_not_found_ident =
137135
Longident.Ldot (Lident Primitive_modules.util, "raiseWhenNotFound")
@@ -295,8 +293,7 @@ let init () =
295293
let pat_from_js = {Asttypes.loc; txt = from_js} in
296294
let to_js_type result =
297295
Ast_comb.single_non_rec_val pat_to_js
298-
(Ast_uncurried.uncurried_type ~loc:Location.none ~arity:1
299-
(Ast_compatible.arrow ~arity:(Some 1) core_type result))
296+
(Ast_compatible.arrow ~arity:(Some 1) core_type result)
300297
in
301298
let new_type, new_tdcl =
302299
U.new_type_of_type_declaration tdcl ("abs_" ^ name)

‎compiler/frontend/ast_derive_projector.ml

+8-9
Original file line numberDiff line numberDiff line change
@@ -120,10 +120,6 @@ let init () =
120120
Ext_list.flat_map tdcls handle_tdcl);
121121
signature_gen =
122122
(fun (tdcls : Parsetree.type_declaration list) _explict_nonrec ->
123-
let handle_uncurried_type_tranform ~loc ~arity t =
124-
if arity > 0 then Ast_uncurried.uncurried_type ~loc ~arity t
125-
else t
126-
in
127123
let handle_tdcl tdcl =
128124
let core_type =
129125
Ast_derive_util.core_type_of_type_declaration tdcl
@@ -140,10 +136,9 @@ let init () =
140136
| Ptype_record label_declarations ->
141137
Ext_list.map label_declarations (fun {pld_name; pld_type} ->
142138
Ast_comb.single_non_rec_val ?attrs:gentype_attrs pld_name
143-
(Ast_compatible.arrow ~arity:None core_type pld_type
144-
(*arity will alwys be 1 since these are single param functions*)
145-
|> handle_uncurried_type_tranform ~arity:1
146-
~loc:pld_name.loc))
139+
(Ast_compatible.arrow ~arity:(Some 1) core_type
140+
pld_type
141+
(*arity will alwys be 1 since these are single param functions*)))
147142
| Ptype_variant constructor_declarations ->
148143
Ext_list.map constructor_declarations
149144
(fun
@@ -166,11 +161,15 @@ let init () =
166161
| Some x -> x
167162
| None -> core_type
168163
in
164+
let add_arity ~arity t =
165+
if arity > 0 then Ast_uncurried.uncurried_type ~arity t
166+
else t
167+
in
169168
Ast_comb.single_non_rec_val ?attrs:gentype_attrs
170169
{loc; txt = Ext_string.uncapitalize_ascii con_name}
171170
(Ext_list.fold_right pcd_args annotate_type (fun x acc ->
172171
Ast_compatible.arrow ~arity:None x acc)
173-
|> handle_uncurried_type_tranform ~arity ~loc))
172+
|> add_arity ~arity))
174173
| Ptype_open | Ptype_abstract ->
175174
Ast_derive_util.not_applicable tdcl.ptype_loc deriving_name;
176175
[]

‎compiler/frontend/ast_exp_handle_external.ml

+1-1
Original file line numberDiff line numberDiff line change
@@ -133,7 +133,7 @@ let handle_ffi ~loc ~payload =
133133
match !is_function with
134134
| Some arity ->
135135
let type_ =
136-
Ast_uncurried.uncurried_type ~loc
136+
Ast_uncurried.uncurried_type
137137
~arity:(if arity = 0 then 1 else arity)
138138
(arrow ~arity)
139139
in

‎compiler/frontend/ast_external_process.ml

+2-2
Original file line numberDiff line numberDiff line change
@@ -934,11 +934,11 @@ let handle_attributes (loc : Bs_loc.t) (type_annotation : Parsetree.core_type)
934934
Parsetree.core_type * External_ffi_types.t * Parsetree.attributes * bool =
935935
let prim_name_with_source = {name = prim_name; source = External} in
936936
let type_annotation, build_uncurried_type =
937-
match Ast_uncurried.core_type_remove_function_dollar type_annotation with
937+
match type_annotation with
938938
| {ptyp_desc = Ptyp_arrow (_, _, _, Some _); _} as t ->
939939
( t,
940940
fun ~arity (x : Parsetree.core_type) ->
941-
Ast_uncurried.uncurried_type ~loc ~arity x )
941+
Ast_uncurried.uncurried_type ~arity x )
942942
| _ -> (type_annotation, fun ~arity:_ x -> x)
943943
in
944944
let result_type, arg_types_ty =

‎compiler/frontend/ast_typ_uncurry.ml

+1-1
Original file line numberDiff line numberDiff line change
@@ -66,5 +66,5 @@ let to_uncurry_type loc (mapper : Bs_ast_mapper.mapper)
6666
| _ -> assert false
6767
in
6868
match arity with
69-
| Some arity -> Ast_uncurried.uncurried_type ~loc ~arity fn_type
69+
| Some arity -> Ast_uncurried.uncurried_type ~arity fn_type
7070
| None -> assert false

‎compiler/gentype/TranslateCoreType.ml

+4-3
Original file line numberDiff line numberDiff line change
@@ -52,7 +52,8 @@ let rec translate_arrow_type ~config ~type_vars_gen
5252
~no_function_return_dependencies ~type_env ~rev_arg_deps ~rev_args
5353
(core_type : Typedtree.core_type) =
5454
match core_type.ctyp_desc with
55-
| Ttyp_arrow (Nolabel, core_type1, core_type2, _) ->
55+
| Ttyp_arrow (Nolabel, core_type1, core_type2, arity)
56+
when arity = None || rev_args = [] ->
5657
let {dependencies; type_} =
5758
core_type1 |> fun __x ->
5859
translateCoreType_ ~config ~type_vars_gen ~type_env __x
@@ -63,7 +64,8 @@ let rec translate_arrow_type ~config ~type_vars_gen
6364
~no_function_return_dependencies ~type_env ~rev_arg_deps:next_rev_deps
6465
~rev_args:((Nolabel, type_) :: rev_args)
6566
| Ttyp_arrow
66-
(((Labelled lbl | Optional lbl) as label), core_type1, core_type2, _) -> (
67+
(((Labelled lbl | Optional lbl) as label), core_type1, core_type2, arity)
68+
when arity = None || rev_args = [] -> (
6769
let as_label =
6870
match core_type.ctyp_attributes |> Annotation.get_gentype_as_renaming with
6971
| Some s -> s
@@ -114,7 +116,6 @@ let rec translate_arrow_type ~config ~type_vars_gen
114116
and translateCoreType_ ~config ~type_vars_gen
115117
?(no_function_return_dependencies = false) ~type_env
116118
(core_type : Typedtree.core_type) =
117-
let core_type = Ast_uncurried.tcore_type_remove_function_dollar core_type in
118119
match core_type.ctyp_desc with
119120
| Ttyp_alias (ct, _) ->
120121
ct

‎compiler/gentype/TranslateTypeExprFromTypes.ml

+9-5
Original file line numberDiff line numberDiff line change
@@ -268,7 +268,8 @@ let rec translate_arrow_type ~config ~type_vars_gen ~type_env ~rev_arg_deps
268268
| Tlink t ->
269269
translate_arrow_type ~config ~type_vars_gen ~type_env ~rev_arg_deps
270270
~rev_args t
271-
| Tarrow (Nolabel, type_expr1, type_expr2, _, _) ->
271+
| Tarrow (Nolabel, type_expr1, type_expr2, _, arity)
272+
when arity = None || rev_args = [] ->
272273
let {dependencies; type_} =
273274
type_expr1 |> fun __x ->
274275
translateTypeExprFromTypes_ ~config ~type_vars_gen ~type_env __x
@@ -279,8 +280,12 @@ let rec translate_arrow_type ~config ~type_vars_gen ~type_env ~rev_arg_deps
279280
~rev_arg_deps:next_rev_deps
280281
~rev_args:((Nolabel, type_) :: rev_args)
281282
| Tarrow
282-
(((Labelled lbl | Optional lbl) as label), type_expr1, type_expr2, _, _)
283-
-> (
283+
( ((Labelled lbl | Optional lbl) as label),
284+
type_expr1,
285+
type_expr2,
286+
_,
287+
arity )
288+
when arity = None || rev_args = [] -> (
284289
match type_expr1 |> remove_option ~label with
285290
| None ->
286291
let {dependencies; type_ = type1} =
@@ -312,8 +317,7 @@ let rec translate_arrow_type ~config ~type_vars_gen ~type_env ~rev_arg_deps
312317
{dependencies = all_deps; type_ = function_type}
313318

314319
and translateTypeExprFromTypes_ ~config ~type_vars_gen ~type_env
315-
(type_expr_ : Types.type_expr) =
316-
let type_expr = Ast_uncurried.remove_function_dollar type_expr_ in
320+
(type_expr : Types.type_expr) =
317321
match type_expr.desc with
318322
| Tvar None ->
319323
let type_name =

‎compiler/ml/ast_mapper_from0.ml

+1-4
Original file line numberDiff line numberDiff line change
@@ -120,10 +120,7 @@ module T = struct
120120
| _ -> assert false
121121
in
122122
let arity = arity_from_type t_arity in
123-
let fun_t =
124-
{fun_t with ptyp_desc = Ptyp_arrow (lbl, t1, t2, Some arity)}
125-
in
126-
{typ0 with ptyp_desc = Ptyp_constr (lid, [fun_t])}
123+
{fun_t with ptyp_desc = Ptyp_arrow (lbl, t1, t2, Some arity)}
127124
| _ -> typ0)
128125
| Ptyp_object (l, o) ->
129126
object_ ~loc ~attrs (List.map (object_field sub) l) o

‎compiler/ml/ast_mapper_to0.ml

+14-13
Original file line numberDiff line numberDiff line change
@@ -98,20 +98,21 @@ module T = struct
9898
match desc with
9999
| Ptyp_any -> any ~loc ~attrs ()
100100
| Ptyp_var s -> var ~loc ~attrs s
101-
| Ptyp_arrow (lab, t1, t2, _) ->
102-
arrow ~loc ~attrs lab (sub.typ sub t1) (sub.typ sub t2)
101+
| Ptyp_arrow (lab, t1, t2, arity) -> (
102+
let typ0 = arrow ~loc ~attrs lab (sub.typ sub t1) (sub.typ sub t2) in
103+
match arity with
104+
| None -> typ0
105+
| Some arity ->
106+
let arity_string = "Has_arity" ^ string_of_int arity in
107+
let arity_type =
108+
Ast_helper0.Typ.variant ~loc
109+
[Rtag (Location.mknoloc arity_string, [], true, [])]
110+
Closed None
111+
in
112+
Ast_helper0.Typ.constr ~loc
113+
{txt = Lident "function$"; loc}
114+
[typ0; arity_type])
103115
| Ptyp_tuple tyl -> tuple ~loc ~attrs (List.map (sub.typ sub) tyl)
104-
| Ptyp_constr
105-
( ({txt = Lident "function$"} as lid),
106-
[({ptyp_desc = Ptyp_arrow (_, _, _, Some arity)} as t_arg)] ) ->
107-
let encode_arity_string arity = "Has_arity" ^ string_of_int arity in
108-
let arity_type ~loc arity =
109-
Ast_helper0.Typ.variant ~loc
110-
[Rtag ({txt = encode_arity_string arity; loc}, [], true, [])]
111-
Closed None
112-
in
113-
constr ~loc ~attrs (map_loc sub lid)
114-
[sub.typ sub t_arg; arity_type ~loc:Location.none arity]
115116
| Ptyp_constr (lid, tl) ->
116117
constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl)
117118
| Ptyp_object (l, o) ->

0 commit comments

Comments
 (0)