1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
external box_int64 : (int64#[@unboxed]) -> int64 @ local @@ portable = "%box_int64"
external unbox_int64 : int64 @ local -> (int64#[@unboxed]) @@ portable = "%unbox_int64"
external box_float : (float#[@unboxed]) -> float @ local @@ portable = "%box_float"
external unbox_float : float @ local -> (float#[@unboxed]) @@ portable = "%unbox_float"
external bits_of_float
: float @ local
-> int64 @ local
@@ portable
= "caml_int64_bits_of_float" "caml_int64_bits_of_float_unboxed"
[@@unboxed] [@@noalloc] [@@builtin]
external float_of_bits
: int64 @ local
-> float @ local
@@ portable
= "caml_int64_float_of_bits" "caml_int64_float_of_bits_unboxed"
[@@unboxed] [@@noalloc] [@@builtin]
let[@inline] bits_of_float f = unbox_int64 (bits_of_float (box_float f))
let[@inline] float_of_bits i = unbox_float (float_of_bits (box_int64 i))
[%%template
[@@@mode.default c = (uncontended, shared, contended)]
external magic
: ('a : any) ('b : any).
('a[@local_opt]) @ c -> ('b[@local_opt]) @ c
@@ portable
= "%identity"
[@@layout_poly]
external select
: bool
-> (int32#[@unboxed])
-> (int32#[@unboxed])
-> (int32#[@unboxed])
@@ portable
= "caml_csel_value" "caml_csel_int32_unboxed"
[@@kind k = bits32] [@@noalloc] [@@no_effects] [@@no_coeffects] [@@builtin]
external select
: bool
-> (int64#[@unboxed])
-> (int64#[@unboxed])
-> (int64#[@unboxed])
@@ portable
= "caml_csel_value" "caml_csel_int64_unboxed"
[@@kind k = bits64] [@@noalloc] [@@no_effects] [@@no_coeffects] [@@builtin]
external select
: bool
-> (nativeint#[@unboxed])
-> (nativeint#[@unboxed])
-> (nativeint#[@unboxed])
@@ portable
= "caml_csel_value" "caml_csel_nativeint_unboxed"
[@@kind k = word] [@@noalloc] [@@no_effects] [@@no_coeffects] [@@builtin]
[@@@mode.default m = (local, global)]
external select
: ('a : k).
bool -> ('a[@local_opt]) @ c -> ('a[@local_opt]) @ c -> ('a[@local_opt]) @ c
@@ portable
= "caml_csel_value"
[@@kind k = value_or_null_with_imm]
[@@noalloc]
[@@no_effects]
[@@no_coeffects]
[@@builtin]
let[@inline] select : type (a : k). bool -> a @ c m -> a @ c m -> a @ c m =
fun if_ then_ else_ ->
(magic [@mode c])
((select [@kind k] [@mode c]) if_ ((magic [@mode c]) then_) ((magic [@mode c]) else_))
[@@kind k = (bits32, bits64, word)]
;;
let[@inline] select : type (a : k). bool -> a @ c m -> a @ c m -> a @ c m =
fun if_ then_ else_ ->
(magic [@mode c])
(float_of_bits
((select [@kind bits64])
if_
(bits_of_float ((magic [@mode c]) then_))
(bits_of_float ((magic [@mode c]) else_))))
[@@kind k = float64]
;;
let[@inline] select : type (a : k). bool -> a @ c m -> a @ c m -> a @ c m =
fun if_ then_ else_ -> if if_ then then_ else else_
[@@kind k = float32]
;;
let[@inline] select : type (a : k). bool -> a @ c m -> a @ c m -> a @ c m =
fun if_ then_ else_ ->
(let #(then1, then2) : #(Stdlib.Obj.t * Stdlib.Obj.t) = (magic [@mode c]) then_ in
let #(else1, else2) : #(Stdlib.Obj.t * Stdlib.Obj.t) = (magic [@mode c]) else_ in
let r1 = (select [@kind value_or_null] [@mode m c]) if_ then1 else1 in
let r2 = (select [@kind value_or_null] [@mode m c]) if_ then2 else2 in
((magic [@mode c]) #(r1, r2) : a))
[@exclave_if_local m ~reasons:[ May_return_regional ]]
[@@kind k = (value & value)]
;;
let[@inline] select : type (a : k). bool -> a @ c m -> a @ c m -> a @ c m =
fun if_ then_ else_ ->
(let #(then1, then2, then3) : #(Stdlib.Obj.t * Stdlib.Obj.t * Stdlib.Obj.t) =
(magic [@mode c]) then_
in
let #(else1, else2, else3) : #(Stdlib.Obj.t * Stdlib.Obj.t * Stdlib.Obj.t) =
(magic [@mode c]) else_
in
let r1 = (select [@kind value_or_null] [@mode m c]) if_ then1 else1 in
let r2 = (select [@kind value_or_null] [@mode m c]) if_ then2 else2 in
let r3 = (select [@kind value_or_null] [@mode m c]) if_ then3 else3 in
((magic [@mode c]) #(r1, r2, r3) : a))
[@exclave_if_local m ~reasons:[ May_return_regional ]]
[@@kind k = (value & value & value)]
;;
let[@inline] select : type (a : k). bool -> a @ c m -> a @ c m -> a @ c m =
fun if_ then_ else_ ->
(let #(then1, then2, then3, then4)
: #(Stdlib.Obj.t * Stdlib.Obj.t * Stdlib.Obj.t * Stdlib.Obj.t)
=
(magic [@mode c]) then_
in
let #(else1, else2, else3, else4)
: #(Stdlib.Obj.t * Stdlib.Obj.t * Stdlib.Obj.t * Stdlib.Obj.t)
=
(magic [@mode c]) else_
in
let r1 = (select [@kind value_or_null] [@mode m c]) if_ then1 else1 in
let r2 = (select [@kind value_or_null] [@mode m c]) if_ then2 else2 in
let r3 = (select [@kind value_or_null] [@mode m c]) if_ then3 else3 in
let r4 = (select [@kind value_or_null] [@mode m c]) if_ then4 else4 in
((magic [@mode c]) #(r1, r2, r3, r4) : a))
[@exclave_if_local m ~reasons:[ May_return_regional ]]
[@@kind k = (value & value & value & value)]
;;]