Skip to content

Local immutable arrays #1420

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 8 commits into from
Jun 14, 2023
Merged

Local immutable arrays #1420

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
8 commits
Select commit Hold shift + click to select a range
f67e999
Local immutable arrays (ocaml-jst#156)
antalsz Mar 15, 2023
b095f24
Apply local immutable arrays (ocaml-jst#156) to `middle_end` & `backend`
antalsz Mar 15, 2023
8f778f7
Drop suspicious claim that `Parraysetu` can allocate
antalsz May 30, 2023
a320693
Checkpoint on flambda2 implementation
antalsz May 26, 2023
6b1f006
Finish flambda2 wiring + add caml_modify_local_prototype in memory.h
mshinwell Jun 1, 2023
39ef4f8
`make fmt`
antalsz Jun 1, 2023
35311c4
Bootstrap
antalsz Jun 12, 2023
8f2a549
Add tests of immutable array literals containing variables
antalsz Jun 13, 2023
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
103 changes: 55 additions & 48 deletions backend/cmm_helpers.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -882,10 +882,10 @@ let unboxed_float_array_ref arr ofs dbg =
Cop
(Cload (Double, Mutable), [array_indexing log2_size_float arr ofs dbg], dbg)

let float_array_ref arr ofs dbg =
box_float dbg Lambda.alloc_heap (unboxed_float_array_ref arr ofs dbg)
let float_array_ref mode arr ofs dbg =
box_float dbg mode (unboxed_float_array_ref arr ofs dbg)

let addr_array_set arr ofs newval dbg =
let addr_array_set_heap arr ofs newval dbg =
Cop
( Cextcall
{ func = "caml_modify";
Expand Down Expand Up @@ -915,6 +915,25 @@ let addr_array_set_local arr ofs newval dbg =
[arr; untag_int ofs dbg; newval],
dbg )

let addr_array_set (mode : Lambda.modify_mode) arr ofs newval dbg =
match mode with
| Modify_heap -> addr_array_set_heap arr ofs newval dbg
| Modify_maybe_stack -> addr_array_set_local arr ofs newval dbg

(* int and float arrays can be written to uniformly regardless of their mode *)

let int_array_set arr ofs newval dbg =
Cop
( Cstore (Word_int, Assignment),
[array_indexing log2_size_addr arr ofs dbg; newval],
dbg )

let float_array_set arr ofs newval dbg =
Cop
( Cstore (Double, Assignment),
[array_indexing log2_size_float arr ofs dbg; newval],
dbg )

let addr_array_initialize arr ofs newval dbg =
Cop
( Cextcall
Expand All @@ -930,18 +949,6 @@ let addr_array_initialize arr ofs newval dbg =
[array_indexing log2_size_addr arr ofs dbg; newval],
dbg )

let int_array_set arr ofs newval dbg =
Cop
( Cstore (Word_int, Assignment),
[array_indexing log2_size_addr arr ofs dbg; newval],
dbg )

let float_array_set arr ofs newval dbg =
Cop
( Cstore (Double, Assignment),
[array_indexing log2_size_float arr ofs dbg; newval],
dbg )

(* Get the field of a block given a possibly inconstant index *)

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

let arrayref_unsafe kind arg1 arg2 dbg =
match (kind : Lambda.array_kind) with
| Pgenarray ->
let arrayref_unsafe rkind arg1 arg2 dbg =
match (rkind : Lambda.array_ref_kind) with
| Pgenarray_ref mode ->
bind "index" arg2 (fun idx ->
bind "arr" arg1 (fun arr ->
Cifthenelse
( is_addr_array_ptr arr dbg,
dbg,
addr_array_ref arr idx dbg,
dbg,
float_array_ref arr idx dbg,
float_array_ref mode arr idx dbg,
dbg,
Any )))
| Paddrarray -> addr_array_ref arg1 arg2 dbg
| Pintarray ->
| Paddrarray_ref -> addr_array_ref arg1 arg2 dbg
| Pintarray_ref ->
(* CR mshinwell: for int/addr_array_ref move "dbg" to first arg *)
int_array_ref arg1 arg2 dbg
| Pfloatarray -> float_array_ref arg1 arg2 dbg
| Pfloatarray_ref mode -> float_array_ref mode arg1 arg2 dbg

let arrayref_safe kind arg1 arg2 dbg =
match (kind : Lambda.array_kind) with
| Pgenarray ->
let arrayref_safe rkind arg1 arg2 dbg =
match (rkind : Lambda.array_ref_kind) with
| Pgenarray_ref mode ->
bind "index" arg2 (fun idx ->
bind "arr" arg1 (fun arr ->
bind "header" (get_header_without_profinfo arr dbg) (fun hdr ->
Expand All @@ -3316,7 +3323,7 @@ let arrayref_safe kind arg1 arg2 dbg =
dbg,
addr_array_ref arr idx dbg,
dbg,
float_array_ref arr idx dbg,
float_array_ref mode arr idx dbg,
dbg,
Any ) )
else
Expand All @@ -3331,10 +3338,10 @@ let arrayref_safe kind arg1 arg2 dbg =
Csequence
( make_checkbound dbg
[float_array_length_shifted hdr dbg; idx],
float_array_ref arr idx dbg ),
float_array_ref mode arr idx dbg ),
dbg,
Any ))))
| Paddrarray ->
| Paddrarray_ref ->
bind "index" arg2 (fun idx ->
bind "arr" arg1 (fun arr ->
Csequence
Expand All @@ -3344,7 +3351,7 @@ let arrayref_safe kind arg1 arg2 dbg =
dbg;
idx ],
addr_array_ref arr idx dbg )))
| Pintarray ->
| Pintarray_ref ->
bind "index" arg2 (fun idx ->
bind "arr" arg1 (fun arr ->
Csequence
Expand All @@ -3354,8 +3361,8 @@ let arrayref_safe kind arg1 arg2 dbg =
dbg;
idx ],
int_array_ref arr idx dbg )))
| Pfloatarray ->
box_float dbg Lambda.alloc_heap
| Pfloatarray_ref mode ->
box_float dbg mode
(bind "index" arg2 (fun idx ->
bind "arr" arg1 (fun arr ->
Csequence
Expand All @@ -3371,7 +3378,7 @@ type ternary_primitive =

let setfield_computed ptr init arg1 arg2 arg3 dbg =
match assignment_kind ptr init with
| Caml_modify -> return_unit dbg (addr_array_set arg1 arg2 arg3 dbg)
| Caml_modify -> return_unit dbg (addr_array_set_heap arg1 arg2 arg3 dbg)
| Caml_modify_local ->
return_unit dbg (addr_array_set_local arg1 arg2 arg3 dbg)
| Caml_initialize ->
Expand All @@ -3398,29 +3405,29 @@ let bytesset_safe arg1 arg2 arg3 dbg =
[add_int str idx dbg; ignore_high_bit_int newval],
dbg ) )))))

let arrayset_unsafe kind arg1 arg2 arg3 dbg =
let arrayset_unsafe skind arg1 arg2 arg3 dbg =
return_unit dbg
(match (kind : Lambda.array_kind) with
| Pgenarray ->
(match (skind : Lambda.array_set_kind) with
| Pgenarray_set mode ->
bind "newval" arg3 (fun newval ->
bind "index" arg2 (fun index ->
bind "arr" arg1 (fun arr ->
Cifthenelse
( is_addr_array_ptr arr dbg,
dbg,
addr_array_set arr index newval dbg,
addr_array_set mode arr index newval dbg,
dbg,
float_array_set arr index (unbox_float dbg newval) dbg,
dbg,
Any ))))
| Paddrarray -> addr_array_set arg1 arg2 arg3 dbg
| Pintarray -> int_array_set arg1 arg2 arg3 dbg
| Pfloatarray -> float_array_set arg1 arg2 arg3 dbg)
| Paddrarray_set mode -> addr_array_set mode arg1 arg2 arg3 dbg
| Pintarray_set -> int_array_set arg1 arg2 arg3 dbg
| Pfloatarray_set -> float_array_set arg1 arg2 arg3 dbg)

let arrayset_safe kind arg1 arg2 arg3 dbg =
let arrayset_safe skind arg1 arg2 arg3 dbg =
return_unit dbg
(match (kind : Lambda.array_kind) with
| Pgenarray ->
(match (skind : Lambda.array_set_kind) with
| Pgenarray_set mode ->
bind "newval" arg3 (fun newval ->
bind "index" arg2 (fun idx ->
bind "arr" arg1 (fun arr ->
Expand All @@ -3434,7 +3441,7 @@ let arrayset_safe kind arg1 arg2 arg3 dbg =
Cifthenelse
( is_addr_array_hdr hdr dbg,
dbg,
addr_array_set arr idx newval dbg,
addr_array_set mode arr idx newval dbg,
dbg,
float_array_set arr idx (unbox_float dbg newval)
dbg,
Expand All @@ -3447,7 +3454,7 @@ let arrayset_safe kind arg1 arg2 arg3 dbg =
Csequence
( make_checkbound dbg
[addr_array_length_shifted hdr dbg; idx],
addr_array_set arr idx newval dbg ),
addr_array_set mode arr idx newval dbg ),
dbg,
Csequence
( make_checkbound dbg
Expand All @@ -3456,7 +3463,7 @@ let arrayset_safe kind arg1 arg2 arg3 dbg =
dbg ),
dbg,
Any )))))
| Paddrarray ->
| Paddrarray_set mode ->
bind "newval" arg3 (fun newval ->
bind "index" arg2 (fun idx ->
bind "arr" arg1 (fun arr ->
Expand All @@ -3466,8 +3473,8 @@ let arrayset_safe kind arg1 arg2 arg3 dbg =
(get_header_without_profinfo arr dbg)
dbg;
idx ],
addr_array_set arr idx newval dbg ))))
| Pintarray ->
addr_array_set mode arr idx newval dbg ))))
| Pintarray_set ->
bind "newval" arg3 (fun newval ->
bind "index" arg2 (fun idx ->
bind "arr" arg1 (fun arr ->
Expand All @@ -3478,7 +3485,7 @@ let arrayset_safe kind arg1 arg2 arg3 dbg =
dbg;
idx ],
int_array_set arr idx newval dbg ))))
| Pfloatarray ->
| Pfloatarray_set ->
bind_load "newval" arg3 (fun newval ->
bind "index" arg2 (fun idx ->
bind "arr" arg1 (fun arr ->
Expand Down
23 changes: 17 additions & 6 deletions backend/cmm_helpers.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -328,9 +328,10 @@ val int_array_ref : expression -> expression -> Debuginfo.t -> expression
val unboxed_float_array_ref :
expression -> expression -> Debuginfo.t -> expression

val float_array_ref : expression -> expression -> Debuginfo.t -> expression
val float_array_ref :
Lambda.alloc_mode -> expression -> expression -> Debuginfo.t -> expression

val addr_array_set :
val addr_array_set_heap :
expression -> expression -> expression -> Debuginfo.t -> expression

val addr_array_set_local :
Expand All @@ -339,6 +340,14 @@ val addr_array_set_local :
val addr_array_initialize :
expression -> expression -> expression -> Debuginfo.t -> expression

val addr_array_set :
Lambda.modify_mode ->
expression ->
expression ->
expression ->
Debuginfo.t ->
expression

val int_array_set :
expression -> expression -> expression -> Debuginfo.t -> expression

Expand Down Expand Up @@ -711,9 +720,10 @@ val bigstring_load :
(** Arrays *)

(** Array access. Args: array, index *)
val arrayref_unsafe : Lambda.array_kind -> binary_primitive
val arrayref_unsafe : Lambda.array_ref_kind -> binary_primitive

val arrayref_safe : Lambda.array_kind -> binary_primitive
(** Array access. Args: array, index *)
val arrayref_safe : Lambda.array_ref_kind -> binary_primitive

type ternary_primitive =
expression -> expression -> expression -> Debuginfo.t -> expression
Expand All @@ -738,9 +748,10 @@ val bytesset_safe : ternary_primitive
including in the case where the array contains floats.

Args: array, index, value *)
val arrayset_unsafe : Lambda.array_kind -> ternary_primitive
val arrayset_unsafe : Lambda.array_set_kind -> ternary_primitive

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

(** Set a chunk of data in the given bytes or bigstring structure. See also
[string_load] and [bigstring_load].
Expand Down
24 changes: 12 additions & 12 deletions backend/cmmgen.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1123,10 +1123,10 @@ and transl_prim_2 env p arg1 arg2 dbg =
bigstring_load size unsafe mode (transl env arg1) (transl env arg2) dbg

(* Array operations *)
| Parrayrefu kind ->
arrayref_unsafe kind (transl env arg1) (transl env arg2) dbg
| Parrayrefs kind ->
arrayref_safe kind (transl env arg1) (transl env arg2) dbg
| Parrayrefu rkind ->
arrayref_unsafe rkind (transl env arg1) (transl env arg2) dbg
| Parrayrefs rkind ->
arrayref_safe rkind (transl env arg1) (transl env arg2) dbg

(* Boxed integers *)
| Paddbint (bi, mode) ->
Expand Down Expand Up @@ -1211,20 +1211,20 @@ and transl_prim_3 env p arg1 arg2 arg3 dbg =
(transl env arg1) (transl env arg2) (transl env arg3) dbg

(* Array operations *)
| Parraysetu kind ->
| Parraysetu skind ->
let newval =
match kind with
| Pfloatarray -> transl_unbox_float dbg env arg3
match skind with
| Pfloatarray_set -> transl_unbox_float dbg env arg3
| _ -> transl env arg3
in
arrayset_unsafe kind (transl env arg1) (transl env arg2) newval dbg
| Parraysets kind ->
arrayset_unsafe skind (transl env arg1) (transl env arg2) newval dbg
| Parraysets skind ->
let newval =
match kind with
| Pfloatarray -> transl_unbox_float dbg env arg3
match skind with
| Pfloatarray_set -> transl_unbox_float dbg env arg3
| _ -> transl env arg3
in
arrayset_safe kind (transl env arg1) (transl env arg2) newval dbg
arrayset_safe skind (transl env arg1) (transl env arg2) newval dbg

| Pbytes_set(size, unsafe) ->
bytes_set size unsafe (transl env arg1) (transl env arg2)
Expand Down
22 changes: 18 additions & 4 deletions middle_end/clambda_primitives.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -32,6 +32,8 @@ type memory_access_size =

type alloc_mode = Lambda.alloc_mode

type modify_mode = Lambda.modify_mode

type primitive =
| Pread_symbol of string
(* Operations on heap blocks *)
Expand Down Expand Up @@ -74,10 +76,10 @@ type primitive =
The arguments of [Pduparray] give the kind and mutability of the
array being *produced* by the duplication. *)
| Parraylength of array_kind
| Parrayrefu of array_kind
| Parraysetu of array_kind
| Parrayrefs of array_kind
| Parraysets of array_kind
| Parrayrefu of array_ref_kind
| Parraysetu of array_set_kind
| Parrayrefs of array_ref_kind
| Parraysets of array_set_kind
(* Test if the argument is a block or an immediate integer *)
| Pisint
(* Test if the (integer) argument is outside an interval *)
Expand Down Expand Up @@ -136,6 +138,18 @@ and float_comparison = Lambda.float_comparison =
and array_kind = Lambda.array_kind =
Pgenarray | Paddrarray | Pintarray | Pfloatarray

and array_ref_kind = Lambda.array_ref_kind =
| Pgenarray_ref of alloc_mode
| Paddrarray_ref
| Pintarray_ref
| Pfloatarray_ref of alloc_mode

and array_set_kind = Lambda.array_set_kind =
| Pgenarray_set of modify_mode
| Paddrarray_set of modify_mode
| Pintarray_set
| Pfloatarray_set

and value_kind = Lambda.value_kind =
(* CR mshinwell: Pfloatval should be renamed to Pboxedfloatval *)
Pgenval | Pfloatval | Pboxedintval of boxed_integer | Pintval
Expand Down
Loading