Skip to content

Commit 435c54d

Browse files
mshinwellmshinwell
committed
Require the array kind in Lambda get/set array prims
1 parent 2a51862 commit 435c54d

11 files changed

+332
-171
lines changed

‎bytecomp/bytegen.ml

+24-10
Original file line numberDiff line numberDiff line change
@@ -507,73 +507,87 @@ let comp_primitive stack_info p sz args =
507507
(* In bytecode, nothing is ever actually stack-allocated, so we ignore the
508508
array modes (allocation for [Parrayref{s,u}], modification for
509509
[Parrayset{s,u}]). *)
510-
| Parrayrefs (Pgenarray_ref _, index_kind, _)
510+
(* XXX think about reinterpret cases for bytecode *)
511+
| Parrayrefs (Pgenarray_ref _, _, index_kind, _)
511512
| Parrayrefs ((Paddrarray_ref | Pintarray_ref | Pfloatarray_ref _
512513
| Punboxedfloatarray_ref (Pfloat64 | Pfloat32)
513514
| Punboxedintarray_ref _
514515
| Pgcscannableproductarray_ref _
515516
| Pgcignorableproductarray_ref _),
517+
_,
516518
(Punboxed_int_index _ as index_kind),
517519
_) ->
518520
Kccall(indexing_primitive index_kind "caml_array_get", 2)
519-
| Parrayrefs ((Punboxedfloatarray_ref Pfloat64 | Pfloatarray_ref _), Ptagged_int_index, _) ->
521+
| Parrayrefs ((Punboxedfloatarray_ref Pfloat64 | Pfloatarray_ref _),
522+
_, Ptagged_int_index, _) ->
520523
Kccall("caml_floatarray_get", 2)
521524
| Parrayrefs ((Punboxedfloatarray_ref Pfloat32 | Punboxedintarray_ref _
522525
| Paddrarray_ref | Pintarray_ref
523526
| Pgcscannableproductarray_ref _
524527
| Pgcignorableproductarray_ref _),
528+
_,
525529
Ptagged_int_index,
526530
_) ->
527531
Kccall("caml_array_get_addr", 2)
528-
| Parraysets (Pgenarray_set _, index_kind)
532+
| Parraysets (Pgenarray_set _, _, index_kind)
529533
| Parraysets ((Paddrarray_set _ | Pintarray_set | Pfloatarray_set
530534
| Punboxedfloatarray_set (Pfloat64 | Pfloat32)
531535
| Punboxedintarray_set _
532536
| Pgcscannableproductarray_set _
533537
| Pgcignorableproductarray_set _),
538+
_,
534539
(Punboxed_int_index _ as index_kind)) ->
535540
Kccall(indexing_primitive index_kind "caml_array_set", 3)
536-
| Parraysets ((Punboxedfloatarray_set Pfloat64 | Pfloatarray_set),
541+
| Parraysets ((Punboxedfloatarray_set Pfloat64 | Pfloatarray_set), _,
537542
Ptagged_int_index) ->
538543
Kccall("caml_floatarray_set", 3)
539544
| Parraysets ((Punboxedfloatarray_set Pfloat32 | Punboxedintarray_set _
540545
| Paddrarray_set _ | Pintarray_set
541546
| Pgcscannableproductarray_set _
542547
| Pgcignorableproductarray_set _),
548+
_,
543549
Ptagged_int_index) ->
544550
Kccall("caml_array_set_addr", 3)
545-
| Parrayrefu (Pgenarray_ref _, index_kind, _)
551+
| Parrayrefu (Pgenarray_ref _, _, index_kind, _)
546552
| Parrayrefu ((Paddrarray_ref | Pintarray_ref | Pfloatarray_ref _
547553
| Punboxedfloatarray_ref (Pfloat64 | Pfloat32)
548554
| Punboxedintarray_ref _
549555
| Pgcscannableproductarray_ref _
550556
| Pgcignorableproductarray_ref _),
557+
_,
551558
(Punboxed_int_index _ as index_kind), _) ->
552559
Kccall(indexing_primitive index_kind "caml_array_unsafe_get", 2)
553-
| Parrayrefu ((Punboxedfloatarray_ref Pfloat64 | Pfloatarray_ref _), Ptagged_int_index, _) ->
560+
| Parrayrefu ((Punboxedfloatarray_ref Pfloat64 | Pfloatarray_ref _),
561+
_, Ptagged_int_index, _) ->
554562
Kccall("caml_floatarray_unsafe_get", 2)
555563
| Parrayrefu ((Punboxedfloatarray_ref Pfloat32 | Punboxedintarray_ref _
556564
| Paddrarray_ref | Pintarray_ref
557565
| Pgcscannableproductarray_ref _
558566
| Pgcignorableproductarray_ref _),
567+
_,
559568
Ptagged_int_index, _) -> Kgetvectitem
560-
| Parraysetu (Pgenarray_set _, index_kind)
569+
| Parraysetu (Pgenarray_set _, _, index_kind)
561570
| Parraysetu ((Paddrarray_set _ | Pintarray_set | Pfloatarray_set
562571
| Punboxedfloatarray_set (Pfloat64 | Pfloat32)
563572
| Punboxedintarray_set _
564573
| Pgcscannableproductarray_set _
565574
| Pgcignorableproductarray_set _),
575+
_,
566576
(Punboxed_int_index _ as index_kind)) ->
567577
Kccall(indexing_primitive index_kind "caml_array_unsafe_set", 3)
568-
| Parraysetu ((Punboxedfloatarray_set Pfloat64 | Pfloatarray_set), Ptagged_int_index) ->
578+
| Parraysetu ((Punboxedfloatarray_set Pfloat64 | Pfloatarray_set),
579+
_, Ptagged_int_index) ->
569580
Kccall("caml_floatarray_unsafe_set", 3)
570581
| Parraysetu ((Punboxedfloatarray_set Pfloat32 | Punboxedintarray_set _
571582
| Paddrarray_set _ | Pintarray_set
572583
| Pgcscannableproductarray_set _
573584
| Pgcignorableproductarray_set _),
585+
_,
574586
Ptagged_int_index) -> Ksetvectitem
575-
| Parrayrefs (Punboxedvectorarray_ref _, _, _) | Parraysets (Punboxedvectorarray_set _, _)
576-
| Parrayrefu (Punboxedvectorarray_ref _, _, _) | Parraysetu (Punboxedvectorarray_set _, _) ->
587+
| Parrayrefs (Punboxedvectorarray_ref _, _, _, _)
588+
| Parraysets (Punboxedvectorarray_set _, _, _)
589+
| Parrayrefu (Punboxedvectorarray_ref _, _, _, _)
590+
| Parraysetu (Punboxedvectorarray_set _, _, _) ->
577591
fatal_error "SIMD is not supported in bytecode mode."
578592
| Pctconst c ->
579593
let const_name = match c with

‎lambda/lambda.ml

+10-9
Original file line numberDiff line numberDiff line change
@@ -193,10 +193,10 @@ type primitive =
193193
| Pduparray of array_kind * mutable_flag
194194
| Parrayblit of array_set_kind (* Kind of the dest array. *)
195195
| Parraylength of array_kind
196-
| Parrayrefu of array_ref_kind * array_index_kind * mutable_flag
197-
| Parraysetu of array_set_kind * array_index_kind
198-
| Parrayrefs of array_ref_kind * array_index_kind * mutable_flag
199-
| Parraysets of array_set_kind * array_index_kind
196+
| Parrayrefu of array_ref_kind * array_kind * array_index_kind * mutable_flag
197+
| Parraysetu of array_set_kind * array_kind * array_index_kind
198+
| Parrayrefs of array_ref_kind * array_kind * array_index_kind * mutable_flag
199+
| Parraysets of array_set_kind * array_kind * array_index_kind
200200
(* Test if the argument is a block or an immediate integer *)
201201
| Pisint of { variant_only : bool }
202202
(* Test if the argument is a null pointer *)
@@ -1831,14 +1831,14 @@ let primitive_may_allocate : primitive -> locality_mode option = function
18311831
| Punboxedfloatarray_ref _ | Punboxedintarray_ref _
18321832
| Punboxedvectorarray_ref _
18331833
| Pgcscannableproductarray_ref _
1834-
| Pgcignorableproductarray_ref _), _, _)
1834+
| Pgcignorableproductarray_ref _), _, _, _)
18351835
| Parrayrefs ((Paddrarray_ref | Pintarray_ref
18361836
| Punboxedfloatarray_ref _ | Punboxedintarray_ref _
18371837
| Punboxedvectorarray_ref _
18381838
| Pgcscannableproductarray_ref _
1839-
| Pgcignorableproductarray_ref _), _, _) -> None
1840-
| Parrayrefu ((Pgenarray_ref m | Pfloatarray_ref m), _, _)
1841-
| Parrayrefs ((Pgenarray_ref m | Pfloatarray_ref m), _, _) -> Some m
1839+
| Pgcignorableproductarray_ref _), _, _, _) -> None
1840+
| Parrayrefu ((Pgenarray_ref m | Pfloatarray_ref m), _, _, _)
1841+
| Parrayrefs ((Pgenarray_ref m | Pfloatarray_ref m), _, _, _) -> Some m
18421842
| Pisint _ | Pisnull | Pisout -> None
18431843
| Pintofbint _ -> None
18441844
| Pbintofint (_,m)
@@ -2235,7 +2235,8 @@ let primitive_result_layout (p : primitive) =
22352235
| Pstring_load_16 _ | Pbytes_load_16 _ | Pbigstring_load_16 _
22362236
| Pprobe_is_enabled _ | Pbswap16
22372237
-> layout_int
2238-
| Parrayrefu (array_ref_kind, _, _) | Parrayrefs (array_ref_kind, _, _) ->
2238+
| Parrayrefu (array_ref_kind, _, _, _)
2239+
| Parrayrefs (array_ref_kind, _, _, _) ->
22392240
array_ref_kind_result_layout array_ref_kind
22402241
| Pbintofint (bi, _) | Pcvtbint (_,bi,_)
22412242
| Pnegbint (bi, _) | Paddbint (bi, _) | Psubbint (bi, _)

‎lambda/lambda.mli

+6-4
Original file line numberDiff line numberDiff line change
@@ -188,10 +188,12 @@ type primitive =
188188
array. We check that the source array has the same shape, but do not
189189
need to know anything about its locality. *)
190190
| Parraylength of array_kind
191-
| Parrayrefu of array_ref_kind * array_index_kind * mutable_flag
192-
| Parraysetu of array_set_kind * array_index_kind
193-
| Parrayrefs of array_ref_kind * array_index_kind * mutable_flag
194-
| Parraysets of array_set_kind * array_index_kind
191+
| Parrayrefu of array_ref_kind * array_kind * array_index_kind * mutable_flag
192+
(** The [array_kind], not the [array_ref_kind], determines the stride for
193+
the array index. Likewise for the other array get/set primitives. *)
194+
| Parraysetu of array_set_kind * array_kind * array_index_kind
195+
| Parrayrefs of array_ref_kind * array_kind * array_index_kind * mutable_flag
196+
| Parraysets of array_set_kind * array_kind * array_index_kind
195197
(* Test if the argument is a block or an immediate integer *)
196198
| Pisint of { variant_only : bool }
197199
(* Test if the argument is a null pointer *)

‎lambda/matching.ml

+1-1
Original file line numberDiff line numberDiff line change
@@ -2485,7 +2485,7 @@ let get_expr_args_array ~scopes kind head (arg, _mut, _sort, _layout) rem =
24852485
let result_layout = array_ref_kind_result_layout ref_kind in
24862486
let mut = if Types.is_mutable am then Mutable else Immutable in
24872487
( Lprim
2488-
(Parrayrefu (ref_kind, Ptagged_int_index, mut),
2488+
(Parrayrefu (ref_kind, kind, Ptagged_int_index, mut),
24892489
[ arg; Lconst (Const_base (Const_int pos)) ],
24902490
loc),
24912491
(if Types.is_mutable am then StrictOpt else Alias),

‎lambda/printlambda.ml

+22-14
Original file line numberDiff line numberDiff line change
@@ -671,20 +671,28 @@ let primitive ppf = function
671671
| Pduparray (k, Immutable_unique) ->
672672
fprintf ppf "duparray_unique[%s]" (array_kind k)
673673
| Parrayblit sk -> fprintf ppf "arrayblit[%a]" array_set_kind sk
674-
| Parrayrefu (rk, idx, mut) -> fprintf ppf "%s.unsafe_get[%a indexed by %a]"
675-
(array_mut mut)
676-
array_ref_kind rk
677-
array_index_kind idx
678-
| Parraysetu (sk, idx) -> fprintf ppf "array.unsafe_set[%a indexed by %a]"
679-
array_set_kind sk
680-
array_index_kind idx
681-
| Parrayrefs (rk, idx, mut) -> fprintf ppf "%s.get[%a indexed by %a]"
682-
(array_mut mut)
683-
array_ref_kind rk
684-
array_index_kind idx
685-
| Parraysets (sk, idx) -> fprintf ppf "array.set[%a indexed by %a]"
686-
array_set_kind sk
687-
array_index_kind idx
674+
| Parrayrefu (rk, ak, idx, mut) ->
675+
fprintf ppf "%s.unsafe_get[%a indexed by %a, array kind %s]"
676+
(array_mut mut)
677+
array_ref_kind rk
678+
array_index_kind idx
679+
(array_kind ak)
680+
| Parraysetu (sk, ak, idx) ->
681+
fprintf ppf "array.unsafe_set[%a indexed by %a, array kind %s]"
682+
array_set_kind sk
683+
array_index_kind idx
684+
(array_kind ak)
685+
| Parrayrefs (rk, ak, idx, mut) ->
686+
fprintf ppf "%s.get[%a indexed by %a, array kind %s]"
687+
(array_mut mut)
688+
array_ref_kind rk
689+
array_index_kind idx
690+
(array_kind ak)
691+
| Parraysets (sk, ak, idx) ->
692+
fprintf ppf "array.set[%a indexed by %a, array kind %s]"
693+
array_set_kind sk
694+
array_index_kind idx
695+
(array_kind ak)
688696
| Pctconst c ->
689697
let const_name = match c with
690698
| Big_endian -> "big_endian"

‎lambda/transl_array_comprehension.ml

+4-1
Original file line numberDiff line numberDiff line change
@@ -498,6 +498,7 @@ let iterator ~transl_exp ~scopes ~loc :
498498
(Lprim
499499
( Parrayrefu
500500
( Lambda.(array_ref_kind alloc_heap iter_arr_kind),
501+
iter_arr_kind,
501502
Ptagged_int_index,
502503
iter_arr_mut ),
503504
[iter_arr.var; Lvar iter_ix],
@@ -780,7 +781,9 @@ let body ~loc ~array_kind ~array_size ~array_sizing ~array ~index ~body =
780781
(* array.(index) <- elt *)
781782
Lprim
782783
( Parraysetu
783-
(Lambda.(array_set_kind modify_heap array_kind), Ptagged_int_index),
784+
( Lambda.(array_set_kind modify_heap array_kind),
785+
array_kind,
786+
Ptagged_int_index ),
784787
[array.var; index.var; elt],
785788
loc )
786789
in

0 commit comments

Comments
 (0)