Skip to content

Update Clambda_primitives.result_layout #2014

New issue

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

#

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

Already on GitHub? # to your account

Merged
merged 3 commits into from
Nov 9, 2023
Merged

Update Clambda_primitives.result_layout #2014

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
d66a132
update Clambda_primitives.result_layout
alanechang Nov 8, 2023
d2c9e8d
add test
alanechang Nov 8, 2023
dc8ade5
fix upstream closure
alanechang Nov 8, 2023
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
95 changes: 68 additions & 27 deletions middle_end/clambda_primitives.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -227,31 +227,72 @@ let equal (x: primitive) (y: primitive) = x = y

let result_layout (p : primitive) =
match p with
| Punbox_float -> Lambda.Punboxed_float
| Punbox_int bi -> Lambda.Punboxed_int bi
| Pmake_unboxed_product layouts -> Lambda.Punboxed_product layouts
| Punboxed_product_field (field, layouts) -> List.nth layouts field
| Pccall {prim_native_repr_res = (_, repr_res); _} ->
Lambda.layout_of_native_repr repr_res
| Pufloatfield _ -> Lambda.Punboxed_float
| Pread_symbol _ | Pmakeblock _ | Pmakeufloatblock _ | Pfield _
| Pfield_computed | Psetfield _ | Psetfield_computed _ | Pfloatfield _
| Psetfloatfield _ | Psetufloatfield _ | Pduprecord _ | Praise _
| Psequand | Psequor | Pnot | Pnegint | Paddint | Psubint | Pmulint
| Pdivint _ | Pmodint _ | Pandint | Porint | Pxorint | Plslint | Plsrint
| Pasrint | Pintcomp _ | Pcompare_ints | Pcompare_floats | Pcompare_bints _
| Poffsetint _ | Poffsetref _ | Pintoffloat | Pfloatofint _ | Pnegfloat _
| Pabsfloat _ | Paddfloat _ | Psubfloat _ | Pmulfloat _ | Pdivfloat _
| Pfloatcomp _ | Pstringlength | Pstringrefu | Pstringrefs
| Pbyteslength | Pbytesrefu | Pbytessetu | Pbytesrefs | Pbytessets
| Pmakearray _ | Pduparray _ | Parraylength _ | Parrayrefu _ | Parraysetu _
| Parrayrefs _ | Parraysets _ | Pisint | Pisout | Pbintofint _ | Pintofbint _
| Pcvtbint _ | Pnegbint _ | Paddbint _ | Psubbint _ | Pmulbint _ | Pdivbint _
| Pmodbint _ | Pandbint _ | Porbint _ | Pxorbint _ | Plslbint _ | Plsrbint _
| Pasrbint _ | Pbintcomp _ | Pbigarrayref _ | Pbigarrayset _ | Pbigarraydim _
| Psetfield _ | Psetfield_computed _ | Psetfloatfield _ | Poffsetref _
| Psetufloatfield _
| Pbytessetu | Pbytessets | Parraysetu _ | Parraysets _ | Pbigarrayset _
-> Lambda.layout_unit
| Pmakeblock _ | Pmakearray _ | Pduprecord _
| Pmakeufloatblock _
| Pduparray _ | Pbigarraydim _ -> Lambda.layout_block
| Pfield _ | Pfield_computed -> Lambda.layout_field
| Punboxed_product_field (field, layouts) -> (Array.of_list layouts).(field)
| Pmake_unboxed_product layouts -> Lambda.layout_unboxed_product layouts
| Pfloatfield _ | Pfloatofint _ | Pnegfloat _ | Pabsfloat _
| Paddfloat _ | Psubfloat _ | Pmulfloat _ | Pdivfloat _
| Pbox_float _ -> Lambda.layout_boxed_float
| Pufloatfield _ | Punbox_float -> Punboxed_float
| Pccall { prim_native_repr_res = _, repr_res } -> Lambda.layout_of_native_repr repr_res
| Praise _ -> Lambda.layout_bottom
| Psequor | Psequand | Pnot
| Pnegint | Paddint | Psubint | Pmulint
| Pdivint _ | Pmodint _
| Pandint | Porint | Pxorint
| Plslint | Plsrint | Pasrint
| Pintcomp _
| Pcompare_ints | Pcompare_floats | Pcompare_bints _
| Poffsetint _ | Pintoffloat | Pfloatcomp _
| Pstringlength | Pstringrefu | Pstringrefs
| Pbyteslength | Pbytesrefu | Pbytesrefs
| Parraylength _ | Pisint | Pisout | Pintofbint _
| Pbintcomp _
| Pprobe_is_enabled _ | Pbswap16
-> Lambda.layout_int
| Parrayrefu array_ref_kind | Parrayrefs array_ref_kind ->
Lambda.array_ref_kind_result_layout array_ref_kind
| Pbintofint (bi, _) | Pcvtbint (_,bi,_)
| Pnegbint (bi, _) | Paddbint (bi, _) | Psubbint (bi, _)
| Pmulbint (bi, _) | Pdivbint {size = bi} | Pmodbint {size = bi}
| Pandbint (bi, _) | Porbint (bi, _) | Pxorbint (bi, _)
| Plslbint (bi, _) | Plsrbint (bi, _) | Pasrbint (bi, _)
| Pbbswap (bi, _) | Pbox_int (bi, _) ->
Lambda.layout_boxedint bi
| Punbox_int bi -> Punboxed_int bi
| Pbigarrayref (_, _, kind, _) ->
begin match kind with
| Pbigarray_unknown -> Lambda.layout_any_value
| Pbigarray_float32 | Pbigarray_float64 -> Lambda.layout_boxed_float
| Pbigarray_sint8 | Pbigarray_uint8
| Pbigarray_sint16 | Pbigarray_uint16
| Pbigarray_caml_int -> Lambda.layout_int
| Pbigarray_int32 -> Lambda.layout_boxedint Pint32
| Pbigarray_int64 -> Lambda.layout_boxedint Pint64
| Pbigarray_native_int -> Lambda.layout_boxedint Pnativeint
| Pbigarray_complex32 | Pbigarray_complex64 ->
Lambda.layout_block
end
| Pint_as_pointer _ ->
(* CR ncourant: use an unboxed int64 here when it exists *)
Lambda.layout_any_value
| Pget_header _ -> Lambda.layout_boxedint Pnativeint
| Prunstack | Presume | Pperform | Preperform ->
(* CR mshinwell/ncourant: to be thought about later *)
Misc.fatal_error "Effects-related primitives are not yet supported"
| Patomic_load { immediate_or_pointer = Immediate } -> Lambda.layout_int
| Patomic_load { immediate_or_pointer = Pointer } -> Lambda.layout_any_value
| Patomic_exchange
| Patomic_cas
| Patomic_fetch_add
| Pdls_get
| Popaque | Pread_symbol _
| Pstring_load _ | Pbytes_load _ | Pbytes_set _ | Pbigstring_load _
| Pbigstring_set _ | Pbswap16 | Pbbswap _ | Pint_as_pointer _ | Popaque
| Pprobe_is_enabled _ | Pbox_float _ | Pbox_int _ | Pget_header _
| Prunstack | Pperform | Presume | Preperform | Patomic_exchange
| Patomic_cas | Patomic_fetch_add | Pdls_get | Patomic_load _
-> Lambda.layout_any_value
| Pbigstring_set _ -> Lambda.layout_any_value
91 changes: 66 additions & 25 deletions ocaml/middle_end/clambda_primitives.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -225,29 +225,70 @@ let equal (x: primitive) (y: primitive) = x = y

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
| Pufloatfield _ -> Lambda.Punboxed_float
| Pread_symbol _ | Pmakeblock _ | Pmakeufloatblock _ | Pfield _
| Pfield_computed | Psetfield _ | Psetfield_computed _ | Pfloatfield _
| Psetfloatfield _ | Psetufloatfield _ | Pduprecord _ | Praise _
| Psequand | Psequor | Pnot | Pnegint | Paddint | Psubint | Pmulint
| Pdivint _ | Pmodint _ | Pandint | Porint | Pxorint | Plslint | Plsrint
| Pasrint | Pintcomp _ | Pcompare_ints | Pcompare_floats | Pcompare_bints _
| Poffsetint _ | Poffsetref _ | Pintoffloat | Pfloatofint _ | Pnegfloat _
| Pabsfloat _ | Paddfloat _ | Psubfloat _ | Pmulfloat _ | Pdivfloat _
| Pfloatcomp _ | Pstringlength | Pstringrefu | Pstringrefs
| Pbyteslength | Pbytesrefu | Pbytessetu | Pbytesrefs | Pbytessets
| Pmakearray _ | Pduparray _ | Parraylength _ | Parrayrefu _ | Parraysetu _
| Parrayrefs _ | Parraysets _ | Pisint | Pisout | Pbintofint _ | Pintofbint _
| Pcvtbint _ | Pnegbint _ | Paddbint _ | Psubbint _ | Pmulbint _ | Pdivbint _
| Pmodbint _ | Pandbint _ | Porbint _ | Pxorbint _ | Plslbint _ | Plsrbint _
| Pasrbint _ | Pbintcomp _ | Pbigarrayref _ | Pbigarrayset _ | Pbigarraydim _
| Psetfield _ | Psetfield_computed _ | Psetfloatfield _ | Poffsetref _
| Psetufloatfield _
| Pbytessetu | Pbytessets | Parraysetu _ | Parraysets _ | Pbigarrayset _
-> Lambda.layout_unit
| Pmakeblock _ | Pmakearray _ | Pduprecord _
| Pmakeufloatblock _
| Pduparray _ | Pbigarraydim _ -> Lambda.layout_block
| Pfield _ | Pfield_computed -> Lambda.layout_field
| Pfloatfield _ | Pfloatofint _ | Pnegfloat _ | Pabsfloat _
| Paddfloat _ | Psubfloat _ | Pmulfloat _ | Pdivfloat _
| Pbox_float _ -> Lambda.layout_boxed_float
| Pufloatfield _ | Punbox_float -> Punboxed_float
| Pccall { prim_native_repr_res = _, repr_res } -> Lambda.layout_of_native_repr repr_res
| Praise _ -> Lambda.layout_bottom
| Psequor | Psequand | Pnot
| Pnegint | Paddint | Psubint | Pmulint
| Pdivint _ | Pmodint _
| Pandint | Porint | Pxorint
| Plslint | Plsrint | Pasrint
| Pintcomp _
| Pcompare_ints | Pcompare_floats | Pcompare_bints _
| Poffsetint _ | Pintoffloat | Pfloatcomp _
| Pstringlength | Pstringrefu | Pstringrefs
| Pbyteslength | Pbytesrefu | Pbytesrefs
| Parraylength _ | Pisint | Pisout | Pintofbint _
| Pbintcomp _
| Pprobe_is_enabled _ | Pbswap16
-> Lambda.layout_int
| Parrayrefu array_ref_kind | Parrayrefs array_ref_kind ->
Lambda.array_ref_kind_result_layout array_ref_kind
| Pbintofint (bi, _) | Pcvtbint (_,bi,_)
| Pnegbint (bi, _) | Paddbint (bi, _) | Psubbint (bi, _)
| Pmulbint (bi, _) | Pdivbint {size = bi} | Pmodbint {size = bi}
| Pandbint (bi, _) | Porbint (bi, _) | Pxorbint (bi, _)
| Plslbint (bi, _) | Plsrbint (bi, _) | Pasrbint (bi, _)
| Pbbswap (bi, _) | Pbox_int (bi, _) ->
Lambda.layout_boxedint bi
| Punbox_int bi -> Punboxed_int bi
| Pbigarrayref (_, _, kind, _) ->
begin match kind with
| Pbigarray_unknown -> Lambda.layout_any_value
| Pbigarray_float32 | Pbigarray_float64 -> Lambda.layout_boxed_float
| Pbigarray_sint8 | Pbigarray_uint8
| Pbigarray_sint16 | Pbigarray_uint16
| Pbigarray_caml_int -> Lambda.layout_int
| Pbigarray_int32 -> Lambda.layout_boxedint Pint32
| Pbigarray_int64 -> Lambda.layout_boxedint Pint64
| Pbigarray_native_int -> Lambda.layout_boxedint Pnativeint
| Pbigarray_complex32 | Pbigarray_complex64 ->
Lambda.layout_block
end
| Pint_as_pointer _ ->
(* CR ncourant: use an unboxed int64 here when it exists *)
Lambda.layout_any_value
| Pget_header _ -> Lambda.layout_boxedint Pnativeint
| Prunstack | Presume | Pperform | Preperform ->
(* CR mshinwell/ncourant: to be thought about later *)
Misc.fatal_error "Effects-related primitives are not yet supported"
| Patomic_load { immediate_or_pointer = Immediate } -> Lambda.layout_int
| Patomic_load { immediate_or_pointer = Pointer } -> Lambda.layout_any_value
| Patomic_exchange
| Patomic_cas
| Patomic_fetch_add
| Pdls_get
| Popaque | Pread_symbol _
| Pstring_load _ | Pbytes_load _ | Pbytes_set _ | Pbigstring_load _
| Pbigstring_set _ | Pbswap16 | Pbbswap _ | Pint_as_pointer _ | Popaque
| Pprobe_is_enabled _ | Pbox_float _ | Pbox_int _ | Pget_header _
| Prunstack | Pperform | Presume | Preperform | Patomic_exchange
| Patomic_cas | Patomic_fetch_add | Pdls_get | Patomic_load _
-> Lambda.layout_any_value
| Pbigstring_set _ -> Lambda.layout_any_value
29 changes: 18 additions & 11 deletions ocaml/testsuite/tests/typing-layouts-float64/unboxed_floats.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,23 +1,22 @@
(* TEST
reference = "${test_source_directory}/unboxed_floats.reference"
* flambda2
** native
* native
flags = "-extension layouts_alpha"
** bytecode
* bytecode
flags = "-extension layouts_alpha"
** native
* native
flags = "-extension layouts_beta"
** bytecode
* bytecode
flags = "-extension layouts_beta"
** native
* native
flags = "-extension layouts"
** bytecode
* bytecode
flags = "-extension layouts"
** setup-ocamlc.byte-build-env
* setup-ocamlc.byte-build-env
ocamlc_byte_exit_status = "2"
*** ocamlc.byte
** ocamlc.byte
compiler_reference = "${test_source_directory}/unboxed_floats_disabled.compilers.reference"
**** check-ocamlc.byte-output
*** check-ocamlc.byte-output


*)
Expand Down Expand Up @@ -484,4 +483,12 @@ let rb' = { xb = 3.14; yb = 42.1 }
let _ =
Printf.printf "Test 11, heterogeneous polymorphic equality.\n";
Printf.printf " equal: %b\n" (Ex ru = Ex rb);
Printf.printf " unequal: %b\n" (Ex ru = Ex rb');
Printf.printf " unequal: %b\n" (Ex ru = Ex rb')

(*************************************************)
(* Test 12: If-then-else with float64 and assert *)

let _ =
let a = if Sys.opaque_identity true then Float_u.of_int 1 else assert false in
Printf.printf "Test 12, If-then-else with assert and float64.\n";
print_floatu " result (1.00)" a
2 changes: 2 additions & 0 deletions ocaml/testsuite/tests/typing-layouts-float64/unboxed_floats.reference
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -147,3 +147,5 @@ Test 10, float# records in recursive groups.
Test 11, heterogeneous polymorphic equality.
equal: true
unequal: false
Test 12, If-then-else with assert and float64.
result (1.00): 1.00
4 changes: 2 additions & 2 deletions ocaml/testsuite/tests/typing-layouts-float64/unboxed_floats_disabled.compilers.reference
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
File "unboxed_floats.ml", line 326, characters 25-31:
326 | let ( let* ) x (f : _ -> float#) = f x
File "unboxed_floats.ml", line 325, characters 25-31:
325 | let ( let* ) x (f : _ -> float#) = f x
^^^^^^
Error: This construct requires the stable version of the extension "layouts", which is disabled and cannot be used