Skip to content

Commit a484f3b

Browse files
authored
Add attributes effects and coeffects (#18)
* Add effects/coeffects attributes to Primitives Effects/coeffects of an external builtin can be specified using the attributes: [@@no_coeffects] [@@no_effects] [@@only_generative_effects] * Conservative effects and coeffects without [@@noalloc]. * Bootstrap
1 parent cf7523d commit a484f3b

File tree

7 files changed

+80
-1
lines changed

7 files changed

+80
-1
lines changed

backend/cmm_helpers.ml

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1417,9 +1417,14 @@ let default_prim name =
14171417
let int64_native_prim name arity ~alloc =
14181418
let u64 = Primitive.Unboxed_integer Primitive.Pint64 in
14191419
let rec make_args = function 0 -> [] | n -> u64 :: make_args (n - 1) in
1420+
let effects, coeffects =
1421+
if alloc
1422+
then Primitive.Arbitrary_effects, Primitive.Has_coeffects
1423+
else Primitive.No_effects, Primitive.No_coeffects in
14201424
Primitive.make ~name ~native_name:(name ^ "_native")
14211425
~alloc
14221426
~c_builtin:false
1427+
~effects ~coeffects
14231428
~native_repr_args:(make_args arity)
14241429
~native_repr_res:u64
14251430

middle_end/flambda2/from_lambda/closure_conversion.ml

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -173,6 +173,8 @@ let close_c_call acc ~let_bound_var
173173
prim_arity;
174174
prim_alloc;
175175
prim_c_builtin;
176+
prim_effects = _;
177+
prim_coeffects = _;
176178
prim_native_name;
177179
prim_native_repr_args;
178180
prim_native_repr_res

ocaml/asmcomp/cmm_helpers.ml

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1356,9 +1356,12 @@ let default_prim name =
13561356
let int64_native_prim name arity ~alloc =
13571357
let u64 = Primitive.Unboxed_integer Primitive.Pint64 in
13581358
let rec make_args = function 0 -> [] | n -> u64 :: make_args (n - 1) in
1359+
let effects = Primitive.Arbitrary_effects in
1360+
let coeffects = Primitive.Has_coeffects in
13591361
Primitive.make ~name ~native_name:(name ^ "_native")
13601362
~alloc
13611363
~c_builtin:false
1364+
~effects ~coeffects
13621365
~native_repr_args:(make_args arity)
13631366
~native_repr_res:u64
13641367

ocaml/boot/ocamlc

1.14 KB
Binary file not shown.

ocaml/boot/ocamllex

0 Bytes
Binary file not shown.

ocaml/typing/primitive.ml

Lines changed: 60 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -26,11 +26,16 @@ type native_repr =
2626
| Unboxed_integer of boxed_integer
2727
| Untagged_int
2828

29+
type effects = No_effects | Only_generative_effects | Arbitrary_effects
30+
type coeffects = No_coeffects | Has_coeffects
31+
2932
type description =
3033
{ prim_name: string; (* Name of primitive or C function *)
3134
prim_arity: int; (* Number of arguments *)
3235
prim_alloc: bool; (* Does it allocates or raise? *)
3336
prim_c_builtin: bool; (* Is the compiler allowed to replace it? *)
37+
prim_effects: effects;
38+
prim_coeffects: coeffects;
3439
prim_native_name: string; (* Name of C function for the nat. code gen. *)
3540
prim_native_repr_args: native_repr list;
3641
prim_native_repr_res: native_repr }
@@ -39,6 +44,8 @@ type error =
3944
| Old_style_float_with_native_repr_attribute
4045
| Old_style_noalloc_with_noalloc_attribute
4146
| No_native_primitive_with_repr_attribute
47+
| Inconsistent_attributes_for_effects
48+
| Inconsistent_noalloc_attributes_for_effects
4249

4350
exception Error of Location.t * error
4451

@@ -71,16 +78,20 @@ let simple ~name ~arity ~alloc =
7178
prim_arity = arity;
7279
prim_alloc = alloc;
7380
prim_c_builtin = false;
81+
prim_effects = Arbitrary_effects;
82+
prim_coeffects = Has_coeffects;
7483
prim_native_name = "";
7584
prim_native_repr_args = make_native_repr_args arity Same_as_ocaml_repr;
7685
prim_native_repr_res = Same_as_ocaml_repr}
7786

78-
let make ~name ~alloc ~c_builtin
87+
let make ~name ~alloc ~c_builtin ~effects ~coeffects
7988
~native_name ~native_repr_args ~native_repr_res =
8089
{prim_name = name;
8190
prim_arity = List.length native_repr_args;
8291
prim_alloc = alloc;
8392
prim_c_builtin = c_builtin;
93+
prim_effects = effects;
94+
prim_coeffects = coeffects;
8495
prim_native_name = native_name;
8596
prim_native_repr_args = native_repr_args;
8697
prim_native_repr_res = native_repr_res}
@@ -106,6 +117,31 @@ let parse_declaration valdecl ~native_repr_args ~native_repr_res =
106117
Attr_helper.has_no_payload_attribute ["builtin"; "ocaml.builtin"]
107118
valdecl.pval_attributes
108119
in
120+
let no_effects_attribute =
121+
Attr_helper.has_no_payload_attribute ["no_effects"; "ocaml.no_effects"]
122+
valdecl.pval_attributes
123+
in
124+
let only_generative_effects_attribute =
125+
Attr_helper.has_no_payload_attribute ["only_generative_effects";
126+
"ocaml.only_generative_effects"]
127+
valdecl.pval_attributes
128+
in
129+
if no_effects_attribute && only_generative_effects_attribute then
130+
raise (Error (valdecl.pval_loc,
131+
Inconsistent_attributes_for_effects));
132+
let effects =
133+
if no_effects_attribute then No_effects
134+
else if only_generative_effects_attribute then Only_generative_effects
135+
else Arbitrary_effects
136+
in
137+
let no_coeffects_attribute =
138+
Attr_helper.has_no_payload_attribute ["no_coeffects"; "ocaml.no_coeffects"]
139+
valdecl.pval_attributes
140+
in
141+
let coeffects =
142+
if no_coeffects_attribute then No_coeffects
143+
else Has_coeffects
144+
in
109145
if old_style_float &&
110146
not (List.for_all is_ocaml_repr native_repr_args &&
111147
is_ocaml_repr native_repr_res) then
@@ -130,6 +166,9 @@ let parse_declaration valdecl ~native_repr_args ~native_repr_res =
130166
raise (Error (valdecl.pval_loc,
131167
No_native_primitive_with_repr_attribute));
132168
let noalloc = old_style_noalloc || noalloc_attribute in
169+
if noalloc && only_generative_effects_attribute then
170+
raise (Error (valdecl.pval_loc,
171+
Inconsistent_noalloc_attributes_for_effects));
133172
let native_repr_args, native_repr_res =
134173
if old_style_float then
135174
(make_native_repr_args arity Unboxed_float, Unboxed_float)
@@ -140,6 +179,8 @@ let parse_declaration valdecl ~native_repr_args ~native_repr_res =
140179
prim_arity = arity;
141180
prim_alloc = not noalloc;
142181
prim_c_builtin = builtin_attribute;
182+
prim_effects = effects;
183+
prim_coeffects = coeffects;
143184
prim_native_name = native_name;
144185
prim_native_repr_args = native_repr_args;
145186
prim_native_repr_res = native_repr_res}
@@ -165,6 +206,9 @@ let oattr_unboxed = { oattr_name = "unboxed" }
165206
let oattr_untagged = { oattr_name = "untagged" }
166207
let oattr_noalloc = { oattr_name = "noalloc" }
167208
let oattr_builtin = { oattr_name = "builtin" }
209+
let oattr_no_effects = { oattr_name = "no_effects" }
210+
let oattr_only_generative_effects = { oattr_name = "only_generative_effects" }
211+
let oattr_no_coeffects = { oattr_name = "no_coeffects" }
168212

169213
let print p osig_val_decl =
170214
let prims =
@@ -180,6 +224,15 @@ let print p osig_val_decl =
180224
let all_untagged = for_all is_untagged in
181225
let attrs = if p.prim_alloc then [] else [oattr_noalloc] in
182226
let attrs = if p.prim_c_builtin then oattr_builtin::attrs else attrs in
227+
let attrs = match p.prim_effects with
228+
| No_effects -> oattr_no_effects::attrs
229+
| Only_generative_effects -> oattr_only_generative_effects::attrs
230+
| Arbitrary_effects -> attrs
231+
in
232+
let attrs = match p.prim_coeffects with
233+
| No_coeffects -> oattr_no_coeffects::attrs
234+
| Has_coeffects -> attrs
235+
in
183236
let attrs =
184237
if all_unboxed then
185238
oattr_unboxed :: attrs
@@ -227,6 +280,12 @@ let report_error ppf err =
227280
Format.fprintf ppf
228281
"[@The native code version of the primitive is mandatory@ \
229282
when attributes [%@untagged] or [%@unboxed] are present.@]"
283+
| Inconsistent_attributes_for_effects ->
284+
Format.fprintf ppf "At most one of [%@no_effects] and \
285+
[%@only_generative_effects] can be specified."
286+
| Inconsistent_noalloc_attributes_for_effects ->
287+
Format.fprintf ppf "Cannot use [%@%@no_generative_effects] \
288+
in conjunction with [%@%@noalloc]."
230289

231290
let () =
232291
Location.register_error_of_exn

ocaml/typing/primitive.mli

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -25,6 +25,10 @@ type native_repr =
2525
| Unboxed_integer of boxed_integer
2626
| Untagged_int
2727

28+
(* See [middle_end/semantics_of_primitives.mli] *)
29+
type effects = No_effects | Only_generative_effects | Arbitrary_effects
30+
type coeffects = No_coeffects | Has_coeffects
31+
2832
type description = private
2933
{ prim_name: string; (* Name of primitive or C function *)
3034
prim_arity: int; (* Number of arguments *)
@@ -35,6 +39,8 @@ type description = private
3539
based on its name [prim_name], into a predetermined instruction sequence.
3640
[prim_c_builtin] is ignored on compiler primitives
3741
whose name [prim_name] starts with %. *)
42+
prim_effects: effects;
43+
prim_coeffects: coeffects;
3844
prim_native_name: string; (* Name of C function for the nat. code gen. *)
3945
prim_native_repr_args: native_repr list;
4046
prim_native_repr_res: native_repr }
@@ -51,6 +57,8 @@ val make
5157
: name:string
5258
-> alloc:bool
5359
-> c_builtin:bool
60+
-> effects:effects
61+
-> coeffects:coeffects
5462
-> native_name:string
5563
-> native_repr_args: native_repr list
5664
-> native_repr_res: native_repr
@@ -79,5 +87,7 @@ type error =
7987
| Old_style_float_with_native_repr_attribute
8088
| Old_style_noalloc_with_noalloc_attribute
8189
| No_native_primitive_with_repr_attribute
90+
| Inconsistent_attributes_for_effects
91+
| Inconsistent_noalloc_attributes_for_effects
8292

8393
exception Error of Location.t * error

0 commit comments

Comments
 (0)