Source file import.ml

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
143
144
145
146
147
148
149
150
151
152
open! Base
module Int8 = Stdlib_stable.Int8
module Int16 = Stdlib_stable.Int16
module Option_u = Unboxed_datatypes.Option_u

module%template Array : sig @@ portable
  include module type of Array

  [@@@kind.default k = base_or_null]

  val length : ('a : k mod separable). 'a t @ contended -> int
  val unsafe_create_uninitialized : ('a : k mod non_float). int -> 'a t

  val unsafe_racy_get_contended
    : ('a : k mod separable).
    'a t @ contended -> int -> 'a @ contended

  val unsafe_racy_set_contended
    : ('a : k mod separable).
    'a t @ contended -> int -> 'a -> unit

  val set : ('a : k mod separable). 'a t -> int -> 'a -> unit
  val unsafe_set : ('a : k mod separable). 'a t -> int -> 'a -> unit

  [@@@mode.default m = (uncontended, shared)]

  val copy : ('a : k mod separable). 'a t @ m -> 'a t @ m
  val get : ('a : k mod separable). 'a t @ m -> int -> 'a @ m
  val unsafe_get : ('a : k mod separable). 'a t @ m -> int -> 'a @ m
end = struct
  include Array

  let[@inline] unsafe_create_uninitialized len =
    (* It's possible to use this safely because ('a : value mod non_float) *)
    create ~len (Obj.magic None)
  ;;

  external unsafe_create_uninitialized
    :  int
    -> ('a : bits32 mod non_float) t
    @@ portable
    = "caml_make_unboxed_int32_vect_bytecode" "caml_make_unboxed_int32_vect"
  [@@kind bits32]

  external unsafe_create_uninitialized
    :  int
    -> ('a : bits64 mod non_float) t
    @@ portable
    = "caml_make_unboxed_int64_vect_bytecode" "caml_make_unboxed_int64_vect"
  [@@kind bits64]

  external unsafe_create_uninitialized
    :  int
    -> ('a : float32 mod non_float) t
    @@ portable
    = "caml_make_unboxed_float32_vect_bytecode" "caml_make_unboxed_float32_vect"
  [@@kind float32]

  external unsafe_create_uninitialized
    :  int
    -> ('a : float64 mod non_float) t
    @@ portable
    = "caml_floatarray_create"
  [@@kind float64]

  external unsafe_create_uninitialized
    :  int
    -> ('a : word mod non_float) t
    @@ portable
    = "caml_make_unboxed_nativeint_vect_bytecode" "caml_make_unboxed_nativeint_vect"
  [@@kind word]

  external unsafe_racy_get_contended
    : ('a : any mod separable).
    'a t @ contended -> int -> 'a @ contended
    @@ portable
    = "%array_unsafe_get"
  [@@layout_poly]

  external unsafe_racy_set_contended
    : ('a : any mod separable).
    'a t @ contended -> int -> 'a -> unit
    @@ portable
    = "%array_unsafe_set"
  [@@layout_poly]

  [@@@kind.default k = base_or_null]

  let length = length
  let set = set
  let unsafe_set = unsafe_set
  let unsafe_racy_get_contended = unsafe_racy_get_contended
  let unsafe_racy_set_contended = unsafe_racy_set_contended

  [@@@mode.default m = (uncontended, shared)]

  let get = (get [@mode m])
  let unsafe_get = (unsafe_get [@mode m])
  let[@inline] copy t = (copy [@kind k]) (Obj.magic_uncontended t)
end

module%template Iarray : sig @@ portable
  include module type of Iarray

  [@@@kind.default k = base_or_null]

  val length : ('a : k mod separable). 'a t @ contended -> int

  val unsafe_racy_get_contended
    : ('a : k mod separable).
    'a t @ contended -> int -> 'a @ contended

  [@@@mode.default m = (uncontended, shared)]

  val get : ('a : k mod separable). 'a t @ m -> int -> 'a @ m
  val unsafe_get : ('a : k mod separable). 'a t @ m -> int -> 'a @ m

  val unsafe_to_array__promise_no_mutation
    : ('a : k mod separable).
    'a t @ m -> 'a array @ m

  val unsafe_of_array__promise_no_mutation
    : ('a : k mod separable).
    'a array @ m -> 'a t @ m
end = struct
  include Iarray

  external unsafe_racy_get_contended
    : ('a : any mod separable).
    'a t @ contended -> int -> 'a @ contended
    @@ portable
    = "%array_unsafe_get"
  [@@layout_poly]

  [@@@kind.default k = base_or_null]

  let length = length
  let unsafe_racy_get_contended = unsafe_racy_get_contended

  [@@@mode.default m = (uncontended, shared)]

  let get = (get [@mode m])
  let unsafe_get = (unsafe_get [@mode m])

  let unsafe_to_array__promise_no_mutation =
    (unsafe_to_array__promise_no_mutation [@mode m])
  ;;

  let unsafe_of_array__promise_no_mutation =
    (unsafe_of_array__promise_no_mutation [@mode m])
  ;;
end