Skip to content

Commit 22f539e

Browse files
clef-mengasche
authored andcommitted
Add predefined type ['a atomic_loc].
This type will be used for ['a Atomic.Loc.t], as proposed in the RFC ocaml/RFCs#39 We implement this here to be able to use it in the stdlib later, after a bootstrap.
1 parent 9f64f6f commit 22f539e

File tree

5 files changed

+18
-11
lines changed

5 files changed

+18
-11
lines changed

testsuite/tests/match-side-effects/check_partial.ml

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -72,7 +72,7 @@ let lazy_needs_partial : _ * bool t ref -> int = function
7272
*match*/306 =o (field_mut 0 (field_imm 1 param/298)))
7373
(if (isint *match*/306) (if *match*/306 12 (exit 3)) (exit 3)))))
7474
with (3)
75-
(raise (makeblock 0 (global Match_failure/20!) [0: "" 1 49])))))
75+
(raise (makeblock 0 (global Match_failure/21!) [0: "" 1 49])))))
7676
(apply (field_mut 1 (global Toploop!)) "lazy_needs_partial"
7777
lazy_needs_partial/296))
7878
val lazy_needs_partial : unit lazy_t * bool t ref -> int = <fun>
@@ -91,7 +91,7 @@ let guard_total : bool t ref -> int = function
9191
(if (opaque 0) 1
9292
(let (*match*/385 =o (field_mut 0 param/384))
9393
(if (isint *match*/385) (if *match*/385 12 0)
94-
(raise (makeblock 0 (global Match_failure/20!) [0: "" 1 38])))))))
94+
(raise (makeblock 0 (global Match_failure/21!) [0: "" 1 38])))))))
9595
(apply (field_mut 1 (global Toploop!)) "guard_total" guard_total/307))
9696
val guard_total : bool t ref -> int = <fun>
9797
|}];;
@@ -111,7 +111,7 @@ let guard_needs_partial : bool t ref -> int = function
111111
with (9)
112112
(if (opaque 0) 1
113113
(if (isint *match*/389) 12
114-
(raise (makeblock 0 (global Match_failure/20!) [0: "" 1 46]))))))))
114+
(raise (makeblock 0 (global Match_failure/21!) [0: "" 1 46]))))))))
115115
(apply (field_mut 1 (global Toploop!)) "guard_needs_partial"
116116
guard_needs_partial/386))
117117
val guard_needs_partial : bool t ref -> int = <fun>

testsuite/tests/match-side-effects/partiality.ml

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -49,7 +49,7 @@ exception. This typically occurs due to complex matches on mutable fields.
4949
(let (*match*/288 =o (field_mut 1 x/283))
5050
(if *match*/288 (field_imm 0 *match*/288)
5151
(raise
52-
(makeblock 0 (global Match_failure/20!) [0: "" 4 2])))))
52+
(makeblock 0 (global Match_failure/21!) [0: "" 4 2])))))
5353
1))
5454
0)))
5555
(apply (field_mut 1 (global Toploop!)) "f" f/281))
@@ -111,7 +111,7 @@ exception. This typically occurs due to complex matches on mutable fields.
111111
(if *match*/303 (field_imm 0 *match*/303)
112112
(let (*match*/304 =o (field_mut 1 x/299))
113113
(if *match*/304
114-
(raise (makeblock 0 (global Match_failure/20!) [0: "" 2 2]))
114+
(raise (makeblock 0 (global Match_failure/21!) [0: "" 2 2]))
115115
1))))
116116
0)))
117117
(apply (field_mut 1 (global Toploop!)) "f" f/298))
@@ -160,7 +160,7 @@ exception. This typically occurs due to complex matches on mutable fields.
160160
(let (*match*/312 =o (field_mut 0 (field_imm 0 *match*/308)))
161161
(if *match*/312 (field_imm 0 *match*/312)
162162
(raise
163-
(makeblock 0 (global Match_failure/20!) [0: "" 2 2]))))
163+
(makeblock 0 (global Match_failure/21!) [0: "" 2 2]))))
164164
3))))))
165165
(apply (field_mut 1 (global Toploop!)) "f" f/305))
166166
@@ -293,7 +293,7 @@ exception. This typically occurs due to complex matches on mutable fields.
293293
*match*/354 =a (field_imm 1 *match*/352))
294294
(if *match*/354 (field_imm 0 *match*/354)
295295
(raise
296-
(makeblock 0 (global Match_failure/20!) [0: "" 2 2]))))
296+
(makeblock 0 (global Match_failure/21!) [0: "" 2 2]))))
297297
3))))))
298298
(apply (field_mut 1 (global Toploop!)) "deep" deep/342))
299299

testsuite/tests/match-side-effects/test_contexts_code.ml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -44,7 +44,7 @@ let example_1 () =
4444
case tag 0: (makeblock 0 (int) (field_imm 0 *match*/340))
4545
case tag 1:
4646
(raise
47-
(makeblock 0 (global Match_failure/20!)
47+
(makeblock 0 (global Match_failure/21!)
4848
[0: "contexts_1.ml" 17 2])))))
4949
case tag 1: [1: 2]))
5050
[1: 1]))))
@@ -91,7 +91,7 @@ let example_2 () =
9191
case tag 0: (makeblock 0 (int) (field_imm 0 *match*/358))
9292
case tag 1:
9393
(raise
94-
(makeblock 0 (global Match_failure/20!)
94+
(makeblock 0 (global Match_failure/21!)
9595
[0: "contexts_2.ml" 11 2])))))
9696
case tag 1: [1: 2]))
9797
[1: 1]))))

typing/predef.ml

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -47,6 +47,7 @@ and ident_lazy_t = ident_create "lazy_t"
4747
and ident_string = ident_create "string"
4848
and ident_extension_constructor = ident_create "extension_constructor"
4949
and ident_floatarray = ident_create "floatarray"
50+
and ident_atomic_loc = ident_create "atomic_loc"
5051

5152
let path_int = Pident ident_int
5253
and path_char = Pident ident_char
@@ -67,6 +68,7 @@ and path_lazy_t = Pident ident_lazy_t
6768
and path_string = Pident ident_string
6869
and path_extension_constructor = Pident ident_extension_constructor
6970
and path_floatarray = Pident ident_floatarray
71+
and path_atomic_loc = Pident ident_atomic_loc
7072

7173
let type_int = newgenty (Tconstr(path_int, [], ref Mnil))
7274
and type_char = newgenty (Tconstr(path_char, [], ref Mnil))
@@ -89,6 +91,7 @@ and type_string = newgenty (Tconstr(path_string, [], ref Mnil))
8991
and type_extension_constructor =
9092
newgenty (Tconstr(path_extension_constructor, [], ref Mnil))
9193
and type_floatarray = newgenty (Tconstr(path_floatarray, [], ref Mnil))
94+
and type_atomic_loc t = newgenty (Tconstr(path_atomic_loc, [t], ref Mnil))
9295

9396
let ident_match_failure = ident_create "Match_failure"
9497
and ident_out_of_memory = ident_create "Out_of_memory"
@@ -244,6 +247,9 @@ let build_initial_env add_type add_extension empty_env =
244247
|> add_type ident_extension_constructor
245248
|> add_type ident_float
246249
|> add_type ident_floatarray
250+
|> add_type1 ident_atomic_loc
251+
~variance:Variance.full
252+
~separability:Separability.Ind
247253
|> add_type ident_int ~immediate:Always
248254
|> add_type ident_int32
249255
|> add_type ident_int64

typing/predef.mli

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -34,8 +34,9 @@ val type_nativeint: type_expr
3434
val type_int32: type_expr
3535
val type_int64: type_expr
3636
val type_lazy_t: type_expr -> type_expr
37-
val type_extension_constructor:type_expr
38-
val type_floatarray:type_expr
37+
val type_extension_constructor: type_expr
38+
val type_floatarray: type_expr
39+
val type_atomic_loc: type_expr -> type_expr
3940

4041
val path_int: Path.t
4142
val path_char: Path.t

0 commit comments

Comments
 (0)