jon.recoil.org

Source file iarray0.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
open! Import0

(** Abstract type and unsafe casts *)

type (+'a : any mod separable) t = 'a iarray

[%%template
[@@@mode.default c = (uncontended, shared)]

(* This one should not operate on local arrays, because that would be more unsafe:
   extraction from a local array gets *global* elements. So if this function worked on
   local arrays it could be used to forget that a value was local by storing it in a local
   iarray, converting, and then extracting from the local array. *)
external unsafe_to_array__promise_no_mutation
  : ('a : any mod separable).
  'a t @ c -> 'a array @ c
  @@ portable
  = "%array_of_iarray"

(* In contrast to the function above, this one is safe to work on locals. Well, just as
   safe as it is on globals. *)
external unsafe_of_array__promise_no_mutation
  : ('a : any mod separable).
  ('a array[@local_opt]) @ c -> ('a t[@local_opt]) @ c
  @@ portable
  = "%array_to_iarray"]

(** Operators *)

module O = struct
  external ( .:() )
    : ('a : any mod separable).
    ('a t[@local_opt]) -> int -> ('a[@local_opt])
    @@ portable
    = "%array_safe_get"
  [@@layout_poly]
end

open O

(** Indexing and length *)

[%%template
[@@@mode.default c = (uncontended, shared, contended), p = (portable, nonportable)]

external get
  : ('a : any mod separable).
  ('a t[@local_opt]) @ c p -> int -> ('a[@local_opt]) @ c p
  @@ portable
  = "%array_safe_get"
[@@layout_poly]

external unsafe_get
  : ('a : any mod separable).
  ('a t[@local_opt]) @ c p -> int -> ('a[@local_opt]) @ c p
  @@ portable
  = "%array_unsafe_get"
[@@layout_poly]]

external length
  : ('a : any mod separable).
  ('a t[@local_opt]) @ immutable -> int
  @@ portable
  = "%array_length"
[@@layout_poly]

(** Constructors *)

let init len ~f = unsafe_of_array__promise_no_mutation (Array.init len ~f)

(** Transformations *)

let map t ~f = init (length t) ~f:(fun i -> f (unsafe_get t i)) [@nontail]

let%template equal equal_elt ta tb =
  if phys_equal ta tb
  then true
  else (
    let na = length ta in
    let nb = length tb in
    match na = nb with
    | false -> false
    | true ->
      let rec local_ loop pos =
        if pos = na
        then true
        else equal_elt (unsafe_get ta pos) (unsafe_get tb pos) && loop (pos + 1)
      in
      loop 0 [@nontail])
[@@mode __ = (local, global)]
;;

(* sexp serialization is copied from that of [array] in [Sexplib0] *)

let sexp_of_t sexp_of__a ar =
  let lst_ref = ref [] in
  for i = length ar - 1 downto 0 do
    lst_ref := sexp_of__a ar.:(i) :: !lst_ref
  done;
  Sexp0.List !lst_ref
;;

let%template[@alloc stack] sexp_of_t sexp_of__a ar = exclave_
  let rec loop i acc = exclave_
    if i < 0 then Sexp0.List acc else loop (i - 1) (sexp_of__a (get ar i) :: acc)
  in
  loop (length ar - 1) []
;;