Source file `PersistentSequence.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
153
154
155
156
157
158
159
160
(******************************************************************************)
(*                                                                            *)
(*                                    Sek                                     *)
(*                                                                            *)
(*          Arthur Charguéraud, Émilie Guermeur and François Pottier          *)
(*                                                                            *)
(*  Copyright Inria. All rights reserved. This file is distributed under the  *)
(*  terms of the GNU Lesser General Public License as published by the Free   *)
(*  Software Foundation, either version 3 of the License, or (at your         *)
(*  option) any later version, as described in the file LICENSE.              *)
(*                                                                            *)
(******************************************************************************)

open PrivateSignatures

module[@inline] Make
    (SSeq : SSEQ)
= struct

(* A persistent sequence is represented as a shareable sequence. *)

(* Every operation on the shareable sequence [s] uses the unit measure (so
   that every element has weight 1) and owner [none]. *)

type 'a schunk =
  'a SSeq.schunk

type 'a t = 'a SSeq.t =
  | Zero  of { default : 'a; }
  | One   of { default : 'a; x : 'a }
  | Short of { default : 'a; a : 'a array }
  | Level of {
      weight : weight;
      front : 'a schunk;
      middle : 'a schunk t;
      back : 'a schunk;
    }

let depth0 = 0

let unit_weight =
  SSeq.MUnit

let create =
  SSeq.create

let[@inline] make default size v =
  SSeq.make default size v Owner.none

let[@inline] init default size f =
  SSeq.init default size f Owner.none

let default =
  SSeq.default

let length =
  SSeq.weight

let is_empty =
  SSeq.is_empty

let[@inline] push pov s x =
  SSeq.push pov s x unit_weight Owner.none depth0

let[@inline] pop pov s =
  SSeq.pop pov s unit_weight Owner.none

let peek =
  SSeq.peek

let[@inline] get s i =
  let _, x = SSeq.get s i unit_weight in
  x

let[@inline] set s i x =
  SSeq.set s i unit_weight Owner.none x

let concat s1 s2 =
  SSeq.concat s1 s2 Owner.none depth0

let split s i =
  assert (0 <= i && i <= length s);
  (* Fast paths. *)
  if i = 0 then
    let default = default s in
    Zero { default }, s
  else if i = length s then
    let default = default s in
    s, Zero { default }
  else begin
    (* We implement a binary split in terms of [three_way_split]. *)
    assert (i < length s);
    let s1, x, s2 = SSeq.three_way_split s i unit_weight Owner.none in
    assert (SSeq.weight s1 = i);
    let s2 = SSeq.push Front s2 x unit_weight Owner.none depth0 in
    s1, s2
  end

let take s i =
  assert (0 <= i && i <= length s);
  (* Fast paths. *)
  if i = 0 then
    let default = default s in
    Zero { default }
  else if i = length s then
    s
  else begin
    (* We implement a binary split in terms of [take]. *)
    let s1, _ = SSeq.take s i unit_weight Owner.none in
    assert (SSeq.weight s1 = i);
    s1
  end

let drop s i =
  assert (0 <= i && i <= length s);
  (* Fast paths. *)
  if i = 0 then
    s
  else if i = length s then
    let default = default s in
    Zero { default }
  else begin
    (* We implement a binary split in terms of [drop]. *)
    assert (0 < i);
    (* A slight twist: we split at [i-1], not [i], so as to avoid
       the need to push [x] into [s2]. *)
    let _, s2 = SSeq.drop s (i - 1) unit_weight Owner.none in
    assert (SSeq.weight s2 = length s - i);
    s2
  end

let sub s head size =
  (* The cost of [take] is about the same as the cost of [reach].
     Thus, if [size] is small, then creating an iterator, moving
     it to the appropriate place, and using it to copy the data
     could be up to twice faster than the code below. However,
     this code still offers the advantage that the data is shared. *)
  take (drop s head) size

let iter_segments =
  SSeq.iter_segments

let to_array =
  SSeq.to_array

let[@inline] of_array_segment default a head size =
  SSeq.of_array_segment default a head size Owner.none

let[@inline] of_array default a =
  of_array_segment default a 0 (Array.length a)

let print element s =
  SSeq.print SSeq.MUnit element s

let check s =
  (* Check that [s] is well-formed, with owner [Owner.none], which
     means that the sequence is considered shared. *)
  SSeq.check s unit_weight Owner.none depth0;

end (* Make *)