Skip to content

Commit 4c1213d

Browse files
alanechangalanechang
authored
Update Clambda_primitives.result_layout (#2014)
1 parent 0ffd18e commit 4c1213d

File tree

5 files changed

+156
-65
lines changed

5 files changed

+156
-65
lines changed

‎middle_end/clambda_primitives.ml

+68-27
Original file line numberDiff line numberDiff line change
@@ -227,31 +227,72 @@ let equal (x: primitive) (y: primitive) = x = y
227227

228228
let result_layout (p : primitive) =
229229
match p with
230-
| Punbox_float -> Lambda.Punboxed_float
231-
| Punbox_int bi -> Lambda.Punboxed_int bi
232-
| Pmake_unboxed_product layouts -> Lambda.Punboxed_product layouts
233-
| Punboxed_product_field (field, layouts) -> List.nth layouts field
234-
| Pccall {prim_native_repr_res = (_, repr_res); _} ->
235-
Lambda.layout_of_native_repr repr_res
236-
| Pufloatfield _ -> Lambda.Punboxed_float
237-
| Pread_symbol _ | Pmakeblock _ | Pmakeufloatblock _ | Pfield _
238-
| Pfield_computed | Psetfield _ | Psetfield_computed _ | Pfloatfield _
239-
| Psetfloatfield _ | Psetufloatfield _ | Pduprecord _ | Praise _
240-
| Psequand | Psequor | Pnot | Pnegint | Paddint | Psubint | Pmulint
241-
| Pdivint _ | Pmodint _ | Pandint | Porint | Pxorint | Plslint | Plsrint
242-
| Pasrint | Pintcomp _ | Pcompare_ints | Pcompare_floats | Pcompare_bints _
243-
| Poffsetint _ | Poffsetref _ | Pintoffloat | Pfloatofint _ | Pnegfloat _
244-
| Pabsfloat _ | Paddfloat _ | Psubfloat _ | Pmulfloat _ | Pdivfloat _
245-
| Pfloatcomp _ | Pstringlength | Pstringrefu | Pstringrefs
246-
| Pbyteslength | Pbytesrefu | Pbytessetu | Pbytesrefs | Pbytessets
247-
| Pmakearray _ | Pduparray _ | Parraylength _ | Parrayrefu _ | Parraysetu _
248-
| Parrayrefs _ | Parraysets _ | Pisint | Pisout | Pbintofint _ | Pintofbint _
249-
| Pcvtbint _ | Pnegbint _ | Paddbint _ | Psubbint _ | Pmulbint _ | Pdivbint _
250-
| Pmodbint _ | Pandbint _ | Porbint _ | Pxorbint _ | Plslbint _ | Plsrbint _
251-
| Pasrbint _ | Pbintcomp _ | Pbigarrayref _ | Pbigarrayset _ | Pbigarraydim _
230+
| Psetfield _ | Psetfield_computed _ | Psetfloatfield _ | Poffsetref _
231+
| Psetufloatfield _
232+
| Pbytessetu | Pbytessets | Parraysetu _ | Parraysets _ | Pbigarrayset _
233+
-> Lambda.layout_unit
234+
| Pmakeblock _ | Pmakearray _ | Pduprecord _
235+
| Pmakeufloatblock _
236+
| Pduparray _ | Pbigarraydim _ -> Lambda.layout_block
237+
| Pfield _ | Pfield_computed -> Lambda.layout_field
238+
| Punboxed_product_field (field, layouts) -> (Array.of_list layouts).(field)
239+
| Pmake_unboxed_product layouts -> Lambda.layout_unboxed_product layouts
240+
| Pfloatfield _ | Pfloatofint _ | Pnegfloat _ | Pabsfloat _
241+
| Paddfloat _ | Psubfloat _ | Pmulfloat _ | Pdivfloat _
242+
| Pbox_float _ -> Lambda.layout_boxed_float
243+
| Pufloatfield _ | Punbox_float -> Punboxed_float
244+
| Pccall { prim_native_repr_res = _, repr_res } -> Lambda.layout_of_native_repr repr_res
245+
| Praise _ -> Lambda.layout_bottom
246+
| Psequor | Psequand | Pnot
247+
| Pnegint | Paddint | Psubint | Pmulint
248+
| Pdivint _ | Pmodint _
249+
| Pandint | Porint | Pxorint
250+
| Plslint | Plsrint | Pasrint
251+
| Pintcomp _
252+
| Pcompare_ints | Pcompare_floats | Pcompare_bints _
253+
| Poffsetint _ | Pintoffloat | Pfloatcomp _
254+
| Pstringlength | Pstringrefu | Pstringrefs
255+
| Pbyteslength | Pbytesrefu | Pbytesrefs
256+
| Parraylength _ | Pisint | Pisout | Pintofbint _
257+
| Pbintcomp _
258+
| Pprobe_is_enabled _ | Pbswap16
259+
-> Lambda.layout_int
260+
| Parrayrefu array_ref_kind | Parrayrefs array_ref_kind ->
261+
Lambda.array_ref_kind_result_layout array_ref_kind
262+
| Pbintofint (bi, _) | Pcvtbint (_,bi,_)
263+
| Pnegbint (bi, _) | Paddbint (bi, _) | Psubbint (bi, _)
264+
| Pmulbint (bi, _) | Pdivbint {size = bi} | Pmodbint {size = bi}
265+
| Pandbint (bi, _) | Porbint (bi, _) | Pxorbint (bi, _)
266+
| Plslbint (bi, _) | Plsrbint (bi, _) | Pasrbint (bi, _)
267+
| Pbbswap (bi, _) | Pbox_int (bi, _) ->
268+
Lambda.layout_boxedint bi
269+
| Punbox_int bi -> Punboxed_int bi
270+
| Pbigarrayref (_, _, kind, _) ->
271+
begin match kind with
272+
| Pbigarray_unknown -> Lambda.layout_any_value
273+
| Pbigarray_float32 | Pbigarray_float64 -> Lambda.layout_boxed_float
274+
| Pbigarray_sint8 | Pbigarray_uint8
275+
| Pbigarray_sint16 | Pbigarray_uint16
276+
| Pbigarray_caml_int -> Lambda.layout_int
277+
| Pbigarray_int32 -> Lambda.layout_boxedint Pint32
278+
| Pbigarray_int64 -> Lambda.layout_boxedint Pint64
279+
| Pbigarray_native_int -> Lambda.layout_boxedint Pnativeint
280+
| Pbigarray_complex32 | Pbigarray_complex64 ->
281+
Lambda.layout_block
282+
end
283+
| Pint_as_pointer _ ->
284+
(* CR ncourant: use an unboxed int64 here when it exists *)
285+
Lambda.layout_any_value
286+
| Pget_header _ -> Lambda.layout_boxedint Pnativeint
287+
| Prunstack | Presume | Pperform | Preperform ->
288+
(* CR mshinwell/ncourant: to be thought about later *)
289+
Misc.fatal_error "Effects-related primitives are not yet supported"
290+
| Patomic_load { immediate_or_pointer = Immediate } -> Lambda.layout_int
291+
| Patomic_load { immediate_or_pointer = Pointer } -> Lambda.layout_any_value
292+
| Patomic_exchange
293+
| Patomic_cas
294+
| Patomic_fetch_add
295+
| Pdls_get
296+
| Popaque | Pread_symbol _
252297
| Pstring_load _ | Pbytes_load _ | Pbytes_set _ | Pbigstring_load _
253-
| Pbigstring_set _ | Pbswap16 | Pbbswap _ | Pint_as_pointer _ | Popaque
254-
| Pprobe_is_enabled _ | Pbox_float _ | Pbox_int _ | Pget_header _
255-
| Prunstack | Pperform | Presume | Preperform | Patomic_exchange
256-
| Patomic_cas | Patomic_fetch_add | Pdls_get | Patomic_load _
257-
-> Lambda.layout_any_value
298+
| Pbigstring_set _ -> Lambda.layout_any_value

‎ocaml/middle_end/clambda_primitives.ml

+66-25
Original file line numberDiff line numberDiff line change
@@ -225,29 +225,70 @@ let equal (x: primitive) (y: primitive) = x = y
225225

226226
let result_layout (p : primitive) =
227227
match p with
228-
| Punbox_float -> Lambda.Punboxed_float
229-
| Punbox_int bi -> Lambda.Punboxed_int bi
230-
| Pccall {prim_native_repr_res = (_, repr_res); _} ->
231-
Lambda.layout_of_native_repr repr_res
232-
| Pufloatfield _ -> Lambda.Punboxed_float
233-
| Pread_symbol _ | Pmakeblock _ | Pmakeufloatblock _ | Pfield _
234-
| Pfield_computed | Psetfield _ | Psetfield_computed _ | Pfloatfield _
235-
| Psetfloatfield _ | Psetufloatfield _ | Pduprecord _ | Praise _
236-
| Psequand | Psequor | Pnot | Pnegint | Paddint | Psubint | Pmulint
237-
| Pdivint _ | Pmodint _ | Pandint | Porint | Pxorint | Plslint | Plsrint
238-
| Pasrint | Pintcomp _ | Pcompare_ints | Pcompare_floats | Pcompare_bints _
239-
| Poffsetint _ | Poffsetref _ | Pintoffloat | Pfloatofint _ | Pnegfloat _
240-
| Pabsfloat _ | Paddfloat _ | Psubfloat _ | Pmulfloat _ | Pdivfloat _
241-
| Pfloatcomp _ | Pstringlength | Pstringrefu | Pstringrefs
242-
| Pbyteslength | Pbytesrefu | Pbytessetu | Pbytesrefs | Pbytessets
243-
| Pmakearray _ | Pduparray _ | Parraylength _ | Parrayrefu _ | Parraysetu _
244-
| Parrayrefs _ | Parraysets _ | Pisint | Pisout | Pbintofint _ | Pintofbint _
245-
| Pcvtbint _ | Pnegbint _ | Paddbint _ | Psubbint _ | Pmulbint _ | Pdivbint _
246-
| Pmodbint _ | Pandbint _ | Porbint _ | Pxorbint _ | Plslbint _ | Plsrbint _
247-
| Pasrbint _ | Pbintcomp _ | Pbigarrayref _ | Pbigarrayset _ | Pbigarraydim _
228+
| Psetfield _ | Psetfield_computed _ | Psetfloatfield _ | Poffsetref _
229+
| Psetufloatfield _
230+
| Pbytessetu | Pbytessets | Parraysetu _ | Parraysets _ | Pbigarrayset _
231+
-> Lambda.layout_unit
232+
| Pmakeblock _ | Pmakearray _ | Pduprecord _
233+
| Pmakeufloatblock _
234+
| Pduparray _ | Pbigarraydim _ -> Lambda.layout_block
235+
| Pfield _ | Pfield_computed -> Lambda.layout_field
236+
| Pfloatfield _ | Pfloatofint _ | Pnegfloat _ | Pabsfloat _
237+
| Paddfloat _ | Psubfloat _ | Pmulfloat _ | Pdivfloat _
238+
| Pbox_float _ -> Lambda.layout_boxed_float
239+
| Pufloatfield _ | Punbox_float -> Punboxed_float
240+
| Pccall { prim_native_repr_res = _, repr_res } -> Lambda.layout_of_native_repr repr_res
241+
| Praise _ -> Lambda.layout_bottom
242+
| Psequor | Psequand | Pnot
243+
| Pnegint | Paddint | Psubint | Pmulint
244+
| Pdivint _ | Pmodint _
245+
| Pandint | Porint | Pxorint
246+
| Plslint | Plsrint | Pasrint
247+
| Pintcomp _
248+
| Pcompare_ints | Pcompare_floats | Pcompare_bints _
249+
| Poffsetint _ | Pintoffloat | Pfloatcomp _
250+
| Pstringlength | Pstringrefu | Pstringrefs
251+
| Pbyteslength | Pbytesrefu | Pbytesrefs
252+
| Parraylength _ | Pisint | Pisout | Pintofbint _
253+
| Pbintcomp _
254+
| Pprobe_is_enabled _ | Pbswap16
255+
-> Lambda.layout_int
256+
| Parrayrefu array_ref_kind | Parrayrefs array_ref_kind ->
257+
Lambda.array_ref_kind_result_layout array_ref_kind
258+
| Pbintofint (bi, _) | Pcvtbint (_,bi,_)
259+
| Pnegbint (bi, _) | Paddbint (bi, _) | Psubbint (bi, _)
260+
| Pmulbint (bi, _) | Pdivbint {size = bi} | Pmodbint {size = bi}
261+
| Pandbint (bi, _) | Porbint (bi, _) | Pxorbint (bi, _)
262+
| Plslbint (bi, _) | Plsrbint (bi, _) | Pasrbint (bi, _)
263+
| Pbbswap (bi, _) | Pbox_int (bi, _) ->
264+
Lambda.layout_boxedint bi
265+
| Punbox_int bi -> Punboxed_int bi
266+
| Pbigarrayref (_, _, kind, _) ->
267+
begin match kind with
268+
| Pbigarray_unknown -> Lambda.layout_any_value
269+
| Pbigarray_float32 | Pbigarray_float64 -> Lambda.layout_boxed_float
270+
| Pbigarray_sint8 | Pbigarray_uint8
271+
| Pbigarray_sint16 | Pbigarray_uint16
272+
| Pbigarray_caml_int -> Lambda.layout_int
273+
| Pbigarray_int32 -> Lambda.layout_boxedint Pint32
274+
| Pbigarray_int64 -> Lambda.layout_boxedint Pint64
275+
| Pbigarray_native_int -> Lambda.layout_boxedint Pnativeint
276+
| Pbigarray_complex32 | Pbigarray_complex64 ->
277+
Lambda.layout_block
278+
end
279+
| Pint_as_pointer _ ->
280+
(* CR ncourant: use an unboxed int64 here when it exists *)
281+
Lambda.layout_any_value
282+
| Pget_header _ -> Lambda.layout_boxedint Pnativeint
283+
| Prunstack | Presume | Pperform | Preperform ->
284+
(* CR mshinwell/ncourant: to be thought about later *)
285+
Misc.fatal_error "Effects-related primitives are not yet supported"
286+
| Patomic_load { immediate_or_pointer = Immediate } -> Lambda.layout_int
287+
| Patomic_load { immediate_or_pointer = Pointer } -> Lambda.layout_any_value
288+
| Patomic_exchange
289+
| Patomic_cas
290+
| Patomic_fetch_add
291+
| Pdls_get
292+
| Popaque | Pread_symbol _
248293
| Pstring_load _ | Pbytes_load _ | Pbytes_set _ | Pbigstring_load _
249-
| Pbigstring_set _ | Pbswap16 | Pbbswap _ | Pint_as_pointer _ | Popaque
250-
| Pprobe_is_enabled _ | Pbox_float _ | Pbox_int _ | Pget_header _
251-
| Prunstack | Pperform | Presume | Preperform | Patomic_exchange
252-
| Patomic_cas | Patomic_fetch_add | Pdls_get | Patomic_load _
253-
-> Lambda.layout_any_value
294+
| Pbigstring_set _ -> Lambda.layout_any_value

‎ocaml/testsuite/tests/typing-layouts-float64/unboxed_floats.ml

+18-11
Original file line numberDiff line numberDiff line change
@@ -1,23 +1,22 @@
11
(* TEST
22
reference = "${test_source_directory}/unboxed_floats.reference"
3-
* flambda2
4-
** native
3+
* native
54
flags = "-extension layouts_alpha"
6-
** bytecode
5+
* bytecode
76
flags = "-extension layouts_alpha"
8-
** native
7+
* native
98
flags = "-extension layouts_beta"
10-
** bytecode
9+
* bytecode
1110
flags = "-extension layouts_beta"
12-
** native
11+
* native
1312
flags = "-extension layouts"
14-
** bytecode
13+
* bytecode
1514
flags = "-extension layouts"
16-
** setup-ocamlc.byte-build-env
15+
* setup-ocamlc.byte-build-env
1716
ocamlc_byte_exit_status = "2"
18-
*** ocamlc.byte
17+
** ocamlc.byte
1918
compiler_reference = "${test_source_directory}/unboxed_floats_disabled.compilers.reference"
20-
**** check-ocamlc.byte-output
19+
*** check-ocamlc.byte-output
2120
2221
2322
*)
@@ -484,4 +483,12 @@ let rb' = { xb = 3.14; yb = 42.1 }
484483
let _ =
485484
Printf.printf "Test 11, heterogeneous polymorphic equality.\n";
486485
Printf.printf " equal: %b\n" (Ex ru = Ex rb);
487-
Printf.printf " unequal: %b\n" (Ex ru = Ex rb');
486+
Printf.printf " unequal: %b\n" (Ex ru = Ex rb')
487+
488+
(*************************************************)
489+
(* Test 12: If-then-else with float64 and assert *)
490+
491+
let _ =
492+
let a = if Sys.opaque_identity true then Float_u.of_int 1 else assert false in
493+
Printf.printf "Test 12, If-then-else with assert and float64.\n";
494+
print_floatu " result (1.00)" a

‎ocaml/testsuite/tests/typing-layouts-float64/unboxed_floats.reference

+2
Original file line numberDiff line numberDiff line change
@@ -147,3 +147,5 @@ Test 10, float# records in recursive groups.
147147
Test 11, heterogeneous polymorphic equality.
148148
equal: true
149149
unequal: false
150+
Test 12, If-then-else with assert and float64.
151+
result (1.00): 1.00

‎ocaml/testsuite/tests/typing-layouts-float64/unboxed_floats_disabled.compilers.reference

+2-2
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
File "unboxed_floats.ml", line 326, characters 25-31:
2-
326 | let ( let* ) x (f : _ -> float#) = f x
1+
File "unboxed_floats.ml", line 325, characters 25-31:
2+
325 | let ( let* ) x (f : _ -> float#) = f x
33
^^^^^^
44
Error: This construct requires the stable version of the extension "layouts", which is disabled and cannot be used

0 commit comments

Comments
 (0)