Source file `SupplyDefault.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
(******************************************************************************)
(*                                                                            *)
(*                                    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 PublicSignature

(* This functor allows providing a [default] element up front, once and for
   all, thereby removing the need from passing it as an argument to [create],
   [of_array], etc. *)

(* Although this code is reasonably short, the signature of this functor is
   quite long, as it is a variant of the signature [SEK]. For this reason,
   we do not provide an [.mli] file. *)

(* The repetition between the ephemeral variant and the persistent variant
   could be eliminated by introducing a helper functor. However, tolerating
   this repetition leads to more readable code. *)

module[@inline] SupplyDefault
  (S : SEK)
  (D : sig type element val default: element end)
= struct

  (* In OCaml < 4.08, we cannot include [S] here.
     We list its toplevel components. *)
  type side = S.side
  let front = S.front
  let back = S.back
  let other = S.other
  type direction = S.direction
  let forward = S.forward
  let backward = S.backward
  let opposite = S.opposite
  let sign = S.sign
  exception Empty = S.Empty
  exception End = S.End
  let snapshot = S.snapshot
  let snapshot_and_clear = S.snapshot_and_clear
  let edit = S.edit
  let released = S.released

  module Ephemeral = struct
    include S.Ephemeral
    open D
    (* In OCaml < 4.08, we cannot redefine the type [t]. *)
    (* type t = element E.t *)
    let[@inline] create () = create default
    let[@inline] make n v = make default n v
    let[@inline] init n f = init default n f
    let[@inline] of_list_segment n xs = of_list_segment default n xs
    let[@inline] of_list xs = of_list default xs
    let[@inline] of_array_segment a i k = of_array_segment default a i k
    let[@inline] of_array a = of_array default a
    let[@inline] of_seq_segment n xs = of_seq_segment default n xs
    let[@inline] of_seq xs = of_seq default xs
  end (* E *)

  module Persistent = struct
    include S.Persistent
    open D
    (* In OCaml < 4.08, we cannot redefine the type [t]. *)
    (* type t = element P.t *)
    let[@inline] create () = create default
    let empty = create()
    let[@inline] make n v = make default n v
    let[@inline] init n f = init default n f
    let[@inline] of_list_segment n xs = of_list_segment default n xs
    let[@inline] of_list xs = of_list default xs
    let[@inline] of_array_segment a i k = of_array_segment default a i k
    let[@inline] of_array a = of_array default a
    let[@inline] of_seq_segment n xs = of_seq_segment default n xs
    let[@inline] of_seq xs = of_seq default xs
    let[@inline] map f s = map default f s
    let[@inline] mapi f s = mapi default f s
    let[@inline] filter_map f s = filter_map default f s
    let[@inline] flatten_map f s = flatten_map default f s
    let[@inline] map2 f s1 s2 = map2 default f s1 s2
  end (* P *)

  module E = Ephemeral
  module P = Persistent

  module Emulated = struct

    module Array = struct
      include S.Emulated.Array
      open D
      let[@inline] make n x = make default n x
      let[@inline] init n f = init default n f
      let[@inline] make_matrix m n x = make_matrix default m n x
      let[@inline] concat ss = concat default ss
      let[@inline] of_list xs = of_list default xs
      let[@inline] map f s = map default f s
      let[@inline] mapi f s = mapi default f s
      let[@inline] map2 f s1 s2 = map2 default f s1 s2
      let[@inline] of_seq s = of_seq default s
    end

    module List = struct
      include S.Emulated.List
      open D
      let empty = P.empty (* We cannot name it [[]]. *)
      let[@inline] init n f = init default n f
      let[@inline] map f s = map default f s
      let[@inline] mapi f s = mapi default f s
      let[@inline] rev_map f s = rev_map default f s
      let[@inline] filter_map f s = filter_map default f s
      let[@inline] concat_map f s = concat_map default f s
      let[@inline] map2 f s1 s2 = map2 default f s1 s2
      let[@inline] rev_map2 f s1 s2 = rev_map2 default f s1 s2
      let[@inline] fold_left_map f accu s = fold_left_map default f accu s
      let[@inline] of_seq s = of_seq default s
    end (* List *)

    module Queue = struct
      include S.Emulated.Queue
      open D
      let[@inline] create () = create default
      let[@inline] of_seq xs = of_seq default xs
    end (* Queue *)

    module Stack = struct
      include S.Emulated.Stack
      open D
      let[@inline] create () = create default
      let[@inline] of_seq xs = of_seq default xs
    end (* Stack *)

  end (* Emulated *)

end (* SupplyDefault *)