Skip to content

Commit 585e023

Browse files
mshinwellmshinwell
authored
flambda-backend: Improved simplification of array operations (oxcaml#384)
1 parent faec6b1 commit 585e023

9 files changed

Lines changed: 32 additions & 12 deletions

File tree

‎asmcomp/cmmgen.ml‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -690,7 +690,7 @@ and transl_catch env nfail ids body handler dbg =
690690
let strict =
691691
match kind with
692692
| Pfloatval | Pboxedintval _ -> false
693-
| Pintval | Pgenval | Pblock _ -> true
693+
| Pintval | Pgenval | Pblock _ | Parrayval _ -> true
694694
in
695695
u := join_unboxed_number_kind ~strict !u
696696
(is_unboxed_number_cmm ~strict c)
@@ -1145,7 +1145,7 @@ and transl_let env str kind id exp body =
11451145
we do it only if this indeed allows us to get rid of
11461146
some allocations in the bound expression. *)
11471147
is_unboxed_number_cmm ~strict:false cexp
1148-
| _, (Pgenval | Pblock _) ->
1148+
| _, (Pgenval | Pblock _ | Parrayval _) ->
11491149
(* Here we don't know statically that the bound expression
11501150
evaluates to an unboxable number type. We need to be stricter
11511151
and ensure that all possible branches in the expression

‎lambda/lambda.ml‎

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -162,6 +162,7 @@ and float_comparison =
162162
and value_kind =
163163
Pgenval | Pfloatval | Pboxedintval of boxed_integer | Pintval
164164
| Pblock of { tag : int; fields : value_kind list }
165+
| Parrayval of array_kind
165166

166167
and block_shape =
167168
value_kind list option
@@ -212,11 +213,13 @@ let rec equal_value_kind x y =
212213
| Pfloatval, Pfloatval -> true
213214
| Pboxedintval bi1, Pboxedintval bi2 -> equal_boxed_integer bi1 bi2
214215
| Pintval, Pintval -> true
216+
| Parrayval elt_kind1, Parrayval elt_kind2 -> elt_kind1 = elt_kind2
215217
| Pblock { tag = tag1; fields = fields1 },
216218
Pblock { tag = tag2; fields = fields2 } ->
217219
tag1 = tag2 && List.length fields1 = List.length fields2 &&
218220
List.for_all2 equal_value_kind fields1 fields2
219-
| (Pgenval | Pfloatval | Pboxedintval _ | Pintval | Pblock _), _ -> false
221+
| (Pgenval | Pfloatval | Pboxedintval _ | Pintval | Pblock _
222+
| Parrayval _), _ -> false
220223

221224

222225
type structured_constant =

‎lambda/lambda.mli‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -175,6 +175,7 @@ and array_kind =
175175
and value_kind =
176176
Pgenval | Pfloatval | Pboxedintval of boxed_integer | Pintval
177177
| Pblock of { tag : int; fields : value_kind list }
178+
| Parrayval of array_kind
178179

179180
and block_shape =
180181
value_kind list option

‎lambda/printlambda.ml‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -63,6 +63,7 @@ let rec value_kind ppf = function
6363
| Pgenval -> ()
6464
| Pintval -> fprintf ppf "[int]"
6565
| Pfloatval -> fprintf ppf "[float]"
66+
| Parrayval elt_kind -> fprintf ppf "[%sarray]" (array_kind elt_kind)
6667
| Pboxedintval bi -> fprintf ppf "[%s]" (boxed_integer_name bi)
6768
| Pblock { tag; fields } ->
6869
fprintf ppf "[%d: %a]" tag
@@ -73,6 +74,7 @@ and value_kind' ppf = function
7374
| Pgenval -> fprintf ppf "*"
7475
| Pintval -> fprintf ppf "[int]"
7576
| Pfloatval -> fprintf ppf "[float]"
77+
| Parrayval elt_kind -> fprintf ppf "[%sarray]" (array_kind elt_kind)
7678
| Pboxedintval bi -> fprintf ppf "[%s]" (boxed_integer_name bi)
7779
| Pblock { tag; fields } ->
7880
fprintf ppf "[%d: %a]" tag
@@ -83,6 +85,7 @@ let return_kind ppf = function
8385
| Pgenval -> ()
8486
| Pintval -> fprintf ppf ": int@ "
8587
| Pfloatval -> fprintf ppf ": float@ "
88+
| Parrayval elt_kind -> fprintf ppf ": %sarray@ " (array_kind elt_kind)
8689
| Pboxedintval bi -> fprintf ppf ": %s@ " (boxed_integer_name bi)
8790
| Pblock { tag; fields } ->
8891
fprintf ppf ": [%d: %a]@ " tag
@@ -93,6 +96,7 @@ let field_kind ppf = function
9396
| Pgenval -> pp_print_string ppf "*"
9497
| Pintval -> pp_print_string ppf "int"
9598
| Pfloatval -> pp_print_string ppf "float"
99+
| Parrayval elt_kind -> fprintf ppf "%s-array" (array_kind elt_kind)
96100
| Pboxedintval bi -> pp_print_string ppf (boxed_integer_name bi)
97101
| Pblock { tag; fields } ->
98102
fprintf ppf "[%d: %a]" tag

‎middle_end/clambda_primitives.ml‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -132,6 +132,7 @@ and value_kind = Lambda.value_kind =
132132
(* CR mshinwell: Pfloatval should be renamed to Pboxedfloatval *)
133133
Pgenval | Pfloatval | Pboxedintval of boxed_integer | Pintval
134134
| Pblock of { tag : int; fields : value_kind list }
135+
| Parrayval of array_kind
135136

136137
and block_shape = Lambda.block_shape
137138
and boxed_integer = Primitive.boxed_integer =

‎middle_end/clambda_primitives.mli‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -135,6 +135,7 @@ and value_kind = Lambda.value_kind =
135135
(* CR mshinwell: Pfloatval should be renamed to Pboxedfloatval *)
136136
Pgenval | Pfloatval | Pboxedintval of boxed_integer | Pintval
137137
| Pblock of { tag : int; fields : value_kind list }
138+
| Parrayval of array_kind
138139

139140
and block_shape = Lambda.block_shape
140141
and boxed_integer = Primitive.boxed_integer =

‎middle_end/printclambda.ml‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -30,6 +30,10 @@ let value_kind =
3030
| Pgenval -> ""
3131
| Pintval -> ":int"
3232
| Pfloatval -> ":float"
33+
| Parrayval Pgenarray -> ":genarray"
34+
| Parrayval Pintarray -> ":intarray"
35+
| Parrayval Pfloatarray -> ":floatarray"
36+
| Parrayval Paddrarray -> ":addrarray"
3337
| Pboxedintval Pnativeint -> ":nativeint"
3438
| Pboxedintval Pint32 -> ":int32"
3539
| Pboxedintval Pint64 -> ":int64"

‎testsuite/tests/translprim/array_spec.compilers.flat.reference‎

Lines changed: 11 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -1,21 +1,23 @@
11
(setglobal Array_spec!
22
(let
3-
(int_a = (makearray[int] 1 2 3)
4-
float_a = (makearray[float] 1. 2. 3.)
5-
addr_a = (makearray[addr] "a" "b" "c"))
3+
(int_a =[intarray] (makearray[int] 1 2 3)
4+
float_a =[floatarray] (makearray[float] 1. 2. 3.)
5+
addr_a =[addrarray] (makearray[addr] "a" "b" "c"))
66
(seq (array.length[int] int_a) (array.length[float] float_a)
7-
(array.length[addr] addr_a) (function a : int (array.length[gen] a))
7+
(array.length[addr] addr_a)
8+
(function a[genarray] : int (array.length[gen] a))
89
(array.get[int] int_a 0) (array.get[float] float_a 0)
9-
(array.get[addr] addr_a 0) (function a (array.get[gen] a 0))
10+
(array.get[addr] addr_a 0) (function a[genarray] (array.get[gen] a 0))
1011
(array.unsafe_get[int] int_a 0) (array.unsafe_get[float] float_a 0)
1112
(array.unsafe_get[addr] addr_a 0)
12-
(function a (array.unsafe_get[gen] a 0)) (array.set[int] int_a 0 1)
13-
(array.set[float] float_a 0 1.) (array.set[addr] addr_a 0 "a")
14-
(function a x : int (array.set[gen] a 0 x))
13+
(function a[genarray] (array.unsafe_get[gen] a 0))
14+
(array.set[int] int_a 0 1) (array.set[float] float_a 0 1.)
15+
(array.set[addr] addr_a 0 "a")
16+
(function a[genarray] x : int (array.set[gen] a 0 x))
1517
(array.unsafe_set[int] int_a 0 1)
1618
(array.unsafe_set[float] float_a 0 1.)
1719
(array.unsafe_set[addr] addr_a 0 "a")
18-
(function a x : int (array.unsafe_set[gen] a 0 x))
20+
(function a[genarray] x : int (array.unsafe_set[gen] a 0 x))
1921
(let
2022
(eta_gen_len = (function prim stub (array.length[gen] prim))
2123
eta_gen_safe_get =

‎typing/typeopt.ml‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -169,6 +169,10 @@ let value_kind env ty =
169169
Pboxedintval Pint64
170170
| Tconstr(p, _, _) when Path.same p Predef.path_nativeint ->
171171
Pboxedintval Pnativeint
172+
| Tconstr(p, _, _)
173+
when (Path.same p Predef.path_array
174+
|| Path.same p Predef.path_floatarray) ->
175+
Parrayval (array_type_kind env ty)
172176
| Tconstr(p, _, _) ->
173177
if Numbers.Int.Set.mem ty.id visited || fuel <= 0 then
174178
Pgenval

0 commit comments

Comments
 (0)