Skip to content

Commit 25ef04f

Browse files
antalszmshinwell
antalsz
and
mshinwell
authored
Local immutable arrays (#1420)
Co-authored-by: Mark Shinwell <[email protected]>
1 parent 26d4066 commit 25ef04f

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

57 files changed

+2932
-556
lines changed

‎backend/cmm_helpers.ml

Lines changed: 55 additions & 48 deletions
Original file line numberDiff line numberDiff line change
@@ -882,10 +882,10 @@ let unboxed_float_array_ref arr ofs dbg =
882882
Cop
883883
(Cload (Double, Mutable), [array_indexing log2_size_float arr ofs dbg], dbg)
884884

885-
let float_array_ref arr ofs dbg =
886-
box_float dbg Lambda.alloc_heap (unboxed_float_array_ref arr ofs dbg)
885+
let float_array_ref mode arr ofs dbg =
886+
box_float dbg mode (unboxed_float_array_ref arr ofs dbg)
887887

888-
let addr_array_set arr ofs newval dbg =
888+
let addr_array_set_heap arr ofs newval dbg =
889889
Cop
890890
( Cextcall
891891
{ func = "caml_modify";
@@ -915,6 +915,25 @@ let addr_array_set_local arr ofs newval dbg =
915915
[arr; untag_int ofs dbg; newval],
916916
dbg )
917917

918+
let addr_array_set (mode : Lambda.modify_mode) arr ofs newval dbg =
919+
match mode with
920+
| Modify_heap -> addr_array_set_heap arr ofs newval dbg
921+
| Modify_maybe_stack -> addr_array_set_local arr ofs newval dbg
922+
923+
(* int and float arrays can be written to uniformly regardless of their mode *)
924+
925+
let int_array_set arr ofs newval dbg =
926+
Cop
927+
( Cstore (Word_int, Assignment),
928+
[array_indexing log2_size_addr arr ofs dbg; newval],
929+
dbg )
930+
931+
let float_array_set arr ofs newval dbg =
932+
Cop
933+
( Cstore (Double, Assignment),
934+
[array_indexing log2_size_float arr ofs dbg; newval],
935+
dbg )
936+
918937
let addr_array_initialize arr ofs newval dbg =
919938
Cop
920939
( Cextcall
@@ -930,18 +949,6 @@ let addr_array_initialize arr ofs newval dbg =
930949
[array_indexing log2_size_addr arr ofs dbg; newval],
931950
dbg )
932951

933-
let int_array_set arr ofs newval dbg =
934-
Cop
935-
( Cstore (Word_int, Assignment),
936-
[array_indexing log2_size_addr arr ofs dbg; newval],
937-
dbg )
938-
939-
let float_array_set arr ofs newval dbg =
940-
Cop
941-
( Cstore (Double, Assignment),
942-
[array_indexing log2_size_float arr ofs dbg; newval],
943-
dbg )
944-
945952
(* Get the field of a block given a possibly inconstant index *)
946953

947954
let get_field_computed imm_or_ptr mut ~block ~index dbg =
@@ -3281,28 +3288,28 @@ let bigstring_load size unsafe mode arg1 arg2 dbg =
32813288
check_bound unsafe size dbg (bigstring_length ba dbg) idx
32823289
(unaligned_load size ba_data idx dbg)))))
32833290

3284-
let arrayref_unsafe kind arg1 arg2 dbg =
3285-
match (kind : Lambda.array_kind) with
3286-
| Pgenarray ->
3291+
let arrayref_unsafe rkind arg1 arg2 dbg =
3292+
match (rkind : Lambda.array_ref_kind) with
3293+
| Pgenarray_ref mode ->
32873294
bind "index" arg2 (fun idx ->
32883295
bind "arr" arg1 (fun arr ->
32893296
Cifthenelse
32903297
( is_addr_array_ptr arr dbg,
32913298
dbg,
32923299
addr_array_ref arr idx dbg,
32933300
dbg,
3294-
float_array_ref arr idx dbg,
3301+
float_array_ref mode arr idx dbg,
32953302
dbg,
32963303
Any )))
3297-
| Paddrarray -> addr_array_ref arg1 arg2 dbg
3298-
| Pintarray ->
3304+
| Paddrarray_ref -> addr_array_ref arg1 arg2 dbg
3305+
| Pintarray_ref ->
32993306
(* CR mshinwell: for int/addr_array_ref move "dbg" to first arg *)
33003307
int_array_ref arg1 arg2 dbg
3301-
| Pfloatarray -> float_array_ref arg1 arg2 dbg
3308+
| Pfloatarray_ref mode -> float_array_ref mode arg1 arg2 dbg
33023309

3303-
let arrayref_safe kind arg1 arg2 dbg =
3304-
match (kind : Lambda.array_kind) with
3305-
| Pgenarray ->
3310+
let arrayref_safe rkind arg1 arg2 dbg =
3311+
match (rkind : Lambda.array_ref_kind) with
3312+
| Pgenarray_ref mode ->
33063313
bind "index" arg2 (fun idx ->
33073314
bind "arr" arg1 (fun arr ->
33083315
bind "header" (get_header_without_profinfo arr dbg) (fun hdr ->
@@ -3316,7 +3323,7 @@ let arrayref_safe kind arg1 arg2 dbg =
33163323
dbg,
33173324
addr_array_ref arr idx dbg,
33183325
dbg,
3319-
float_array_ref arr idx dbg,
3326+
float_array_ref mode arr idx dbg,
33203327
dbg,
33213328
Any ) )
33223329
else
@@ -3331,10 +3338,10 @@ let arrayref_safe kind arg1 arg2 dbg =
33313338
Csequence
33323339
( make_checkbound dbg
33333340
[float_array_length_shifted hdr dbg; idx],
3334-
float_array_ref arr idx dbg ),
3341+
float_array_ref mode arr idx dbg ),
33353342
dbg,
33363343
Any ))))
3337-
| Paddrarray ->
3344+
| Paddrarray_ref ->
33383345
bind "index" arg2 (fun idx ->
33393346
bind "arr" arg1 (fun arr ->
33403347
Csequence
@@ -3344,7 +3351,7 @@ let arrayref_safe kind arg1 arg2 dbg =
33443351
dbg;
33453352
idx ],
33463353
addr_array_ref arr idx dbg )))
3347-
| Pintarray ->
3354+
| Pintarray_ref ->
33483355
bind "index" arg2 (fun idx ->
33493356
bind "arr" arg1 (fun arr ->
33503357
Csequence
@@ -3354,8 +3361,8 @@ let arrayref_safe kind arg1 arg2 dbg =
33543361
dbg;
33553362
idx ],
33563363
int_array_ref arr idx dbg )))
3357-
| Pfloatarray ->
3358-
box_float dbg Lambda.alloc_heap
3364+
| Pfloatarray_ref mode ->
3365+
box_float dbg mode
33593366
(bind "index" arg2 (fun idx ->
33603367
bind "arr" arg1 (fun arr ->
33613368
Csequence
@@ -3371,7 +3378,7 @@ type ternary_primitive =
33713378

33723379
let setfield_computed ptr init arg1 arg2 arg3 dbg =
33733380
match assignment_kind ptr init with
3374-
| Caml_modify -> return_unit dbg (addr_array_set arg1 arg2 arg3 dbg)
3381+
| Caml_modify -> return_unit dbg (addr_array_set_heap arg1 arg2 arg3 dbg)
33753382
| Caml_modify_local ->
33763383
return_unit dbg (addr_array_set_local arg1 arg2 arg3 dbg)
33773384
| Caml_initialize ->
@@ -3398,29 +3405,29 @@ let bytesset_safe arg1 arg2 arg3 dbg =
33983405
[add_int str idx dbg; ignore_high_bit_int newval],
33993406
dbg ) )))))
34003407

3401-
let arrayset_unsafe kind arg1 arg2 arg3 dbg =
3408+
let arrayset_unsafe skind arg1 arg2 arg3 dbg =
34023409
return_unit dbg
3403-
(match (kind : Lambda.array_kind) with
3404-
| Pgenarray ->
3410+
(match (skind : Lambda.array_set_kind) with
3411+
| Pgenarray_set mode ->
34053412
bind "newval" arg3 (fun newval ->
34063413
bind "index" arg2 (fun index ->
34073414
bind "arr" arg1 (fun arr ->
34083415
Cifthenelse
34093416
( is_addr_array_ptr arr dbg,
34103417
dbg,
3411-
addr_array_set arr index newval dbg,
3418+
addr_array_set mode arr index newval dbg,
34123419
dbg,
34133420
float_array_set arr index (unbox_float dbg newval) dbg,
34143421
dbg,
34153422
Any ))))
3416-
| Paddrarray -> addr_array_set arg1 arg2 arg3 dbg
3417-
| Pintarray -> int_array_set arg1 arg2 arg3 dbg
3418-
| Pfloatarray -> float_array_set arg1 arg2 arg3 dbg)
3423+
| Paddrarray_set mode -> addr_array_set mode arg1 arg2 arg3 dbg
3424+
| Pintarray_set -> int_array_set arg1 arg2 arg3 dbg
3425+
| Pfloatarray_set -> float_array_set arg1 arg2 arg3 dbg)
34193426

3420-
let arrayset_safe kind arg1 arg2 arg3 dbg =
3427+
let arrayset_safe skind arg1 arg2 arg3 dbg =
34213428
return_unit dbg
3422-
(match (kind : Lambda.array_kind) with
3423-
| Pgenarray ->
3429+
(match (skind : Lambda.array_set_kind) with
3430+
| Pgenarray_set mode ->
34243431
bind "newval" arg3 (fun newval ->
34253432
bind "index" arg2 (fun idx ->
34263433
bind "arr" arg1 (fun arr ->
@@ -3434,7 +3441,7 @@ let arrayset_safe kind arg1 arg2 arg3 dbg =
34343441
Cifthenelse
34353442
( is_addr_array_hdr hdr dbg,
34363443
dbg,
3437-
addr_array_set arr idx newval dbg,
3444+
addr_array_set mode arr idx newval dbg,
34383445
dbg,
34393446
float_array_set arr idx (unbox_float dbg newval)
34403447
dbg,
@@ -3447,7 +3454,7 @@ let arrayset_safe kind arg1 arg2 arg3 dbg =
34473454
Csequence
34483455
( make_checkbound dbg
34493456
[addr_array_length_shifted hdr dbg; idx],
3450-
addr_array_set arr idx newval dbg ),
3457+
addr_array_set mode arr idx newval dbg ),
34513458
dbg,
34523459
Csequence
34533460
( make_checkbound dbg
@@ -3456,7 +3463,7 @@ let arrayset_safe kind arg1 arg2 arg3 dbg =
34563463
dbg ),
34573464
dbg,
34583465
Any )))))
3459-
| Paddrarray ->
3466+
| Paddrarray_set mode ->
34603467
bind "newval" arg3 (fun newval ->
34613468
bind "index" arg2 (fun idx ->
34623469
bind "arr" arg1 (fun arr ->
@@ -3466,8 +3473,8 @@ let arrayset_safe kind arg1 arg2 arg3 dbg =
34663473
(get_header_without_profinfo arr dbg)
34673474
dbg;
34683475
idx ],
3469-
addr_array_set arr idx newval dbg ))))
3470-
| Pintarray ->
3476+
addr_array_set mode arr idx newval dbg ))))
3477+
| Pintarray_set ->
34713478
bind "newval" arg3 (fun newval ->
34723479
bind "index" arg2 (fun idx ->
34733480
bind "arr" arg1 (fun arr ->
@@ -3478,7 +3485,7 @@ let arrayset_safe kind arg1 arg2 arg3 dbg =
34783485
dbg;
34793486
idx ],
34803487
int_array_set arr idx newval dbg ))))
3481-
| Pfloatarray ->
3488+
| Pfloatarray_set ->
34823489
bind_load "newval" arg3 (fun newval ->
34833490
bind "index" arg2 (fun idx ->
34843491
bind "arr" arg1 (fun arr ->

‎backend/cmm_helpers.mli

Lines changed: 17 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -328,9 +328,10 @@ val int_array_ref : expression -> expression -> Debuginfo.t -> expression
328328
val unboxed_float_array_ref :
329329
expression -> expression -> Debuginfo.t -> expression
330330

331-
val float_array_ref : expression -> expression -> Debuginfo.t -> expression
331+
val float_array_ref :
332+
Lambda.alloc_mode -> expression -> expression -> Debuginfo.t -> expression
332333

333-
val addr_array_set :
334+
val addr_array_set_heap :
334335
expression -> expression -> expression -> Debuginfo.t -> expression
335336

336337
val addr_array_set_local :
@@ -339,6 +340,14 @@ val addr_array_set_local :
339340
val addr_array_initialize :
340341
expression -> expression -> expression -> Debuginfo.t -> expression
341342

343+
val addr_array_set :
344+
Lambda.modify_mode ->
345+
expression ->
346+
expression ->
347+
expression ->
348+
Debuginfo.t ->
349+
expression
350+
342351
val int_array_set :
343352
expression -> expression -> expression -> Debuginfo.t -> expression
344353

@@ -711,9 +720,10 @@ val bigstring_load :
711720
(** Arrays *)
712721

713722
(** Array access. Args: array, index *)
714-
val arrayref_unsafe : Lambda.array_kind -> binary_primitive
723+
val arrayref_unsafe : Lambda.array_ref_kind -> binary_primitive
715724

716-
val arrayref_safe : Lambda.array_kind -> binary_primitive
725+
(** Array access. Args: array, index *)
726+
val arrayref_safe : Lambda.array_ref_kind -> binary_primitive
717727

718728
type ternary_primitive =
719729
expression -> expression -> expression -> Debuginfo.t -> expression
@@ -738,9 +748,10 @@ val bytesset_safe : ternary_primitive
738748
including in the case where the array contains floats.
739749
740750
Args: array, index, value *)
741-
val arrayset_unsafe : Lambda.array_kind -> ternary_primitive
751+
val arrayset_unsafe : Lambda.array_set_kind -> ternary_primitive
742752

743-
val arrayset_safe : Lambda.array_kind -> ternary_primitive
753+
(** As [arrayset_unsafe], but performs bounds-checking. *)
754+
val arrayset_safe : Lambda.array_set_kind -> ternary_primitive
744755

745756
(** Set a chunk of data in the given bytes or bigstring structure. See also
746757
[string_load] and [bigstring_load].

‎backend/cmmgen.ml

Lines changed: 12 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -1123,10 +1123,10 @@ and transl_prim_2 env p arg1 arg2 dbg =
11231123
bigstring_load size unsafe mode (transl env arg1) (transl env arg2) dbg
11241124

11251125
(* Array operations *)
1126-
| Parrayrefu kind ->
1127-
arrayref_unsafe kind (transl env arg1) (transl env arg2) dbg
1128-
| Parrayrefs kind ->
1129-
arrayref_safe kind (transl env arg1) (transl env arg2) dbg
1126+
| Parrayrefu rkind ->
1127+
arrayref_unsafe rkind (transl env arg1) (transl env arg2) dbg
1128+
| Parrayrefs rkind ->
1129+
arrayref_safe rkind (transl env arg1) (transl env arg2) dbg
11301130

11311131
(* Boxed integers *)
11321132
| Paddbint (bi, mode) ->
@@ -1211,20 +1211,20 @@ and transl_prim_3 env p arg1 arg2 arg3 dbg =
12111211
(transl env arg1) (transl env arg2) (transl env arg3) dbg
12121212

12131213
(* Array operations *)
1214-
| Parraysetu kind ->
1214+
| Parraysetu skind ->
12151215
let newval =
1216-
match kind with
1217-
| Pfloatarray -> transl_unbox_float dbg env arg3
1216+
match skind with
1217+
| Pfloatarray_set -> transl_unbox_float dbg env arg3
12181218
| _ -> transl env arg3
12191219
in
1220-
arrayset_unsafe kind (transl env arg1) (transl env arg2) newval dbg
1221-
| Parraysets kind ->
1220+
arrayset_unsafe skind (transl env arg1) (transl env arg2) newval dbg
1221+
| Parraysets skind ->
12221222
let newval =
1223-
match kind with
1224-
| Pfloatarray -> transl_unbox_float dbg env arg3
1223+
match skind with
1224+
| Pfloatarray_set -> transl_unbox_float dbg env arg3
12251225
| _ -> transl env arg3
12261226
in
1227-
arrayset_safe kind (transl env arg1) (transl env arg2) newval dbg
1227+
arrayset_safe skind (transl env arg1) (transl env arg2) newval dbg
12281228

12291229
| Pbytes_set(size, unsafe) ->
12301230
bytes_set size unsafe (transl env arg1) (transl env arg2)

‎middle_end/clambda_primitives.ml

Lines changed: 18 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -32,6 +32,8 @@ type memory_access_size =
3232

3333
type alloc_mode = Lambda.alloc_mode
3434

35+
type modify_mode = Lambda.modify_mode
36+
3537
type primitive =
3638
| Pread_symbol of string
3739
(* Operations on heap blocks *)
@@ -74,10 +76,10 @@ type primitive =
7476
The arguments of [Pduparray] give the kind and mutability of the
7577
array being *produced* by the duplication. *)
7678
| Parraylength of array_kind
77-
| Parrayrefu of array_kind
78-
| Parraysetu of array_kind
79-
| Parrayrefs of array_kind
80-
| Parraysets of array_kind
79+
| Parrayrefu of array_ref_kind
80+
| Parraysetu of array_set_kind
81+
| Parrayrefs of array_ref_kind
82+
| Parraysets of array_set_kind
8183
(* Test if the argument is a block or an immediate integer *)
8284
| Pisint
8385
(* Test if the (integer) argument is outside an interval *)
@@ -136,6 +138,18 @@ and float_comparison = Lambda.float_comparison =
136138
and array_kind = Lambda.array_kind =
137139
Pgenarray | Paddrarray | Pintarray | Pfloatarray
138140

141+
and array_ref_kind = Lambda.array_ref_kind =
142+
| Pgenarray_ref of alloc_mode
143+
| Paddrarray_ref
144+
| Pintarray_ref
145+
| Pfloatarray_ref of alloc_mode
146+
147+
and array_set_kind = Lambda.array_set_kind =
148+
| Pgenarray_set of modify_mode
149+
| Paddrarray_set of modify_mode
150+
| Pintarray_set
151+
| Pfloatarray_set
152+
139153
and value_kind = Lambda.value_kind =
140154
(* CR mshinwell: Pfloatval should be renamed to Pboxedfloatval *)
141155
Pgenval | Pfloatval | Pboxedintval of boxed_integer | Pintval

0 commit comments

Comments
 (0)