Skip to content

Commit d431d3b

Browse files
chambartchambart
authored
flambda-backend: Use the type of primitive declarations to make their layout (#1118)
* Add layout to params of primitives * update tests
1 parent 8da887e commit d431d3b

File tree

4 files changed

+222
-137
lines changed

4 files changed

+222
-137
lines changed

‎lambda/translprim.ml

Lines changed: 10 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -795,11 +795,18 @@ let transl_primitive loc p env ty ~poly_mode path =
795795
| None -> prim
796796
| Some prim -> prim
797797
in
798-
let rec make_params n =
798+
let rec make_params ty n =
799799
if n <= 0 then []
800-
else (Ident.create_local "prim", Lambda.layout_top) :: make_params (n-1)
800+
else
801+
match Typeopt.is_function_type env ty with
802+
| None ->
803+
Misc.fatal_errorf "Primitive %s type does not correspond to arity"
804+
(Primitive.byte_name p)
805+
| Some (arg_ty, ret_ty) ->
806+
let arg_layout = Typeopt.layout env arg_ty in
807+
(Ident.create_local "prim", arg_layout) :: make_params ret_ty (n-1)
801808
in
802-
let params = make_params p.prim_arity in
809+
let params = make_params ty p.prim_arity in
803810
let args = List.map (fun (id, _) -> Lvar id) params in
804811
match params with
805812
| [] -> lambda_of_prim p.prim_name prim loc args None

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

Lines changed: 36 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -19,45 +19,61 @@
1919
(array.unsafe_set[addr] addr_a 0 "a")
2020
(function a[genarray] x : int (array.unsafe_set[gen] a 0 x))
2121
(let
22-
(eta_gen_len = (function prim stub (array.length[gen] prim))
22+
(eta_gen_len =
23+
(function prim[genarray] stub (array.length[gen] prim))
2324
eta_gen_safe_get =
24-
(function prim prim stub (array.get[gen] prim prim))
25+
(function prim[genarray] prim[int] stub
26+
(array.get[gen] prim prim))
2527
eta_gen_unsafe_get =
26-
(function prim prim stub (array.unsafe_get[gen] prim prim))
28+
(function prim[genarray] prim[int] stub
29+
(array.unsafe_get[gen] prim prim))
2730
eta_gen_safe_set =
28-
(function prim prim prim stub (array.set[gen] prim prim prim))
31+
(function prim[genarray] prim[int] prim stub
32+
(array.set[gen] prim prim prim))
2933
eta_gen_unsafe_set =
30-
(function prim prim prim stub
34+
(function prim[genarray] prim[int] prim stub
3135
(array.unsafe_set[gen] prim prim prim))
32-
eta_int_len = (function prim stub (array.length[int] prim))
36+
eta_int_len =
37+
(function prim[intarray] stub (array.length[int] prim))
3338
eta_int_safe_get =
34-
(function prim prim stub (array.get[int] prim prim))
39+
(function prim[intarray] prim[int] stub
40+
(array.get[int] prim prim))
3541
eta_int_unsafe_get =
36-
(function prim prim stub (array.unsafe_get[int] prim prim))
42+
(function prim[intarray] prim[int] stub
43+
(array.unsafe_get[int] prim prim))
3744
eta_int_safe_set =
38-
(function prim prim prim stub (array.set[int] prim prim prim))
45+
(function prim[intarray] prim[int] prim[int] stub
46+
(array.set[int] prim prim prim))
3947
eta_int_unsafe_set =
40-
(function prim prim prim stub
48+
(function prim[intarray] prim[int] prim[int] stub
4149
(array.unsafe_set[int] prim prim prim))
42-
eta_float_len = (function prim stub (array.length[float] prim))
50+
eta_float_len =
51+
(function prim[floatarray] stub (array.length[float] prim))
4352
eta_float_safe_get =
44-
(function prim prim stub (array.get[float] prim prim))
53+
(function prim[floatarray] prim[int] stub
54+
(array.get[float] prim prim))
4555
eta_float_unsafe_get =
46-
(function prim prim stub (array.unsafe_get[float] prim prim))
56+
(function prim[floatarray] prim[int] stub
57+
(array.unsafe_get[float] prim prim))
4758
eta_float_safe_set =
48-
(function prim prim prim stub (array.set[float] prim prim prim))
59+
(function prim[floatarray] prim[int] prim[float] stub
60+
(array.set[float] prim prim prim))
4961
eta_float_unsafe_set =
50-
(function prim prim prim stub
62+
(function prim[floatarray] prim[int] prim[float] stub
5163
(array.unsafe_set[float] prim prim prim))
52-
eta_addr_len = (function prim stub (array.length[addr] prim))
64+
eta_addr_len =
65+
(function prim[addrarray] stub (array.length[addr] prim))
5366
eta_addr_safe_get =
54-
(function prim prim stub (array.get[addr] prim prim))
67+
(function prim[addrarray] prim[int] stub
68+
(array.get[addr] prim prim))
5569
eta_addr_unsafe_get =
56-
(function prim prim stub (array.unsafe_get[addr] prim prim))
70+
(function prim[addrarray] prim[int] stub
71+
(array.unsafe_get[addr] prim prim))
5772
eta_addr_safe_set =
58-
(function prim prim prim stub (array.set[addr] prim prim prim))
73+
(function prim[addrarray] prim[int] prim stub
74+
(array.set[addr] prim prim prim))
5975
eta_addr_unsafe_set =
60-
(function prim prim prim stub
76+
(function prim[addrarray] prim[int] prim stub
6177
(array.unsafe_set[addr] prim prim prim)))
6278
(makeblock 0 int_a float_a addr_a eta_gen_len eta_gen_safe_get
6379
eta_gen_unsafe_get eta_gen_safe_set eta_gen_unsafe_set eta_int_len

‎testsuite/tests/translprim/comparison_table.compilers.reference

Lines changed: 80 additions & 49 deletions
Original file line numberDiff line numberDiff line change
@@ -72,77 +72,108 @@
7272
nativeint_ge =
7373
(function x[nativeint] y[nativeint] : int (Nativeint.>= x y))
7474
eta_gen_cmp = (function prim prim stub (caml_compare prim prim))
75-
eta_int_cmp = (function prim prim stub (compare_ints prim prim))
76-
eta_bool_cmp = (function prim prim stub (compare_ints prim prim))
77-
eta_intlike_cmp = (function prim prim stub (compare_ints prim prim))
78-
eta_float_cmp = (function prim prim stub (compare_floats prim prim))
75+
eta_int_cmp =
76+
(function prim[int] prim[int] stub (compare_ints prim prim))
77+
eta_bool_cmp =
78+
(function prim[int] prim[int] stub (compare_ints prim prim))
79+
eta_intlike_cmp =
80+
(function prim[int] prim[int] stub (compare_ints prim prim))
81+
eta_float_cmp =
82+
(function prim[float] prim[float] stub (compare_floats prim prim))
7983
eta_string_cmp =
8084
(function prim prim stub (caml_string_compare prim prim))
8185
eta_int32_cmp =
82-
(function prim prim stub (compare_bints int32 prim prim))
86+
(function prim[int32] prim[int32] stub
87+
(compare_bints int32 prim prim))
8388
eta_int64_cmp =
84-
(function prim prim stub (compare_bints int64 prim prim))
89+
(function prim[int64] prim[int64] stub
90+
(compare_bints int64 prim prim))
8591
eta_nativeint_cmp =
86-
(function prim prim stub (compare_bints nativeint prim prim))
92+
(function prim[nativeint] prim[nativeint] stub
93+
(compare_bints nativeint prim prim))
8794
eta_gen_eq = (function prim prim stub (caml_equal prim prim))
88-
eta_int_eq = (function prim prim stub (== prim prim))
89-
eta_bool_eq = (function prim prim stub (== prim prim))
90-
eta_intlike_eq = (function prim prim stub (== prim prim))
91-
eta_float_eq = (function prim prim stub (==. prim prim))
95+
eta_int_eq = (function prim[int] prim[int] stub (== prim prim))
96+
eta_bool_eq = (function prim[int] prim[int] stub (== prim prim))
97+
eta_intlike_eq = (function prim[int] prim[int] stub (== prim prim))
98+
eta_float_eq = (function prim[float] prim[float] stub (==. prim prim))
9299
eta_string_eq = (function prim prim stub (caml_string_equal prim prim))
93-
eta_int32_eq = (function prim prim stub (Int32.== prim prim))
94-
eta_int64_eq = (function prim prim stub (Int64.== prim prim))
95-
eta_nativeint_eq = (function prim prim stub (Nativeint.== prim prim))
100+
eta_int32_eq =
101+
(function prim[int32] prim[int32] stub (Int32.== prim prim))
102+
eta_int64_eq =
103+
(function prim[int64] prim[int64] stub (Int64.== prim prim))
104+
eta_nativeint_eq =
105+
(function prim[nativeint] prim[nativeint] stub
106+
(Nativeint.== prim prim))
96107
eta_gen_ne = (function prim prim stub (caml_notequal prim prim))
97-
eta_int_ne = (function prim prim stub (!= prim prim))
98-
eta_bool_ne = (function prim prim stub (!= prim prim))
99-
eta_intlike_ne = (function prim prim stub (!= prim prim))
100-
eta_float_ne = (function prim prim stub (!=. prim prim))
108+
eta_int_ne = (function prim[int] prim[int] stub (!= prim prim))
109+
eta_bool_ne = (function prim[int] prim[int] stub (!= prim prim))
110+
eta_intlike_ne = (function prim[int] prim[int] stub (!= prim prim))
111+
eta_float_ne = (function prim[float] prim[float] stub (!=. prim prim))
101112
eta_string_ne =
102113
(function prim prim stub (caml_string_notequal prim prim))
103-
eta_int32_ne = (function prim prim stub (Int32.!= prim prim))
104-
eta_int64_ne = (function prim prim stub (Int64.!= prim prim))
105-
eta_nativeint_ne = (function prim prim stub (Nativeint.!= prim prim))
114+
eta_int32_ne =
115+
(function prim[int32] prim[int32] stub (Int32.!= prim prim))
116+
eta_int64_ne =
117+
(function prim[int64] prim[int64] stub (Int64.!= prim prim))
118+
eta_nativeint_ne =
119+
(function prim[nativeint] prim[nativeint] stub
120+
(Nativeint.!= prim prim))
106121
eta_gen_lt = (function prim prim stub (caml_lessthan prim prim))
107-
eta_int_lt = (function prim prim stub (< prim prim))
108-
eta_bool_lt = (function prim prim stub (< prim prim))
109-
eta_intlike_lt = (function prim prim stub (< prim prim))
110-
eta_float_lt = (function prim prim stub (<. prim prim))
122+
eta_int_lt = (function prim[int] prim[int] stub (< prim prim))
123+
eta_bool_lt = (function prim[int] prim[int] stub (< prim prim))
124+
eta_intlike_lt = (function prim[int] prim[int] stub (< prim prim))
125+
eta_float_lt = (function prim[float] prim[float] stub (<. prim prim))
111126
eta_string_lt =
112127
(function prim prim stub (caml_string_lessthan prim prim))
113-
eta_int32_lt = (function prim prim stub (Int32.< prim prim))
114-
eta_int64_lt = (function prim prim stub (Int64.< prim prim))
115-
eta_nativeint_lt = (function prim prim stub (Nativeint.< prim prim))
128+
eta_int32_lt =
129+
(function prim[int32] prim[int32] stub (Int32.< prim prim))
130+
eta_int64_lt =
131+
(function prim[int64] prim[int64] stub (Int64.< prim prim))
132+
eta_nativeint_lt =
133+
(function prim[nativeint] prim[nativeint] stub
134+
(Nativeint.< prim prim))
116135
eta_gen_gt = (function prim prim stub (caml_greaterthan prim prim))
117-
eta_int_gt = (function prim prim stub (> prim prim))
118-
eta_bool_gt = (function prim prim stub (> prim prim))
119-
eta_intlike_gt = (function prim prim stub (> prim prim))
120-
eta_float_gt = (function prim prim stub (>. prim prim))
136+
eta_int_gt = (function prim[int] prim[int] stub (> prim prim))
137+
eta_bool_gt = (function prim[int] prim[int] stub (> prim prim))
138+
eta_intlike_gt = (function prim[int] prim[int] stub (> prim prim))
139+
eta_float_gt = (function prim[float] prim[float] stub (>. prim prim))
121140
eta_string_gt =
122141
(function prim prim stub (caml_string_greaterthan prim prim))
123-
eta_int32_gt = (function prim prim stub (Int32.> prim prim))
124-
eta_int64_gt = (function prim prim stub (Int64.> prim prim))
125-
eta_nativeint_gt = (function prim prim stub (Nativeint.> prim prim))
142+
eta_int32_gt =
143+
(function prim[int32] prim[int32] stub (Int32.> prim prim))
144+
eta_int64_gt =
145+
(function prim[int64] prim[int64] stub (Int64.> prim prim))
146+
eta_nativeint_gt =
147+
(function prim[nativeint] prim[nativeint] stub
148+
(Nativeint.> prim prim))
126149
eta_gen_le = (function prim prim stub (caml_lessequal prim prim))
127-
eta_int_le = (function prim prim stub (<= prim prim))
128-
eta_bool_le = (function prim prim stub (<= prim prim))
129-
eta_intlike_le = (function prim prim stub (<= prim prim))
130-
eta_float_le = (function prim prim stub (<=. prim prim))
150+
eta_int_le = (function prim[int] prim[int] stub (<= prim prim))
151+
eta_bool_le = (function prim[int] prim[int] stub (<= prim prim))
152+
eta_intlike_le = (function prim[int] prim[int] stub (<= prim prim))
153+
eta_float_le = (function prim[float] prim[float] stub (<=. prim prim))
131154
eta_string_le =
132155
(function prim prim stub (caml_string_lessequal prim prim))
133-
eta_int32_le = (function prim prim stub (Int32.<= prim prim))
134-
eta_int64_le = (function prim prim stub (Int64.<= prim prim))
135-
eta_nativeint_le = (function prim prim stub (Nativeint.<= prim prim))
156+
eta_int32_le =
157+
(function prim[int32] prim[int32] stub (Int32.<= prim prim))
158+
eta_int64_le =
159+
(function prim[int64] prim[int64] stub (Int64.<= prim prim))
160+
eta_nativeint_le =
161+
(function prim[nativeint] prim[nativeint] stub
162+
(Nativeint.<= prim prim))
136163
eta_gen_ge = (function prim prim stub (caml_greaterequal prim prim))
137-
eta_int_ge = (function prim prim stub (>= prim prim))
138-
eta_bool_ge = (function prim prim stub (>= prim prim))
139-
eta_intlike_ge = (function prim prim stub (>= prim prim))
140-
eta_float_ge = (function prim prim stub (>=. prim prim))
164+
eta_int_ge = (function prim[int] prim[int] stub (>= prim prim))
165+
eta_bool_ge = (function prim[int] prim[int] stub (>= prim prim))
166+
eta_intlike_ge = (function prim[int] prim[int] stub (>= prim prim))
167+
eta_float_ge = (function prim[float] prim[float] stub (>=. prim prim))
141168
eta_string_ge =
142169
(function prim prim stub (caml_string_greaterequal prim prim))
143-
eta_int32_ge = (function prim prim stub (Int32.>= prim prim))
144-
eta_int64_ge = (function prim prim stub (Int64.>= prim prim))
145-
eta_nativeint_ge = (function prim prim stub (Nativeint.>= prim prim))
170+
eta_int32_ge =
171+
(function prim[int32] prim[int32] stub (Int32.>= prim prim))
172+
eta_int64_ge =
173+
(function prim[int64] prim[int64] stub (Int64.>= prim prim))
174+
eta_nativeint_ge =
175+
(function prim[nativeint] prim[nativeint] stub
176+
(Nativeint.>= prim prim))
146177
int_vec =[(consts (0))
147178
(non_consts ([0: *, [(consts (0)) (non_consts ([0: *, *]))]]))]
148179
[0: [0: 1 1] [0: [0: 1 2] [0: [0: 2 1] 0]]]

0 commit comments

Comments
 (0)