Skip to content

Add boxed_float variant to all float operations #1900

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.

Sign up for GitHub

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

Merged
merged 3 commits into from
Feb 12, 2024
Merged

Add boxed_float variant to all float operations #1900

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
4769d5a
squash for review
TheNumbat Jan 25, 2024
feff87b
merge
TheNumbat Feb 12, 2024
9a68af3
bootstrap
TheNumbat Feb 12, 2024
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
11 changes: 6 additions & 5 deletions backend/cmm_helpers.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1252,7 +1252,7 @@ module Extended_machtype = struct
| Ptop -> Misc.fatal_error "No Extended_machtype for layout [Ptop]"
| Pbottom ->
Misc.fatal_error "No unique Extended_machtype for layout [Pbottom]"
| Punboxed_float -> typ_float
| Punboxed_float Pfloat64 -> typ_float
| Punboxed_vector (Pvec128 _) -> typ_vec128
| Punboxed_int _ ->
(* Only 64-bit architectures, so this is always [typ_int] *)
Expand Down Expand Up @@ -2828,7 +2828,7 @@ let arraylength kind arg dbg =
Cop (Cor, [len; Cconst_int (1, dbg)], dbg)
| Paddrarray | Pintarray ->
Cop (Cor, [addr_array_length_shifted hdr dbg; Cconst_int (1, dbg)], dbg)
| Pfloatarray | Punboxedfloatarray ->
| Pfloatarray | Punboxedfloatarray Pfloat64 ->
(* Note: we only support 64 bit targets now, so this is ok for
Punboxedfloatarray *)
Cop (Cor, [float_array_length_shifted hdr dbg; Cconst_int (1, dbg)], dbg)
Expand Down Expand Up @@ -3615,12 +3615,13 @@ let transl_attrib : Lambda.check_attribute -> Cmm.codegen_option list = function

let kind_of_layout (layout : Lambda.layout) =
match layout with
| Pvalue Pfloatval -> Boxed_float
| Pvalue (Pboxedfloatval Pfloat64) -> Boxed_float
| Pvalue (Pboxedintval bi) -> Boxed_integer bi
| Pvalue (Pboxedvectorval vi) -> Boxed_vector vi
| Pvalue (Pgenval | Pintval | Pvariant _ | Parrayval _)
| Ptop | Pbottom | Punboxed_float | Punboxed_int _ | Punboxed_vector _
| Punboxed_product _ ->
| Ptop | Pbottom
| Punboxed_float Pfloat64
| Punboxed_int _ | Punboxed_vector _ | Punboxed_product _ ->
Any

(* Atomics *)
Expand Down
65 changes: 38 additions & 27 deletions middle_end/flambda2/from_lambda/closure_conversion.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -503,7 +503,7 @@ let close_c_call acc env ~loc ~let_bound_ids_with_kinds
let box_return_value =
match prim_native_repr_res with
| _, Same_as_ocaml_repr _ -> None
| _, Unboxed_float -> Some (P.Box_number (Naked_float, alloc_mode))
| _, Unboxed_float Pfloat64 -> Some (P.Box_number (Naked_float, alloc_mode))
| _, Unboxed_integer Pnativeint ->
Some (P.Box_number (Naked_nativeint, alloc_mode))
| _, Unboxed_integer Pint32 -> Some (P.Box_number (Naked_int32, alloc_mode))
Expand Down Expand Up @@ -531,7 +531,7 @@ let close_c_call acc env ~loc ~let_bound_ids_with_kinds
kind
(from_lambda_values_and_unboxed_numbers_only
(Typeopt.layout_of_const_sort sort)))
| Unboxed_float -> K.naked_float
| Unboxed_float Pfloat64 -> K.naked_float
| Unboxed_integer Pnativeint -> K.naked_nativeint
| Unboxed_integer Pint32 -> K.naked_int32
| Unboxed_integer Pint64 -> K.naked_int64
Expand Down Expand Up @@ -577,7 +577,7 @@ let close_c_call acc env ~loc ~let_bound_ids_with_kinds
then Misc.fatal_errorf "Expected arity one for %s" prim_native_name
else
match prim_native_repr_args, prim_native_repr_res with
| [(_, Unboxed_integer Pint64)], (_, Unboxed_float) -> (
| [(_, Unboxed_integer Pint64)], (_, Unboxed_float Pfloat64) -> (
match args with
| [arg] ->
let result = Variable.create "reinterpreted_int64" in
Expand Down Expand Up @@ -620,7 +620,7 @@ let close_c_call acc env ~loc ~let_bound_ids_with_kinds
let unbox_arg : P.unary_primitive option =
match arg_repr with
| _, Same_as_ocaml_repr _ -> None
| _, Unboxed_float -> Some (P.Unbox_number Naked_float)
| _, Unboxed_float Pfloat64 -> Some (P.Unbox_number Naked_float)
| _, Unboxed_integer Pnativeint ->
Some (P.Unbox_number Naked_nativeint)
| _, Unboxed_integer Pint32 -> Some (P.Unbox_number Naked_int32)
Expand Down Expand Up @@ -808,29 +808,40 @@ let close_primitive acc env ~let_bound_ids_with_kinds named
| Pufloatfield _ | Psetufloatfield _ | 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 _
| Punboxed_float_comp _ | Pstringlength | Pstringrefu | Pstringrefs
| Pbyteslength | Pbytesrefu | Pbytessetu | Pbytesrefs | Pbytessets
| Pduparray _ | Parraylength _ | Parrayrefu _ | Parraysetu _
| Parrayrefs _ | Parraysets _ | Pisint _ | Pisout | Pbintofint _
| Pintofbint _ | Pcvtbint _ | Pnegbint _ | Paddbint _ | Psubbint _
| Pmulbint _ | Pdivbint _ | Pmodbint _ | Pandbint _ | Porbint _
| Pxorbint _ | Plslbint _ | Plsrbint _ | Pasrbint _ | Pbintcomp _
| Punboxed_int_comp _ | Pbigarrayref _ | Pbigarrayset _ | Pbigarraydim _
| Pstring_load_16 _ | Pstring_load_32 _ | Pstring_load_64 _
| Pstring_load_128 _ | Pbytes_load_16 _ | Pbytes_load_32 _
| Pbytes_load_64 _ | Pbytes_load_128 _ | Pbytes_set_16 _ | Pbytes_set_32 _
| Pbytes_set_64 _ | Pbytes_set_128 _ | Pbigstring_load_16 _
| Pbigstring_load_32 _ | Pbigstring_load_64 _ | Pbigstring_load_128 _
| Pbigstring_set_16 _ | Pbigstring_set_32 _ | Pbigstring_set_64 _
| Pbigstring_set_128 _ | Pctconst _ | Pbswap16 | Pbbswap _
| Pint_as_pointer _ | Popaque _ | Pprobe_is_enabled _ | Pobj_dup
| Pobj_magic _ | Punbox_float | Pbox_float _ | Punbox_int _ | Pbox_int _
| Pmake_unboxed_product _ | Punboxed_product_field _ | Pget_header _
| Prunstack | Pperform | Presume | Preperform | Patomic_exchange
| Patomic_cas | Patomic_fetch_add | Pdls_get | Patomic_load _ ->
| Pcompare_floats Pfloat64
| Pcompare_bints _ | Poffsetint _ | Poffsetref _
| Pintoffloat Pfloat64
| Pfloatofint (Pfloat64, _)
| Pnegfloat (Pfloat64, _)
| Pabsfloat (Pfloat64, _)
| Paddfloat (Pfloat64, _)
| Psubfloat (Pfloat64, _)
| Pmulfloat (Pfloat64, _)
| Pdivfloat (Pfloat64, _)
| Pfloatcomp (Pfloat64, _)
| Punboxed_float_comp (Pfloat64, _)
| Pstringlength | Pstringrefu | Pstringrefs | Pbyteslength | Pbytesrefu
| Pbytessetu | Pbytesrefs | Pbytessets | Pduparray _ | Parraylength _
| Parrayrefu _ | Parraysetu _ | Parrayrefs _ | Parraysets _ | Pisint _
| Pisout | Pbintofint _ | Pintofbint _ | Pcvtbint _ | Pnegbint _
| Paddbint _ | Psubbint _ | Pmulbint _ | Pdivbint _ | Pmodbint _
| Pandbint _ | Porbint _ | Pxorbint _ | Plslbint _ | Plsrbint _
| Pasrbint _ | Pbintcomp _ | Punboxed_int_comp _ | Pbigarrayref _
| Pbigarrayset _ | Pbigarraydim _ | Pstring_load_16 _ | Pstring_load_32 _
| Pstring_load_64 _ | Pstring_load_128 _ | Pbytes_load_16 _
| Pbytes_load_32 _ | Pbytes_load_64 _ | Pbytes_load_128 _
| Pbytes_set_16 _ | Pbytes_set_32 _ | Pbytes_set_64 _ | Pbytes_set_128 _
| Pbigstring_load_16 _ | Pbigstring_load_32 _ | Pbigstring_load_64 _
| Pbigstring_load_128 _ | Pbigstring_set_16 _ | Pbigstring_set_32 _
| Pbigstring_set_64 _ | Pbigstring_set_128 _ | Pctconst _ | Pbswap16
| Pbbswap _ | Pint_as_pointer _ | Popaque _ | Pprobe_is_enabled _
| Pobj_dup | Pobj_magic _
| Punbox_float Pfloat64
| Pbox_float (Pfloat64, _)
| Punbox_int _ | Pbox_int _ | Pmake_unboxed_product _
| Punboxed_product_field _ | Pget_header _ | Prunstack | Pperform
| Presume | Preperform | Patomic_exchange | Patomic_cas
| Patomic_fetch_add | Pdls_get | Patomic_load _ ->
(* Inconsistent with outer match *)
assert false
in
Expand Down
74 changes: 46 additions & 28 deletions middle_end/flambda2/from_lambda/lambda_to_flambda.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -272,22 +272,26 @@ let transform_primitive env (prim : L.primitive) args loc =
Misc.fatal_errorf "Pmakeblock with wrong or non-scannable block tag %d" tag
| Pmakefloatblock (_mut, _mode), args when List.length args < 1 ->
Misc.fatal_errorf "Pmakefloatblock must have at least one argument"
| Pfloatcomp CFnlt, args ->
Primitive (L.Pnot, [L.Lprim (Pfloatcomp CFlt, args, loc)], loc)
| Pfloatcomp CFngt, args ->
Primitive (L.Pnot, [L.Lprim (Pfloatcomp CFgt, args, loc)], loc)
| Pfloatcomp CFnle, args ->
Primitive (L.Pnot, [L.Lprim (Pfloatcomp CFle, args, loc)], loc)
| Pfloatcomp CFnge, args ->
Primitive (L.Pnot, [L.Lprim (Pfloatcomp CFge, args, loc)], loc)
| Punboxed_float_comp CFnlt, args ->
Primitive (L.Pnot, [L.Lprim (Punboxed_float_comp CFlt, args, loc)], loc)
| Punboxed_float_comp CFngt, args ->
Primitive (L.Pnot, [L.Lprim (Punboxed_float_comp CFgt, args, loc)], loc)
| Punboxed_float_comp CFnle, args ->
Primitive (L.Pnot, [L.Lprim (Punboxed_float_comp CFle, args, loc)], loc)
| Punboxed_float_comp CFnge, args ->
Primitive (L.Pnot, [L.Lprim (Punboxed_float_comp CFge, args, loc)], loc)
| Pfloatcomp (bf, CFnlt), args ->
Primitive (L.Pnot, [L.Lprim (Pfloatcomp (bf, CFlt), args, loc)], loc)
| Pfloatcomp (bf, CFngt), args ->
Primitive (L.Pnot, [L.Lprim (Pfloatcomp (bf, CFgt), args, loc)], loc)
| Pfloatcomp (bf, CFnle), args ->
Primitive (L.Pnot, [L.Lprim (Pfloatcomp (bf, CFle), args, loc)], loc)
| Pfloatcomp (bf, CFnge), args ->
Primitive (L.Pnot, [L.Lprim (Pfloatcomp (bf, CFge), args, loc)], loc)
| Punboxed_float_comp (bf, CFnlt), args ->
Primitive
(L.Pnot, [L.Lprim (Punboxed_float_comp (bf, CFlt), args, loc)], loc)
| Punboxed_float_comp (bf, CFngt), args ->
Primitive
(L.Pnot, [L.Lprim (Punboxed_float_comp (bf, CFgt), args, loc)], loc)
| Punboxed_float_comp (bf, CFnle), args ->
Primitive
(L.Pnot, [L.Lprim (Punboxed_float_comp (bf, CFle), args, loc)], loc)
| Punboxed_float_comp (bf, CFnge), args ->
Primitive
(L.Pnot, [L.Lprim (Punboxed_float_comp (bf, CFge), args, loc)], loc)
| Pbigarrayref (_unsafe, num_dimensions, kind, layout), args -> (
match
P.Bigarray_kind.from_lambda kind, P.Bigarray_layout.from_lambda layout
Expand Down Expand Up @@ -605,14 +609,23 @@ let primitive_can_raise (prim : Lambda.primitive) =
| Psetfield_computed _ | Pfloatfield _ | Psetfloatfield _ | Pduprecord _
| Pmakeufloatblock _ | Pufloatfield _ | Psetufloatfield _ | Psequand | Psequor
| Pnot | Pnegint | Paddint | Psubint | Pmulint | Pandint | Porint | Pxorint
| Plslint | Plsrint | Pasrint | Pintcomp _ | Pcompare_ints | Pcompare_floats
| Pcompare_bints _ | Poffsetint _ | Poffsetref _ | Pintoffloat | Pfloatofint _
| Pnegfloat _ | Pabsfloat _ | Paddfloat _ | Psubfloat _ | Pmulfloat _
| Pdivfloat _ | Pfloatcomp _ | Punboxed_float_comp _ | Pstringlength
| Pstringrefu | Pbyteslength | Pbytesrefu | Pbytessetu | Pmakearray _
| Pduparray _ | Parraylength _ | Parrayrefu _ | Parraysetu _ | Pisint _
| Pisout | Pbintofint _ | Pintofbint _ | Pcvtbint _ | Pnegbint _ | Paddbint _
| Psubbint _ | Pmulbint _
| Plslint | Plsrint | Pasrint | Pintcomp _ | Pcompare_ints
| Pcompare_floats Pfloat64
| Pcompare_bints _ | Poffsetint _ | Poffsetref _
| Pintoffloat Pfloat64
| Pfloatofint (Pfloat64, _)
| Pnegfloat (Pfloat64, _)
| Pabsfloat (Pfloat64, _)
| Paddfloat (Pfloat64, _)
| Psubfloat (Pfloat64, _)
| Pmulfloat (Pfloat64, _)
| Pdivfloat (Pfloat64, _)
| Pfloatcomp (Pfloat64, _)
| Punboxed_float_comp (Pfloat64, _)
| Pstringlength | Pstringrefu | Pbyteslength | Pbytesrefu | Pbytessetu
| Pmakearray _ | Pduparray _ | Parraylength _ | Parrayrefu _ | Parraysetu _
| Pisint _ | Pisout | Pbintofint _ | Pintofbint _ | Pcvtbint _ | Pnegbint _
| Paddbint _ | Psubbint _ | Pmulbint _
| Pdivbint { is_safe = Unsafe; _ }
| Pmodbint { is_safe = Unsafe; _ }
| Pandbint _ | Porbint _ | Pxorbint _ | Plslbint _ | Plsrbint _ | Pasrbint _
Expand Down Expand Up @@ -654,7 +667,9 @@ let primitive_can_raise (prim : Lambda.primitive) =
| Pbigstring_set_64 true
| Pbigstring_set_128 { unsafe = true; _ }
| Pctconst _ | Pbswap16 | Pbbswap _ | Pint_as_pointer _ | Popaque _
| Pprobe_is_enabled _ | Pobj_dup | Pobj_magic _ | Pbox_float _ | Punbox_float
| Pprobe_is_enabled _ | Pobj_dup | Pobj_magic _
| Pbox_float (Pfloat64, _)
| Punbox_float Pfloat64
| Punbox_int _ | Pbox_int _ | Pmake_unboxed_product _
| Punboxed_product_field _ | Pget_header _ ->
false
Expand Down Expand Up @@ -848,7 +863,9 @@ let rec cps acc env ccenv (lam : L.lambda) (k : cps_continuation)
match layout with
| Ptop | Pbottom ->
Misc.fatal_error "Cannot bind layout [Ptop] or [Pbottom]"
| Pvalue _ | Punboxed_int _ | Punboxed_float | Punboxed_vector _ ->
| Pvalue _ | Punboxed_int _
| Punboxed_float Pfloat64
| Punboxed_vector _ ->
( env,
[ ( id,
Flambda_kind.With_subkind
Expand Down Expand Up @@ -971,8 +988,9 @@ let rec cps acc env ccenv (lam : L.lambda) (k : cps_continuation)
let id = Ident.create_local name in
let result_layout = L.primitive_result_layout prim in
(match result_layout with
| Pvalue _ | Punboxed_float | Punboxed_int _ | Punboxed_vector _
| Punboxed_product _ ->
| Pvalue _
| Punboxed_float Pfloat64
| Punboxed_int _ | Punboxed_vector _ | Punboxed_product _ ->
()
| Ptop | Pbottom ->
Misc.fatal_errorf "Invalid result layout %a for primitive %a"
Expand Down
Loading