diff --git a/CHANGELOG.md b/CHANGELOG.md index a57a50f0af..2f16d7bd44 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -14,6 +14,7 @@ #### :boom: Breaking Change +- Remove the call-site `@inlined` attribute, which was parsed but never affected code generation. It is now reported as a misplaced attribute (warning 53). https://github.com/rescript-lang/rescript/pull/8734 - Remove `@deriving(abstract)` and `@deriving(jsConverter)`. Use record types (with optional fields, mutable fields and `@as` renaming) and polymorphic variants directly instead. https://github.com/rescript-lang/rescript/pull/8729 #### :eyeglasses: Spec Compliance diff --git a/compiler/core/lam_pass_remove_alias.ml b/compiler/core/lam_pass_remove_alias.ml index 87570aa824..edad878576 100644 --- a/compiler/core/lam_pass_remove_alias.ml +++ b/compiler/core/lam_pass_remove_alias.ml @@ -189,11 +189,7 @@ let simplify_alias (meta : Lam_stats.t) (lam : Lambda.t) : Lambda.t = (* Ext_log.dwarn __LOC__ "beta .. %s/%d" v.name v.stamp ; *) simpl (Lam_beta_reduce.propagate_beta_reduce meta params body ap_args) - else if - (* Lam_analysis.size body < Lam_analysis.small_inline_size *) - (* ap_inlined = Always_inline || *) - Lam_analysis.ok_to_inline_fun_when_app m ap_args - then + else if Lam_analysis.ok_to_inline_fun_when_app m ap_args then let param_map = Lam_closure.is_closed_with_map meta.export_idents params body in diff --git a/compiler/ml/lambda.ml b/compiler/ml/lambda.ml index 20f8202156..24ec6eb784 100644 --- a/compiler/ml/lambda.ml +++ b/compiler/ml/lambda.ml @@ -362,7 +362,7 @@ and lfunction = { and prim_info = {primitive: primitive; args: t list; loc: Location.t} -and ap_info = {ap_loc: Location.t; ap_inlined: inline_attribute} +and ap_info = {ap_loc: Location.t} and lambda_apply = { ap_func: t; diff --git a/compiler/ml/lambda.mli b/compiler/ml/lambda.mli index e39c9bb11c..49a26d5e63 100644 --- a/compiler/ml/lambda.mli +++ b/compiler/ml/lambda.mli @@ -375,10 +375,7 @@ and lfunction = { and prim_info = private {primitive: primitive; args: t list; loc: Location.t} -and ap_info = { - ap_loc: Location.t; - ap_inlined: inline_attribute; (* specified with the [@inlined] attribute *) -} +and ap_info = {ap_loc: Location.t} and lambda_apply = private { ap_func: t; diff --git a/compiler/ml/lambda_traverse.ml b/compiler/ml/lambda_traverse.ml index 27434edd43..f0cfeb222f 100644 --- a/compiler/ml/lambda_traverse.ml +++ b/compiler/ml/lambda_traverse.ml @@ -124,8 +124,7 @@ let make_key e = | Lglobal_module _ | Lconst _ -> e | Lapply ap -> apply ~ap_transformed_jsx:ap.ap_transformed_jsx (tr_rec env ap.ap_func) - (tr_recs env ap.ap_args) - {ap.ap_info with ap_loc = Location.none} + (tr_recs env ap.ap_args) {ap_loc = Location.none} | Llet (Alias, x, ex, e) -> (* Ignore aliases -> substitute *) let ex = tr_rec env ex in diff --git a/compiler/ml/printlambda.ml b/compiler/ml/printlambda.ml index 123bc4c1b9..9a0316ce60 100644 --- a/compiler/ml/printlambda.ml +++ b/compiler/ml/printlambda.ml @@ -231,19 +231,13 @@ let function_attribute ppf {inline; is_a_functor; return_unit} = | Always_inline -> fprintf ppf "always_inline@ " | Never_inline -> fprintf ppf "never_inline@ " -let apply_inlined_attribute ppf = function - | Default_inline -> () - | Always_inline -> fprintf ppf " always_inline" - | Never_inline -> fprintf ppf " never_inline" - let rec lam ppf = function | Lvar id -> Ident.print ppf id | Lglobal_module id -> fprintf ppf "global %a" Ident.print id | Lconst cst -> struct_const ppf cst | Lapply ap -> let lams ppf largs = List.iter (fun l -> fprintf ppf "@ %a" lam l) largs in - fprintf ppf "@[<2>(apply@ %a%a%a)@]" lam ap.ap_func lams ap.ap_args - apply_inlined_attribute ap.ap_info.ap_inlined + fprintf ppf "@[<2>(apply@ %a%a)@]" lam ap.ap_func lams ap.ap_args | Lfunction {params; body; attr} -> let pr_params ppf params = List.iter (fun param -> fprintf ppf "@ %a" Ident.print param) params diff --git a/compiler/ml/translattribute.ml b/compiler/ml/translattribute.ml index a0d43249fb..799a17e5cc 100644 --- a/compiler/ml/translattribute.ml +++ b/compiler/ml/translattribute.ml @@ -20,11 +20,6 @@ let is_inline_attribute (attr : t) = | {txt = "inline"}, _ -> true | _ -> false -let is_inlined_attribute (attr : t) = - match attr with - | {txt = "inlined"}, _ -> true - | _ -> false - let find_attribute p (attributes : t list) = let inline_attribute, other_attributes = List.partition p attributes in let attr = @@ -57,7 +52,7 @@ let parse_inline_attribute (attr : t option) : Lambda.inline_attribute = | None -> Default_inline | Some ({txt; loc}, payload) -> ( let open Parsetree in - (* the 'inline' and 'inlined' attributes can be used as + (* the 'inline' attribute can be used as [@inline], [@inline never] or [@inline always]. [@inline] is equivalent to [@inline always] *) let warning txt = @@ -98,25 +93,6 @@ let add_inline_attribute (expr : Lambda.t) loc attributes = Location.prerr_warning loc (Warnings.Misplaced_attribute "inline"); expr -(* Get the [@inlined] attribute payload (or default if not present). - It also returns the expression without this attribute. This is - used to ensure that this attribute is not misplaced: If it - appears on any expression, it is an error, otherwise it would - have been removed by this function *) -let get_and_remove_inlined_attribute (e : Typedtree.expression) = - let attr, exp_attributes = - find_attribute is_inlined_attribute e.exp_attributes - in - let inlined = parse_inline_attribute attr in - (inlined, {e with exp_attributes}) - -let get_and_remove_inlined_attribute_on_module (e : Typedtree.module_expr) = - let attr, mod_attributes = - find_attribute is_inlined_attribute e.mod_attributes - in - let inlined = parse_inline_attribute attr in - (inlined, {e with mod_attributes}) - let check_attribute (e : Typedtree.expression) (({txt; loc}, _) : t) = match txt with | "inline" -> ( @@ -124,7 +100,7 @@ let check_attribute (e : Typedtree.expression) (({txt; loc}, _) : t) = | Texp_function _ -> () | _ -> Location.prerr_warning loc (Warnings.Misplaced_attribute txt)) | "inlined" -> - (* Removed by the Texp_apply cases *) + (* Call-site inlining hints are not supported *) Location.prerr_warning loc (Warnings.Misplaced_attribute txt) | _ -> () @@ -136,6 +112,6 @@ let check_attribute_on_module (e : Typedtree.module_expr) (({txt; loc}, _) : t) | Tmod_functor _ -> () | _ -> Location.prerr_warning loc (Warnings.Misplaced_attribute txt)) | "inlined" -> - (* Removed by the Texp_apply cases *) + (* Call-site inlining hints are not supported *) Location.prerr_warning loc (Warnings.Misplaced_attribute txt) | _ -> () diff --git a/compiler/ml/translattribute.mli b/compiler/ml/translattribute.mli index 6570ef8f25..0ece488763 100644 --- a/compiler/ml/translattribute.mli +++ b/compiler/ml/translattribute.mli @@ -24,9 +24,3 @@ val add_inline_attribute : val get_inline_attribute : Parsetree.attributes -> Lambda.inline_attribute val get_empty_attribute : string -> Parsetree.attributes -> Location.t option - -val get_and_remove_inlined_attribute : - Typedtree.expression -> Lambda.inline_attribute * Typedtree.expression - -val get_and_remove_inlined_attribute_on_module : - Typedtree.module_expr -> Lambda.inline_attribute * Typedtree.module_expr diff --git a/compiler/ml/translcore.ml b/compiler/ml/translcore.ml index 3ca4c699eb..2953971a88 100644 --- a/compiler/ml/translcore.ml +++ b/compiler/ml/translcore.ml @@ -909,8 +909,7 @@ let wrap_exn loc arg = ~args: [global_module (Ident.create_persistent Primitive_modules.exceptions)] loc) - [arg] - {ap_loc = loc; ap_inlined = Default_inline} + [arg] {ap_loc = loc} let exception_id_destructed (l : Lambda.t) (fv : Ident.t) : bool = let rec hit_opt = function | None -> false @@ -1044,14 +1043,14 @@ and transl_exp0 (e : Typedtree.expression) : Lambda.t = } when List.length oargs >= p.prim_arity && List.for_all (fun (_, arg) -> arg <> None) oargs -> ( + (* [funct] is not translated with [transl_exp], so check its attributes + here, in the warning scope [transl_exp] would use *) + Builtin_attributes.warning_scope ~ppwarning:false funct.exp_attributes + (fun () -> + List.iter (Translattribute.check_attribute funct) funct.exp_attributes); let args, args' = cut p.prim_arity oargs in let wrap f = - if args' = [] then f - else - let inlined, _ = - Translattribute.get_and_remove_inlined_attribute funct - in - transl_apply ~inlined ~transformed_jsx f args' e.exp_loc + if args' = [] then f else transl_apply ~transformed_jsx f args' e.exp_loc in let args = List.map @@ -1104,9 +1103,6 @@ and transl_exp0 (e : Typedtree.expression) : Lambda.t = warn_polymorphic_comparison e.exp_loc builtin argl; wrap (mk_builtin builtin argl e.exp_loc)))) | Texp_apply {funct; args = oargs; partial; transformed_jsx} -> - let inlined, funct = - Translattribute.get_and_remove_inlined_attribute funct - in let uncurried_partial_application = (* In case of partial application foo(args, ...) when some args are missing, get the arity *) @@ -1119,7 +1115,7 @@ and transl_exp0 (e : Typedtree.expression) : Lambda.t = | None -> None else None in - transl_apply ~inlined ~uncurried_partial_application ~transformed_jsx + transl_apply ~uncurried_partial_application ~transformed_jsx (transl_exp funct) oargs e.exp_loc | Texp_match (arg, pat_expr_list, exn_pat_expr_list, partial) -> transl_match e arg pat_expr_list exn_pat_expr_list partial @@ -1315,12 +1311,10 @@ and transl_case {c_lhs; c_guard; c_rhs} = (c_lhs, transl_guard c_guard c_rhs) and transl_cases cases = List.map transl_case cases -and transl_apply ?(inlined = Default_inline) - ?(uncurried_partial_application = None) ?(transformed_jsx = false) lam sargs - loc = +and transl_apply ?(uncurried_partial_application = None) + ?(transformed_jsx = false) lam sargs loc = let lapply ap_func ap_args = - apply ~ap_transformed_jsx:transformed_jsx ap_func ap_args - {ap_loc = loc; ap_inlined = inlined} + apply ~ap_transformed_jsx:transformed_jsx ap_func ap_args {ap_loc = loc} in let rec build_apply lam args = function | (None, optional) :: l -> @@ -1371,8 +1365,7 @@ and transl_apply ?(inlined = Default_inline) let extra_args = Ext_list.map extra_ids (fun id -> var id) in let ap_args = args @ extra_args in let l0 = - apply ~ap_transformed_jsx:transformed_jsx lam ap_args - {ap_loc = loc; ap_inlined = inlined} + apply ~ap_transformed_jsx:transformed_jsx lam ap_args {ap_loc = loc} in function_ ~loc ~attr:default_function_attribute ~params:(List.rev_append !none_ids extra_ids) diff --git a/compiler/ml/translmod.ml b/compiler/ml/translmod.ml index a91572bccd..1badca9a9c 100644 --- a/compiler/ml/translmod.ml +++ b/compiler/ml/translmod.ml @@ -126,7 +126,7 @@ and apply_coercion_result loc strict funct param arg cc_res = ~body: (apply_coercion loc Strict cc_res (Lambda.apply ~ap_transformed_jsx:false (Lambda.var id) [arg] - {ap_loc = loc; ap_inlined = Default_inline}))) + {ap_loc = loc}))) and wrap_id_pos_list loc id_pos_list get_field lam = let fv = Lambda_traverse.free_variables lam in @@ -262,9 +262,17 @@ let rec compile_functor mexp coercion root_path loc = } ~params:[param'] ~body -(* Compile a module expression *) +(* Compile a module expression, in the warning scope of its attributes like + [Translcore.transl_exp] *) and transl_module cc rootpath mexp = - List.iter (Translattribute.check_attribute_on_module mexp) mexp.mod_attributes; + Builtin_attributes.warning_scope ~ppwarning:false mexp.mod_attributes + (fun () -> + List.iter + (Translattribute.check_attribute_on_module mexp) + mexp.mod_attributes; + transl_module0 cc rootpath mexp) + +and transl_module0 cc rootpath mexp = let loc = mexp.mod_loc in match mexp.mod_type with | Mty_alias (Mta_absent, _) -> @@ -277,14 +285,11 @@ and transl_module cc rootpath mexp = | Tmod_structure str -> fst (transl_struct loc [] cc rootpath str) | Tmod_functor _ -> compile_functor mexp cc rootpath loc | Tmod_apply (funct, arg, ccarg) -> - let inlined_attribute, funct = - Translattribute.get_and_remove_inlined_attribute_on_module funct - in apply_coercion loc Strict cc (Lambda.apply ~ap_transformed_jsx:false (transl_module Tcoerce_none None funct) [transl_module ccarg None arg] - {ap_loc = loc; ap_inlined = inlined_attribute}) + {ap_loc = loc}) | Tmod_constraint (arg, _, _, ccarg) -> transl_module (compose_coercions cc ccarg) rootpath arg | Tmod_unpack (arg, _) -> diff --git a/tests/build_tests/super_errors/expected/warning_53_inlined_attribute.res.expected b/tests/build_tests/super_errors/expected/warning_53_inlined_attribute.res.expected new file mode 100644 index 0000000000..bf129e8906 --- /dev/null +++ b/tests/build_tests/super_errors/expected/warning_53_inlined_attribute.res.expected @@ -0,0 +1,35 @@ + + Warning number 53 + /.../fixtures/warning_53_inlined_attribute.res:7:10-17 + + 5 │ + 6 │ external id: int => int = "%identity" + 7 │ let c = (@inlined id)(3) + 8 │ let d = (@warning("-53") @inlined id)(4) + 9 │ + + the @inlined attribute cannot appear in this context + + + Warning number 53 + /.../fixtures/warning_53_inlined_attribute.res:4:9-16 + + 2 │ + 3 │ let a = (@inlined f)(1) + 4 │ let b = @inlined f(2) + 5 │ + 6 │ external id: int => int = "%identity" + + the @inlined attribute cannot appear in this context + + + Warning number 53 + /.../fixtures/warning_53_inlined_attribute.res:3:10-17 + + 1 │ let f = x => x + 1 + 2 │ + 3 │ let a = (@inlined f)(1) + 4 │ let b = @inlined f(2) + 5 │ + + the @inlined attribute cannot appear in this context \ No newline at end of file diff --git a/tests/build_tests/super_errors/fixtures/warning_53_inlined_attribute.res b/tests/build_tests/super_errors/fixtures/warning_53_inlined_attribute.res new file mode 100644 index 0000000000..a870e935e3 --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/warning_53_inlined_attribute.res @@ -0,0 +1,8 @@ +let f = x => x + 1 + +let a = (@inlined f)(1) +let b = @inlined f(2) + +external id: int => int = "%identity" +let c = (@inlined id)(3) +let d = (@warning("-53") @inlined id)(4) diff --git a/tests/ounit_tests/ounit_lambda_traverse_tests.ml b/tests/ounit_tests/ounit_lambda_traverse_tests.ml index 2bc3a09006..4b11e4d213 100644 --- a/tests/ounit_tests/ounit_lambda_traverse_tests.ml +++ b/tests/ounit_tests/ounit_lambda_traverse_tests.ml @@ -10,7 +10,7 @@ let var = Lambda.var x would pass either check below without exercising anything. *) let nodes : (string * Lambda.t) list = [ - ("apply", Lambda.apply var [var] {ap_loc = loc; ap_inlined = Default_inline}); + ("apply", Lambda.apply var [var] {ap_loc = loc}); ( "function", Lambda.function_ ~loc ~attr:Lambda.default_function_attribute ~params:[x] ~body:debugger );