Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Add [@inlined hint] attribute

master
Leo White 2020-03-05 12:31:28 +00:00
parent a1b11caf02
commit f46abe1916
17 changed files with 54 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
lambda/lambda.ml
View File

@ -214,6 +214,7 @@ type structured_constant =
type inline_attribute =
| Always_inline (* [@inline] or [@inline always] *)
| Never_inline (* [@inline never] *)
| Hint_inline (* [@inlined hint] attribute *)
| Unroll of int (* [@unroll x] *)
| Default_inline (* no [@inline] attribute *)
@ -221,12 +222,14 @@ let equal_inline_attribute x y =
match x, y with
| Always_inline, Always_inline
| Never_inline, Never_inline
| Hint_inline, Hint_inline
| Default_inline, Default_inline
->
true
| Unroll u, Unroll v ->
u = v
| (Always_inline | Never_inline | Unroll _ | Default_inline), _ ->
| (Always_inline | Never_inline
| Hint_inline | Unroll _ | Default_inline), _ ->
false
type specialise_attribute =

1
lambda/lambda.mli
View File

@ -204,6 +204,7 @@ type structured_constant =
type inline_attribute =
| Always_inline (* [@inline] or [@inline always] *)
| Never_inline (* [@inline never] *)
| Hint_inline (* [@inline hint] *)
| Unroll of int (* [@unroll x] *)
| Default_inline (* no [@inline] attribute *)

2
lambda/printlambda.ml
View File

@ -453,6 +453,7 @@ let function_attribute ppf { inline; specialise; local; is_a_functor; stub } =
begin match inline with
| Default_inline -> ()
| Always_inline -> fprintf ppf "always_inline@ "
| Hint_inline -> fprintf ppf "hint_inline@ "
| Never_inline -> fprintf ppf "never_inline@ "
| Unroll i -> fprintf ppf "unroll(%i)@ " i
end;
@ -475,6 +476,7 @@ let apply_inlined_attribute ppf = function
| Default_inline -> ()
| Always_inline -> fprintf ppf " always_inline"
| Never_inline -> fprintf ppf " never_inline"
| Hint_inline -> fprintf ppf " hint_inline"
| Unroll i -> fprintf ppf " never_inline(%i)" i
let apply_specialised_attribute ppf = function

3
lambda/simplif.ml
View File

@ -782,7 +782,8 @@ let simplify_local_functions lam =
| {local = Always_local; _}
| {local = Default_local; inline = (Never_inline | Default_inline); _}
-> true
| {local = Default_local; inline = (Always_inline | Unroll _); _}
| {local = Default_local;
inline = (Always_inline | Unroll _ | Hint_inline); _}
| {local = Never_local; _}
-> false
in

9
lambda/translattribute.ml
View File

@ -122,6 +122,7 @@ let parse_inline_attribute attr =
[
"never", Never_inline;
"always", Always_inline;
"hint", Hint_inline;
]
payload
@ -166,7 +167,7 @@ let get_local_attribute l =
let check_local_inline loc attr =
match attr.local, attr.inline with
| Always_local, (Always_inline | Unroll _) ->
| Always_local, (Always_inline | Hint_inline | Unroll _) ->
Location.prerr_warning loc
(Warnings.Duplicated_attribute "local/inline")
| _ ->
@ -178,14 +179,14 @@ let add_inline_attribute expr loc attributes =
| Lfunction({ attr = { stub = false } as attr } as funct), inline ->
begin match attr.inline with
| Default_inline -> ()
| Always_inline | Never_inline | Unroll _ ->
| Always_inline | Hint_inline | Never_inline | Unroll _ ->
Location.prerr_warning loc
(Warnings.Duplicated_attribute "inline")
end;
let attr = { attr with inline } in
check_local_inline loc attr;
Lfunction { funct with attr = attr }
| expr, (Always_inline | Never_inline | Unroll _) ->
| expr, (Always_inline | Hint_inline | Never_inline | Unroll _) ->
Location.prerr_warning loc
(Warnings.Misplaced_attribute "inline");
expr
@ -249,7 +250,7 @@ let get_and_remove_inlined_attribute_on_module e =
let inner_attr, me = get_and_remove me in
let attr =
match attr with
| Always_inline | Never_inline | Unroll _ -> attr
| Always_inline | Hint_inline | Never_inline | Unroll _ -> attr
| Default_inline -> inner_attr
in
attr, Tmod_constraint (me, mt, mtc, mc)

4
manual/manual/cmds/flambda.etex
View File

@ -727,7 +727,9 @@ to a function {\em application}, these direct the inliner likewise. These
attributes at call sites override any other attribute that may be present
on the corresponding declaration.
{\machine{\@inlined}} with no argument is equivalent to
{\machine{\@inlined always}}.
{\machine{\@inlined always}}. {\machine{\@\@inlined hint}} is equivalent to
{\machine{\@\@inline always}} except that it will not trigger warning 55 if
the function application cannot be inlined.
\end{options}
For recursive functions the relevant attributes are:

2
middle_end/closure/closure.ml
View File

@ -1317,7 +1317,7 @@ and close_functions { backend; fenv; cenv; mutable_vars } fun_defs =
in
let magic_scale_constant = 8. in
int_of_float (inline_threshold *. magic_scale_constant) + n
| Always_inline -> max_int
| Always_inline | Hint_inline -> max_int
| Never_inline -> min_int
| Unroll _ -> assert false
in

11
middle_end/flambda/flambda.ml
View File

@ -202,6 +202,7 @@ let rec lam ppf (flam : t) =
match inline with
| Always_inline -> fprintf ppf "<always>"
| Never_inline -> fprintf ppf "<never>"
| Hint_inline -> fprintf ppf "<hint>"
| Unroll i -> fprintf ppf "<unroll %i>" i
| Default_inline -> ()
in
@ -375,7 +376,7 @@ and print_function_declaration ppf var (f : function_declaration) =
in
let inline =
match f.inline with
| Always_inline -> " *inline*"
| Always_inline | Hint_inline -> " *inline*"
| Never_inline -> " *never_inline*"
| Unroll _ -> " *unroll*"
| Default_inline -> ""
@ -1024,10 +1025,12 @@ let create_function_declaration ~params ~body ~stub ~dbg
: function_declaration =
begin match stub, inline with
| true, (Never_inline | Default_inline)
| false, (Never_inline | Default_inline | Always_inline | Unroll _) -> ()
| true, (Always_inline | Unroll _) ->
| false, (Never_inline | Default_inline
| Always_inline | Hint_inline | Unroll _) -> ()
| true, (Always_inline | Hint_inline | Unroll _) ->
Misc.fatal_errorf
"Stubs may not be annotated as [Always_inline] or [Unroll]: %a"
"Stubs may not be annotated as [Always_inline], \
[Hint_inline] or [Unroll]: %a"
print body
end;
begin match stub, specialise with

4
middle_end/flambda/flambda_middle_end.ml
View File

@ -169,7 +169,7 @@ let lambda_to_flambda ~ppf_dump ~prefixname ~backend ~size ~filename
(* Check that there aren't any unused "always inline" attributes. *)
Flambda_iterators.iter_apply_on_program flam ~f:(fun apply ->
match apply.inline with
| Default_inline | Never_inline -> ()
| Default_inline | Never_inline | Hint_inline -> ()
| Always_inline ->
(* CR-someday mshinwell: consider a different error message if
this triggers as a result of the propagation of a user's
@ -183,7 +183,7 @@ let lambda_to_flambda ~ppf_dump ~prefixname ~backend ~size ~filename
| Unroll _ ->
Location.prerr_warning (Debuginfo.to_location apply.dbg)
(Warnings.Inlining_impossible
"[@unroll] attribute was not used on this function \
"[@unrolled] attribute was not used on this function \
application (the optimizer did not know what function \
was being applied)"));
if !Clflags.dump_flambda

4
middle_end/flambda/inline_and_simplify.ml
View File

@ -798,9 +798,9 @@ and simplify_partial_application env r ~lhs_of_application
on partial applications")
| Unroll _ ->
Location.prerr_warning (Debuginfo.to_location dbg)
(Warnings.Inlining_impossible "[@unroll] attributes may not be used \
(Warnings.Inlining_impossible "[@unrolled] attributes may not be used \
on partial applications")
| Default_inline -> ()
| Hint_inline | Default_inline -> ()
end;
begin match (specialise_requested : Lambda.specialise_attribute) with
| Always_specialise | Never_specialise ->

2
middle_end/flambda/inline_and_simplify_aux.ml
View File

@ -543,7 +543,7 @@ let keep_body_check ~is_classic_mode ~recursive =
match fun_decl.inline with
| Default_inline -> can_inline_non_rec_function fun_decl
| Unroll factor -> factor > 0
| Always_inline -> true
| Always_inline | Hint_inline -> true
| Never_inline -> false
end
end

7
middle_end/flambda/inlining_decision.ml
View File

@ -63,11 +63,12 @@ let inline env r ~lhs_of_application
(* Merge call site annotation and function annotation.
The call site annotation takes precedence *)
match (inline_requested : Lambda.inline_attribute) with
| Always_inline | Never_inline | Unroll _ -> inline_requested
| Always_inline | Hint_inline | Never_inline | Unroll _ ->
inline_requested
| Default_inline -> function_body.inline
in
match inline_annotation with
| Always_inline -> false, true, false, env
| Always_inline | Hint_inline -> false, true, false, env
| Never_inline -> false, false, true, env
| Default_inline -> false, false, false, env
| Unroll count ->
@ -493,7 +494,7 @@ let for_call_site ~env ~r ~(function_decls : A.function_declarations)
| Some _ -> Default_inline
| None -> inline_requested
end
| Always_inline | Default_inline | Never_inline ->
| Always_inline | Hint_inline | Default_inline | Never_inline ->
inline_requested
in
let original =

2
middle_end/flambda/simple_value_approx.ml
View File

@ -145,7 +145,7 @@ let print_function_declaration ppf var (f : function_declaration) =
let is_a_functor = if b.is_a_functor then " *functor*" else "" in
let inline =
match b.inline with
| Always_inline -> " *inline*"
| Always_inline | Hint_inline -> " *inline*"
| Never_inline -> " *never_inline*"
| Unroll _ -> " *unroll*"
| Default_inline -> ""

10
testsuite/tests/warnings/w47_inline.compilers.reference
View File

@ -10,27 +10,27 @@ File "w47_inline.ml", line 15, characters 23-29:
15 | let d = (fun x -> x) [@inline malformed attribute] (* rejected *)
^^^^^^
Warning 47: illegal payload for attribute 'inline'.
It must be either 'never', 'always' or empty
It must be either 'never', 'always', 'hint' or empty
File "w47_inline.ml", line 16, characters 23-29:
16 | let e = (fun x -> x) [@inline malformed_attribute] (* rejected *)
^^^^^^
Warning 47: illegal payload for attribute 'inline'.
It must be either 'never', 'always' or empty
It must be either 'never', 'always', 'hint' or empty
File "w47_inline.ml", line 17, characters 23-29:
17 | let f = (fun x -> x) [@inline : malformed_attribute] (* rejected *)
^^^^^^
Warning 47: illegal payload for attribute 'inline'.
It must be either 'never', 'always' or empty
It must be either 'never', 'always', 'hint' or empty
File "w47_inline.ml", line 18, characters 23-29:
18 | let g = (fun x -> x) [@inline ? malformed_attribute] (* rejected *)
^^^^^^
Warning 47: illegal payload for attribute 'inline'.
It must be either 'never', 'always' or empty
It must be either 'never', 'always', 'hint' or empty
File "w47_inline.ml", line 23, characters 15-22:
23 | let k x = (a [@inlined malformed]) x (* rejected *)
^^^^^^^
Warning 47: illegal payload for attribute 'inlined'.
It must be either 'never', 'always' or empty
It must be either 'never', 'always', 'hint' or empty
File "w47_inline.ml", line 31, characters 7-12:
31 | let[@local malformed] f3 x = x (* bad payload *) in
^^^^^

2
testsuite/tests/warnings/w55.flambda.reference
View File

@ -3,7 +3,7 @@ File "w55.ml", line 33, characters 10-26:
^^^^^^^^^^^^^^^^
Warning 55: Cannot inline: [@inlined] attributes may not be used on partial applications
File "w55.ml", line 29, characters 10-27:
29 | let i x = (!h [@inlined]) x
29 | let i x = (!r [@inlined]) x
^^^^^^^^^^^^^^^^^
Warning 55: Cannot inline: [@inlined] attribute was not used on this function application (the optimizer did not know what function was being applied)
File "w55.ml", line 39, characters 12-30:

14
testsuite/tests/warnings/w55.ml
View File

@ -24,9 +24,9 @@ let f = (fun x -> x + 1) [@inline never]
let g x = (f [@inlined]) x
let h = ref f
let r = ref f
let i x = (!h [@inlined]) x
let i x = (!r [@inlined]) x
let j x y = x + y
@ -40,3 +40,13 @@ let b x y = (a [@inlined]) x y
let c x = x + 1 [@@inline never]
let d x = (c [@inlined]) x
let g' x = (f [@inlined hint]) x
let i' x = (!r [@inlined hint]) x
let h' x = (j [@inlined hint]) x
let b' x y = (a [@inlined hint]) x y
let d' x = (c [@inlined hint]) x

2
testsuite/tests/warnings/w55.native.reference
View File

@ -3,7 +3,7 @@ File "w55.ml", line 25, characters 10-26:
^^^^^^^^^^^^^^^^
Warning 55: Cannot inline: Function information unavailable
File "w55.ml", line 29, characters 10-27:
29 | let i x = (!h [@inlined]) x
29 | let i x = (!r [@inlined]) x
^^^^^^^^^^^^^^^^^
Warning 55: Cannot inline: Unknown function
File "w55.ml", line 33, characters 10-26: