Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Fix bug in Clambda_primitives.result_layout. #1833

Merged
merged 1 commit into from
Sep 19, 2023
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 2 additions & 0 deletions middle_end/clambda_primitives.ml
Original file line number Diff line number Diff line change
Expand Up @@ -210,4 +210,6 @@ let result_layout (p : primitive) =
match p with
| Punbox_float -> Lambda.Punboxed_float
| Punbox_int bi -> Lambda.Punboxed_int bi
| Pccall {prim_native_repr_res = (_, repr_res); _} ->
Lambda.layout_of_native_repr repr_res
| _ -> Lambda.layout_any_value
24 changes: 13 additions & 11 deletions ocaml/lambda/lambda.ml
Original file line number Diff line number Diff line change
Expand Up @@ -1487,6 +1487,18 @@ let structured_constant_layout = function
| Const_block _ | Const_immstring _ -> Pvalue Pgenval
| Const_float_array _ | Const_float_block _ -> Pvalue (Parrayval Pfloatarray)

let layout_of_native_repr : Primitive.native_repr -> _ = function
| Untagged_int -> layout_int
| Unboxed_vector v -> layout_boxed_vector v
| Unboxed_float -> layout_boxed_float
| Unboxed_integer bi -> layout_boxedint bi
| Same_as_ocaml_repr s ->
begin match s with
| Value -> layout_any_value
| Float64 -> layout_unboxed_float
| Void -> assert false
end

let primitive_result_layout (p : primitive) =
match p with
| Popaque layout | Pobj_magic layout -> layout
Expand All @@ -1504,17 +1516,7 @@ let primitive_result_layout (p : primitive) =
| Paddfloat _ | Psubfloat _ | Pmulfloat _ | Pdivfloat _
| Pbox_float _ -> layout_boxed_float
| Punbox_float -> Punboxed_float
| Pccall { prim_native_repr_res = _, Untagged_int; _} -> layout_int
| Pccall { prim_native_repr_res = _, Unboxed_vector v; _} -> layout_boxed_vector v
| Pccall { prim_native_repr_res = _, Unboxed_float; _} -> layout_boxed_float
| Pccall { prim_native_repr_res = _, Same_as_ocaml_repr s; _} ->
begin match s with
| Value -> layout_any_value
| Float64 -> layout_unboxed_float
| Void -> assert false
end
| Pccall { prim_native_repr_res = _, Unboxed_integer bi; _} ->
layout_boxedint bi
| Pccall { prim_native_repr_res = _, repr_res } -> layout_of_native_repr repr_res
| Praise _ -> layout_bottom
| Psequor | Psequand | Pnot
| Pnegint | Paddint | Psubint | Pmulint
Expand Down
8 changes: 8 additions & 0 deletions ocaml/lambda/lambda.mli
Original file line number Diff line number Diff line change
Expand Up @@ -309,6 +309,14 @@ val equal_boxed_vector_size : boxed_vector -> boxed_vector -> bool

val must_be_value : layout -> value_kind

(* This is the layout of ocaml values used as arguments to or returned from
primitives for this [native_repr]. So the legacy [Unboxed_float] - which is
a float that is unboxed before being passed to a C function - is mapped to
[layout_any_value], while [Same_as_ocaml_repr Float64] is mapped to
[layout_unboxed_float].
*)
val layout_of_native_repr : Primitive.native_repr -> layout

type structured_constant =
Const_base of constant
| Const_block of int * structured_constant list
Expand Down
2 changes: 2 additions & 0 deletions ocaml/middle_end/clambda_primitives.ml
Original file line number Diff line number Diff line change
Expand Up @@ -211,4 +211,6 @@ let result_layout (p : primitive) =
match p with
| Punbox_float -> Lambda.Punboxed_float
| Punbox_int bi -> Lambda.Punboxed_int bi
| Pccall {prim_native_repr_res = (_, repr_res); _} ->
Lambda.layout_of_native_repr repr_res
| _ -> Lambda.layout_any_value
5 changes: 5 additions & 0 deletions ocaml/testsuite/tests/typing-layouts-float64/c_api.ml
Original file line number Diff line number Diff line change
Expand Up @@ -59,4 +59,9 @@ let sum_of_one_to_seven =
in
print_floatu "Function with many args, sum_of_one_to_seven" f

(* Non-inlined eta expansion *)
let[@inline never] sin_U_U' x = sin_U_U x

let sin_seven =
let f = sin_U_U' (of_float 7.) in
print_floatu "Test U -> U eta expansion, sin seven" f
Original file line number Diff line number Diff line change
Expand Up @@ -4,3 +4,4 @@ Test U -> B, sin four: -0.76
Test (B[@unboxed]) -> U, sin five: -0.96
Test U -> (B[@unboxed]), sin six: -0.28
Function with many args, sum_of_one_to_seven: 28.00
Test U -> U eta expansion, sin seven: 0.66