@@ -225,29 +225,70 @@ let equal (x: primitive) (y: primitive) = x = y
225
225
226
226
let result_layout (p : primitive ) =
227
227
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 _
248
293
| 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
0 commit comments