My working unpac space for OCaml projects in development
Merge opam/patches/gmap
+741
+14
vendor/opam/gmap/.travis.yml
+14
vendor/opam/gmap/.travis.yml
···
1
+
language: c
2
+
install: wget https://raw.githubusercontent.com/ocaml/ocaml-ci-scripts/master/.travis-opam.sh
3
+
script: bash -ex .travis-opam.sh
4
+
sudo: required
5
+
env:
6
+
global:
7
+
- PACKAGE="gmap"
8
+
matrix:
9
+
- OCAML_VERSION=4.04
10
+
- OCAML_VERSION=4.05
11
+
- OCAML_VERSION=4.06
12
+
- OCAML_VERSION=4.07
13
+
notifications:
14
+
email: false
+32
vendor/opam/gmap/CHANGES.md
+32
vendor/opam/gmap/CHANGES.md
···
1
+
## 0.3.0 (2019-04-20)
2
+
3
+
* S.union and S.merge could invalidate the invariant:
4
+
foreach k \in m . m[k] = (key, value) /\ k = key
5
+
which could lead to assertion fail in find
6
+
* The signatures uses semi-explicit polymorphism with a record type:
7
+
* S.equal : { f : 'a key -> 'a -> 'a -> bool } -> t -> t -> bool
8
+
* S.merge : { f : 'a key -> 'a option -> 'a option -> 'a option } -> t -> t -> t
9
+
* S.union : { f : 'a key -> 'a -> 'a -> 'a option } -> t -> t -> t
10
+
* new function S.map : { f : 'a key -> 'a -> 'a } -> t -> t
11
+
* Interface duplication for "bindings" and "value" were removed:
12
+
S.findb, S.getb, S.addb, S.addb_unless_bound no longer exist,
13
+
use S.find, S.get, S.add, S.add_unless_bound instead.
14
+
* The pretty-printer S.pp was removed, and K.pp is no longer required! S.pp is:
15
+
let pp ppf = M.iter (fun (M.B (k, v)) -> Fmt.pf ppf (K.pp k) v)
16
+
* no more Fmt dependency
17
+
* added some initial tests
18
+
19
+
## 0.2.1 (2019-02-16)
20
+
21
+
* move build system to dune
22
+
23
+
## 0.2.0 (2018-06-24)
24
+
25
+
* New function `update`.
26
+
* New function `add_unless_bound` and `addb_unless_bound`.
27
+
* Replace `type v = V : 'a key * 'a -> v` by `type b = B : 'a key * 'a -> b`.
28
+
* Renamed functions ending with `v` to `b`
29
+
30
+
## 0.1.0 (2018-06-16)
31
+
32
+
* Initial release
+16
vendor/opam/gmap/LICENSE.md
+16
vendor/opam/gmap/LICENSE.md
···
1
+
(*
2
+
* Copyright (c) 2017 2018 Hannes Mehnert <hannes@mehnert.org>
3
+
*
4
+
* Permission to use, copy, modify, and distribute this software for any
5
+
* purpose with or without fee is hereby granted, provided that the above
6
+
* copyright notice and this permission notice appear in all copies.
7
+
*
8
+
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
9
+
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
10
+
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
11
+
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
12
+
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
13
+
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
14
+
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
15
+
*
16
+
*)
+65
vendor/opam/gmap/README.md
+65
vendor/opam/gmap/README.md
···
1
+
## Gmap - heterogenous maps over a GADT
2
+
3
+
%%VERSION%%
4
+
5
+
Gmap exposes the functor `Make` which takes a key type (a
6
+
[GADT](https://en.wikipedia.org/wiki/Generalized_algebraic_data_type) 'a key)
7
+
and outputs a type-safe Map where each 'a key is associated with a 'a value.
8
+
This removes the need for additional packing. It uses OCaml's stdlib
9
+
[Map](http://caml.inria.fr/pub/docs/manual-ocaml/libref/Map.html) data
10
+
structure.
11
+
12
+
```OCaml
13
+
type _ key =
14
+
| I : int key
15
+
| S : string key
16
+
17
+
module K = struct
18
+
type 'a t = 'a key
19
+
20
+
let compare : type a b. a t -> b t -> (a, b) Gmap.Order.t = fun t t' ->
21
+
let open Gmap.Order in
22
+
match t, t' with
23
+
| I, I -> Eq | I, _ -> Lt | _, I -> Gt
24
+
| S, S -> Eq
25
+
end
26
+
27
+
module M = Gmap.Make(K)
28
+
29
+
30
+
let () =
31
+
let m = M.empty in
32
+
...
33
+
match M.find I m with
34
+
| Some x -> Printf.printf "got %d\n" x
35
+
| None -> Printf.printf "found nothing\n"
36
+
```
37
+
38
+
This is already an exhaustive pattern match: there is no need for another case
39
+
(for the constructor `S`) since the type system knows that looking for `I` will
40
+
result in an `int`.
41
+
42
+
Motivation came from parsing of protocols which usually specify optional values
43
+
and extensions via a tag-length-value (TLV) mechanism: for a given tag the
44
+
structure of value is different - see for example IP options, TCP options, DNS
45
+
resource records, TLS hello extensions, etc.
46
+
47
+
Discussing this problem with Justus Matthiesen during summer 2017, we came up
48
+
with this design. Its main difference to Daniel C. Bünzli's
49
+
[hmap](http://erratique.ch/software/hmap) is that in gmap the key-value GADT
50
+
type must be provided when instantiating the functor. In hmap, keys are created
51
+
dynamically.
52
+
53
+
## Documentation
54
+
55
+
[](https://travis-ci.org/hannesm/gmap)
56
+
57
+
[API documentation](https://hannesm.github.io/gmap/doc/) is available online.
58
+
59
+
## Installation
60
+
61
+
You need [opam](https://opam.ocaml.org) installed on your system. The command
62
+
63
+
`opam install gmap`
64
+
65
+
will install this library.
+9
vendor/opam/gmap/dune
+9
vendor/opam/gmap/dune
+175
vendor/opam/gmap/gmap.ml
+175
vendor/opam/gmap/gmap.ml
···
1
+
(* (c) 2017, 2018 Hannes Mehnert, all rights reserved *)
2
+
3
+
(* this code wouldn't exist without Justus Matthiesen, thanks for the help! *)
4
+
5
+
module Order = struct
6
+
type (_,_) t =
7
+
| Lt : ('a, 'b) t
8
+
| Eq : ('a, 'a) t
9
+
| Gt : ('a, 'b) t
10
+
end
11
+
12
+
module type KEY = sig
13
+
type _ t
14
+
val compare : 'a t -> 'b t -> ('a, 'b) Order.t
15
+
end
16
+
17
+
module type S = sig
18
+
type 'a key
19
+
type t
20
+
21
+
val empty : t
22
+
val singleton : 'a key -> 'a -> t
23
+
val is_empty : t -> bool
24
+
val cardinal : t -> int
25
+
val mem : 'a key -> t -> bool
26
+
val find : 'a key -> t -> 'a option
27
+
val get : 'a key -> t -> 'a
28
+
val add_unless_bound : 'a key -> 'a -> t -> t option
29
+
val add : 'a key -> 'a -> t -> t
30
+
val remove : 'a key -> t -> t
31
+
val update : 'a key -> ('a option -> 'a option) -> t -> t
32
+
33
+
type b = B : 'a key * 'a -> b
34
+
35
+
val min_binding : t -> b option
36
+
val max_binding : t -> b option
37
+
val any_binding : t -> b option
38
+
val bindings : t -> b list
39
+
40
+
type eq = { f : 'a . 'a key -> 'a -> 'a -> bool }
41
+
val equal : eq -> t -> t -> bool
42
+
43
+
type mapper = { f : 'a. 'a key -> 'a -> 'a }
44
+
val map : mapper -> t -> t
45
+
46
+
val iter : (b -> unit) -> t -> unit
47
+
val fold : (b -> 'a -> 'a) -> t -> 'a -> 'a
48
+
val for_all : (b -> bool) -> t -> bool
49
+
val exists : (b -> bool) -> t -> bool
50
+
val filter : (b -> bool) -> t -> t
51
+
type 'a fold2 = { f : 'b. 'b key -> 'b option -> 'b option -> 'a -> 'a }
52
+
val fold2 : 'a fold2 -> t -> t -> 'a -> 'a
53
+
type merger = { f : 'a. 'a key -> 'a option -> 'a option -> 'a option }
54
+
val merge : merger -> t -> t -> t
55
+
type unionee = { f : 'a. 'a key -> 'a -> 'a -> 'a option }
56
+
val union : unionee -> t -> t -> t
57
+
end
58
+
59
+
module Make (Key : KEY) : S with type 'a key = 'a Key.t = struct
60
+
type 'a key = 'a Key.t
61
+
type k = K : 'a key -> k
62
+
type b = B : 'a key * 'a -> b
63
+
64
+
module M = Map.Make(struct
65
+
type t = k
66
+
let compare (K a) (K b) = match Key.compare a b with
67
+
| Order.Lt -> -1 | Order.Eq -> 0 | Order.Gt -> 1
68
+
end)
69
+
70
+
type t = b M.t
71
+
72
+
let empty = M.empty
73
+
let singleton k v = M.singleton (K k) (B (k, v))
74
+
75
+
let is_empty = M.is_empty
76
+
let mem k m = M.mem (K k) m
77
+
78
+
let add k v m = M.add (K k) (B (k, v)) m
79
+
80
+
let add_unless_bound k v m = if mem k m then None else Some (add k v m)
81
+
82
+
let remove k m = M.remove (K k) m
83
+
84
+
let get : type a. a key -> t -> a = fun k m ->
85
+
match M.find (K k) m with
86
+
| B (k', v) ->
87
+
(* TODO this compare (and further below similar ones) is only needed for
88
+
the type checker (to get the k = k' proof), because the invariant
89
+
foreach k . t [K k] = B (k', v) -> k = k' is preserved by this library
90
+
91
+
it could be replaced by:
92
+
- Obj.magic
93
+
- vendor and slight modification of Stdlib.Map
94
+
- using integers as key -> compare can be a single instruction
95
+
Stay better safe than sorry (at least for now) *)
96
+
match Key.compare k k' with
97
+
| Order.Eq -> v
98
+
| _ -> assert false
99
+
100
+
let find : type a. a key -> t -> a option = fun k m ->
101
+
try Some (get k m) with Not_found -> None
102
+
103
+
let update k f m =
104
+
match f (find k m) with
105
+
| None -> remove k m
106
+
| Some v -> add k v m
107
+
108
+
let any_binding m = try Some (snd (M.choose m)) with Not_found -> None
109
+
let min_binding m = try Some (snd (M.min_binding m)) with Not_found -> None
110
+
let max_binding m = try Some (snd (M.max_binding m)) with Not_found -> None
111
+
let bindings m = snd (List.split (M.bindings m))
112
+
113
+
let cardinal m = M.cardinal m
114
+
115
+
let for_all p m = M.for_all (fun _ b -> p b) m
116
+
let exists p m = M.exists (fun _ b -> p b) m
117
+
118
+
let iter f m = M.iter (fun _ b -> f b) m
119
+
let fold f m acc = M.fold (fun _ b acc -> f b acc) m acc
120
+
let filter p m = M.filter (fun _ b -> p b) m
121
+
122
+
type mapper = { f : 'a. 'a key -> 'a -> 'a }
123
+
let map f m = M.map (fun (B (k, v)) -> B (k, f.f k v)) m
124
+
125
+
type merger = { f : 'a. 'a key -> 'a option -> 'a option -> 'a option }
126
+
127
+
let merge f m m' =
128
+
let callf : type x y. x key -> x option -> y key -> y option -> b option =
129
+
fun k v k' v' ->
130
+
(* see above comment in get about this useless Key.compare *)
131
+
match Key.compare k k' with
132
+
| Order.Eq ->
133
+
(match f.f k v v' with
134
+
| None -> None
135
+
| Some v'' -> Some (B (k, v'')))
136
+
| _ -> assert false
137
+
in
138
+
M.merge (fun (K key) b b' ->
139
+
match b, b' with
140
+
(* Map.merge never calls f None None, just for the types *)
141
+
| None, None -> None
142
+
| None, Some B (k', v') -> callf key None k' (Some v')
143
+
| Some B (k, v), None -> callf k (Some v) key None
144
+
| Some B (k, v), Some B (k', v') -> callf k (Some v) k' (Some v')
145
+
)
146
+
m m'
147
+
148
+
type 'a fold2 = { f : 'b. 'b key -> 'b option -> 'b option -> 'a -> 'a }
149
+
150
+
let fold2 f m m' acc =
151
+
let local = ref acc in
152
+
let f k v1 v2 = local := f.f k v1 v2 !local; None in
153
+
ignore (merge { f } m m');
154
+
!local
155
+
156
+
type unionee = { f : 'a. 'a key -> 'a -> 'a -> 'a option }
157
+
let union f m m' =
158
+
M.union
159
+
(fun (K k) (B (k', v)) (B (k'', v')) ->
160
+
(* see above comment about compare *)
161
+
match Key.compare k k', Key.compare k k'' with
162
+
| Order.Eq, Order.Eq ->
163
+
(match f.f k v v' with None -> None | Some v'' -> Some (B (k, v'')))
164
+
| _ -> assert false)
165
+
m m'
166
+
167
+
type eq = { f : 'a . 'a key -> 'a -> 'a -> bool }
168
+
let equal cmp m m' =
169
+
M.equal (fun (B (k, v)) (B (k', v')) ->
170
+
(* see above comment about compare *)
171
+
match Key.compare k k' with
172
+
| Order.Eq -> cmp.f k v v'
173
+
| _ -> assert false)
174
+
m m'
175
+
end
+236
vendor/opam/gmap/gmap.mli
+236
vendor/opam/gmap/gmap.mli
···
1
+
(* (c) 2017, 2018 Hannes Mehnert, all rights reserved *)
2
+
(* this code wouldn't exist without Justus Matthiesen, thanks for the help! *)
3
+
4
+
(** Heterogenous maps over a GADT.
5
+
6
+
The motivation for this library originated in the area of parsing binary
7
+
network protocols, which often contain options and extensions in the form of
8
+
tag, length, value encodings: the set of tags and corresponding values is
9
+
specified in some Internet standard, and later extended by using a global
10
+
registry. Examples are IP options, TCP options, DNS resource records, TLS
11
+
hello extensions, X.509v3 extensions, ... These extension mechanisms usually
12
+
include the invariant that each tag may only be present once.
13
+
14
+
A more naive approach is to use a variant type of all known tag-value
15
+
combinations and storing these in an association list while parsing, but
16
+
verifying the uniqueness invariant takes quadratic ([O(n^2)]) time, and
17
+
retrieving a specific option is only doable in linear [O(n)] time.
18
+
Additionally, packing and unpacking is required with the variant type
19
+
solution.
20
+
21
+
In gmap, {{:https://en.wikipedia.org/wiki/Generalized_algebraic_data_type}GADTs}
22
+
are used to provide key-dependent value types: each GADT constructor carries
23
+
their value type. The underlying storage mechanism uses OCaml's stdlib
24
+
{{:http://caml.inria.fr/pub/docs/manual-ocaml/libref/Map.html}Map} type:
25
+
Lookup takes [O(log n)] time. The above mentioned uniqueness invariant can
26
+
be preserved while constructing the gmap if for insertion into the map only
27
+
{!S.update} and {!S.add_unless_bound} are used ({!S.add} replaces the
28
+
existing binding if present).
29
+
30
+
A small example:
31
+
32
+
{[
33
+
type _ key =
34
+
| I : int key
35
+
| S : string key
36
+
37
+
module K = struct
38
+
type 'a t = 'a key
39
+
40
+
let compare : type a b. a t -> b t -> (a, b) Gmap.Order.t = fun t t' ->
41
+
let open Gmap.Order in
42
+
match t, t' with
43
+
| I, I -> Eq | I, _ -> Lt | _, I -> Gt
44
+
| S, S -> Eq
45
+
end
46
+
47
+
module GM = Gmap.Make(K)
48
+
]}
49
+
50
+
Using [GM] is done as follows:
51
+
52
+
{[
53
+
match GM.find I (GM.singleton I 10) with
54
+
| Some x -> x * x
55
+
| None -> 0
56
+
]}
57
+
58
+
{e %%VERSION%% - {{:%%PKG_HOMEPAGE%% }homepage}} *)
59
+
60
+
(** Ordering. *)
61
+
module Order : sig
62
+
63
+
(** The ordering type embedding type equality for [Eq]. *)
64
+
type (_,_) t =
65
+
| Lt : ('a, 'b) t
66
+
| Eq : ('a, 'a) t
67
+
| Gt : ('a, 'b) t
68
+
end
69
+
70
+
(** Key. *)
71
+
module type KEY = sig
72
+
73
+
type _ t
74
+
(** The type of a key *)
75
+
76
+
val compare : 'a t -> 'b t -> ('a, 'b) Order.t
77
+
(** [compare k k'] is the total order of keys. *)
78
+
end
79
+
80
+
(** Output signature of the functor {!Make} *)
81
+
module type S = sig
82
+
83
+
type 'a key
84
+
(** The type for map keys whose lookup value is ['a]. *)
85
+
86
+
type t
87
+
(** The type of maps from type ['a key] to ['a]. *)
88
+
89
+
(** {2 Constructors} *)
90
+
91
+
val empty : t
92
+
(** [empty] is the empty map. *)
93
+
94
+
val singleton : 'a key -> 'a -> t
95
+
(** [singleton key value] creates a one-element map that contains a binding
96
+
[value] for [key]. *)
97
+
98
+
(** {2 Basic operations} *)
99
+
100
+
val is_empty : t -> bool
101
+
(** [is_empty m] returns [true] if the map [m] is empty, [false] otherwise. *)
102
+
103
+
val cardinal : t -> int
104
+
(** [cardinal m] returns the number of bindings of the map [m]. *)
105
+
106
+
(** {2 Lookup operations} *)
107
+
108
+
val mem : 'a key -> t -> bool
109
+
(** [mem key m] returns [true] if the map [m] contains a binding for [key]. *)
110
+
111
+
val find : 'a key -> t -> 'a option
112
+
(** [find key m] returns [Some v] if the binding of [key] in [m] is [v], or
113
+
[None] if [key] is not bound [m]. *)
114
+
115
+
val get : 'a key -> t -> 'a
116
+
(** [find key m] returns [v] if the binding of [key] in [m] is [v].
117
+
118
+
@raise Not_found if [m] does not contain a binding for [key]. *)
119
+
120
+
(** {2 Insertion and removal operations} *)
121
+
122
+
val add_unless_bound : 'a key -> 'a -> t -> t option
123
+
(** [add_unless_bound key value m] returns [Some m'], a map containing the
124
+
same bindings as [m], plus a binding of [key] to [value]. Or, [None] if
125
+
[key] was already bound in [m]. *)
126
+
127
+
val add : 'a key -> 'a -> t -> t
128
+
(** [add key value m] returns a map containing the same bindings as [m], plus
129
+
a binding of [key] to [value]. If [key] was already bound in [m], the
130
+
previous binding disappears. *)
131
+
132
+
val remove : 'a key -> t -> t
133
+
(** [remove key m] returns a map containing the same bindings as [m], except
134
+
for [key] which is not bound in the returned map. If [key] was not bound
135
+
in [m], [m] is returned unchanged. *)
136
+
137
+
val update : 'a key -> ('a option -> 'a option) -> t -> t
138
+
(** [update k f m] returns a map containing the same bindings as [m], except
139
+
for the binding [v] of [k]. Depending the value of [v], which is
140
+
[f (find k m)], the binding of [k] is added, removed, or updated. *)
141
+
142
+
(** {2 Bindings} *)
143
+
144
+
type b = B : 'a key * 'a -> b
145
+
(** The type for a binding: a pair containing a key and its value. *)
146
+
147
+
(** {2 Selection of bindings} *)
148
+
149
+
val min_binding : t -> b option
150
+
(** [min_binding m] is the minimal binding in [m], [None] if [m] is empty. *)
151
+
152
+
val max_binding : t -> b option
153
+
(** [max_binding m] is the maximal binding in [m], [None] if [m] is empty. *)
154
+
155
+
val any_binding : t -> b option
156
+
(** [any_binding m] is any binding in [m], [None] if [m] is empty. *)
157
+
158
+
val bindings : t -> b list
159
+
(** [bindings m] returns the list of all bindings in the given map [m]. The
160
+
list is sorted with respect to the ordering over the type of the keys. *)
161
+
162
+
(** {2 Higher-order functions} *)
163
+
164
+
type eq = { f : 'a . 'a key -> 'a -> 'a -> bool }
165
+
(** The function type for the equal operation, using a record type for
166
+
"first-class" semi-explicit polymorphism. *)
167
+
168
+
val equal : eq -> t -> t -> bool
169
+
(** [equal p m m'] tests whether the maps [m] and [m'] are equal, that is
170
+
contain equal keys and associate them with equal data. [p] is the
171
+
equality predicate used to compare the data associated with the keys. *)
172
+
173
+
type mapper = { f : 'a. 'a key -> 'a -> 'a }
174
+
(** The function type for the map operation, using a record type for
175
+
"first-class" semi-explicit polymorphism. *)
176
+
177
+
val map : mapper -> t -> t
178
+
(** [map f m] returns a map with the same domain as [m], where the associated
179
+
binding [b] has been replaced by the result of the application of [f] to
180
+
[b]. The bindings are passed to [f] in increasing order with respect to
181
+
the ordering over the type of the keys. *)
182
+
183
+
val iter : (b -> unit) -> t -> unit
184
+
(** [iter f m] applies [f] to all bindings in [m]. The bindings are passed in
185
+
increasing order with respect to the ordering over the type of keys. *)
186
+
187
+
val fold : (b -> 'a -> 'a) -> t -> 'a -> 'a
188
+
(** [fold f m acc] computes [(f bN .. (f b1 acc))], where [b1 .. bN] are the
189
+
bindings of [m] in increasing order with respect to the ordering over the
190
+
type of the keys. *)
191
+
192
+
val for_all : (b -> bool) -> t -> bool
193
+
(** [for_all p m] checks if all bindings of the map [m] satisfy the predicate
194
+
[p]. *)
195
+
196
+
val exists : (b -> bool) -> t -> bool
197
+
(** [exists p m] checks if at least one binding of the map [m] satisfies
198
+
[p]. *)
199
+
200
+
val filter : (b -> bool) -> t -> t
201
+
(** [filter p m] returns the map with all the bindings in [m] that satisfy
202
+
[p]. *)
203
+
204
+
type 'a fold2 = { f : 'b. 'b key -> 'b option -> 'b option -> 'a -> 'a }
205
+
(** The function type for the fold2 operation, using a record type for
206
+
"first-class" semi-explicit polymorphism. *)
207
+
208
+
val fold2 : 'a fold2 -> t -> t -> 'a -> 'a
209
+
(** [fold2 f m m' acc] iterates over [m] and [m'], and calls [f] for each
210
+
binding in [m] or [m']. It uses [Map.merge] for the folding, but
211
+
ignores the result. *)
212
+
213
+
type merger = { f : 'a. 'a key -> 'a option -> 'a option -> 'a option }
214
+
(** The function type for the merge operation, using a record type for
215
+
"first-class" semi-explicit polymorphism. *)
216
+
217
+
val merge : merger -> t -> t -> t
218
+
(** [merge f m m'] computes a map whose keys is a subset of keys of [m] and
219
+
[m']. The presence of each such binding, and the corresponding value, is
220
+
determined with the function [f]. [f None None] is never called, it
221
+
directly returns [None]. *)
222
+
223
+
type unionee = { f : 'a. 'a key -> 'a -> 'a -> 'a option }
224
+
(** The function type for the union operation, using a record type for
225
+
"first-class" semi-explicit polymorphism. *)
226
+
227
+
val union : unionee -> t -> t -> t
228
+
(** [union f m m'] computes a map whose keys is the union of the keys of [m]
229
+
and [m']. When the same binding is defined in both maps, the function [f]
230
+
is used to combine them. *)
231
+
end
232
+
233
+
(** Functor for heterogenous maps whose keys are provided by [Key]. *)
234
+
module Make (Key : KEY) : sig
235
+
include S with type 'a key = 'a Key.t
236
+
end
+29
vendor/opam/gmap/gmap.opam
+29
vendor/opam/gmap/gmap.opam
···
1
+
opam-version: "2.0"
2
+
maintainer: "Hannes Mehnert <hannes@mehnert.org>"
3
+
authors: "Hannes Mehnert <hannes@mehnert.org>"
4
+
license: "ISC"
5
+
homepage: "https://github.com/hannesm/gmap"
6
+
doc: "https://hannesm.github.io/gmap/doc"
7
+
bug-reports: "https://github.com/hannesm/gmap/issues"
8
+
depends: [
9
+
"ocaml" {>= "4.04.2"}
10
+
"dune" {>= "1.0"}
11
+
"alcotest" {with-test}
12
+
"fmt" {with-test}
13
+
]
14
+
build: [
15
+
["dune" "subst"] {dev}
16
+
["dune" "build" "-p" name "-j" jobs]
17
+
["dune" "runtest" "-p" name "-j" jobs] {with-test}
18
+
]
19
+
dev-repo: "git+https://github.com/hannesm/gmap.git"
20
+
synopsis: "Heterogenous maps over a GADT"
21
+
description: """
22
+
Gmap exposes the functor `Make` which takes a key type (a
23
+
[GADT](https://en.wikipedia.org/wiki/Generalized_algebraic_data_type) 'a key)
24
+
and outputs a type-safe Map where each 'a key is associated with a 'a value.
25
+
This removes the need for additional packing. It uses OCaml's stdlib
26
+
[Map](http://caml.inria.fr/pub/docs/manual-ocaml/libref/Map.html) data
27
+
structure.
28
+
"""
29
+
x-maintenance-intent: [ "(latest)" ]
+160
vendor/opam/gmap/tests.ml
+160
vendor/opam/gmap/tests.ml
···
1
+
2
+
type _ key =
3
+
| I : int key
4
+
| S : string key
5
+
6
+
let pp_m : type a . Format.formatter -> a key -> a -> unit = fun ppf k v ->
7
+
match k, v with
8
+
| I, x -> Fmt.pf ppf "I %d" x
9
+
| S, s -> Fmt.pf ppf "S %s" s
10
+
11
+
let eq_m : type a. a key -> a -> a -> bool = fun k v v' ->
12
+
match k, v, v' with
13
+
| I, x, y -> x = y
14
+
| S, s, t -> String.equal s t
15
+
16
+
module K = struct
17
+
type 'a t = 'a key
18
+
19
+
let compare : type a b. a t -> b t -> (a, b) Gmap.Order.t = fun t t' ->
20
+
let open Gmap.Order in
21
+
match t, t' with
22
+
| I, I -> Eq | I, _ -> Lt | _, I -> Gt
23
+
| S, S -> Eq
24
+
end
25
+
26
+
module M = Gmap.Make(K)
27
+
28
+
let m_check =
29
+
let module M = struct
30
+
type t = M.t
31
+
let pp ppf m = M.iter (fun (M.B (k, v)) -> pp_m ppf k v) m
32
+
let equal a b = M.equal { f = eq_m } a b
33
+
end in
34
+
(module M: Alcotest.TESTABLE with type t = M.t)
35
+
36
+
let b_check =
37
+
let module M = struct
38
+
type t = M.b
39
+
let pp ppf (M.B (k, v)) = pp_m ppf k v
40
+
let equal (M.B (k, v)) (M.B (k', v')) = match K.compare k k' with
41
+
| Gmap.Order.Eq -> eq_m k v v'
42
+
| _ -> false
43
+
end in
44
+
(module M: Alcotest.TESTABLE with type t = M.t)
45
+
46
+
let empty () =
47
+
Alcotest.(check bool "empty map is empty" true (M.is_empty M.empty));
48
+
Alcotest.(check bool "mem on empty map doesn't have A" false (M.mem I M.empty));
49
+
Alcotest.(check (option int) "find on empty map doesn't have A" None
50
+
(M.find I M.empty));
51
+
Alcotest.(check (option string) "find on empty map doesn't have B" None
52
+
(M.find S M.empty));
53
+
Alcotest.(check (option b_check) "min binding is none" None
54
+
(M.min_binding M.empty));
55
+
Alcotest.(check (option b_check) "max binding is none" None
56
+
(M.max_binding M.empty));
57
+
Alcotest.(check (option b_check) "any binding is none" None
58
+
(M.any_binding M.empty));
59
+
Alcotest.(check (list b_check) "bindings is empty" []
60
+
(M.bindings M.empty))
61
+
62
+
let basic () =
63
+
let m = M.singleton I 5 in
64
+
Alcotest.(check bool "non-empty map is not empty" false (M.is_empty m));
65
+
Alcotest.(check int "non-empty map has cardinal 1" 1 (M.cardinal m));
66
+
Alcotest.(check bool "non-empty map has member I" true (M.mem I m));
67
+
Alcotest.(check (option int) "non-empty map finds I" (Some 5) (M.find I m));
68
+
Alcotest.check m_check "singleton and add are equivalent" m (M.add I 5 M.empty);
69
+
Alcotest.(check bool "removing I from map makes it empty" true
70
+
(M.is_empty (M.remove I m)));
71
+
Alcotest.(check bool "removing S from map makes it not empty" false
72
+
(M.is_empty (M.remove S m)));
73
+
Alcotest.check m_check "add overwrites" (M.singleton I 10) (M.add I 10 m);
74
+
Alcotest.(check (option m_check) "add_unless_bound does not overwrite" None
75
+
(M.add_unless_bound I 10 m));
76
+
Alcotest.check m_check "update updates" (M.singleton I 20)
77
+
(M.update I (fun _ -> Some 20) m);
78
+
Alcotest.(check (option b_check) "min_binding is I 5" (Some (M.B (I, 5)))
79
+
(M.min_binding m));
80
+
Alcotest.(check (option b_check) "max_binding is I 5" (Some (M.B (I, 5)))
81
+
(M.max_binding m));
82
+
Alcotest.(check (option b_check) "any_binding is I 5" (Some (M.B (I, 5)))
83
+
(M.any_binding m));
84
+
Alcotest.(check (list b_check) "bindings is [ I 5 ]" [ M.B (I, 5) ]
85
+
(M.bindings m))
86
+
87
+
let bad_eq_false : type a. a key -> a -> a -> bool = fun _ _ _ -> false
88
+
let bad_eq_true : type a. a key -> a -> a -> bool = fun _ _ _ -> true
89
+
90
+
let eq () =
91
+
let m = M.singleton I 5 in
92
+
Alcotest.(check bool "m equal is ok" true (M.equal { f = eq_m } m m));
93
+
Alcotest.(check bool "m equal is ok with singleton" true
94
+
(M.equal { f = eq_m } m (M.singleton I 5)));
95
+
Alcotest.(check bool "m equal is false" false
96
+
(M.equal { f = eq_m } m M.empty));
97
+
Alcotest.(check bool "m equal is false" false
98
+
(M.equal { f = eq_m } m (M.singleton S "foo")));
99
+
Alcotest.(check bool "m equal is false" false
100
+
(M.equal { f = eq_m } m (M.singleton I 10)));
101
+
Alcotest.(check bool "m equal is false" false
102
+
(M.equal { f = eq_m } m (M.add S "foo" (M.singleton I 10))));
103
+
Alcotest.(check bool "m bad equal is always false" false
104
+
(M.equal { f = bad_eq_false } m m));
105
+
Alcotest.(check bool "m bad equal is always true" true
106
+
(M.equal { f = bad_eq_true } m m))
107
+
108
+
let preds () =
109
+
let m = M.singleton I 5 in
110
+
let m' = M.add S "foobar" m in
111
+
let m'' = M.singleton I 10 in
112
+
let p (M.B (k, v)) = match k with I -> v = 5 | _ -> false in
113
+
Alcotest.(check bool "for_all works" true (M.for_all p m));
114
+
Alcotest.(check bool "for_all works m'" false (M.for_all p m'));
115
+
Alcotest.(check bool "for_all works m''" false (M.for_all p m''));
116
+
Alcotest.(check bool "exists works" true (M.exists p m));
117
+
Alcotest.(check bool "exists works m'" true (M.exists p m'));
118
+
Alcotest.(check bool "exists works m''" false (M.exists p m''));
119
+
Alcotest.check m_check "filter works" m (M.filter p m);
120
+
Alcotest.check m_check "filter works m'" m (M.filter p m');
121
+
Alcotest.check m_check "filter works m''" M.empty (M.filter p m'')
122
+
123
+
let map () =
124
+
let m = M.singleton I 5 in
125
+
let map : type a . a key -> a -> a = fun k _v ->
126
+
match k with
127
+
| I -> 100
128
+
| S -> "Foo"
129
+
in
130
+
Alcotest.check m_check "mapped m is equal as expected"
131
+
(M.singleton I 100) (M.map { f = map } m);
132
+
Alcotest.check m_check "mapped m is equal as expected"
133
+
(M.add S "Foo" (M.singleton I 100))
134
+
(M.map { f = map } (M.add S "barf" m))
135
+
136
+
let l_wins : type a . a key -> a -> a -> a option = fun _ v _ -> Some v
137
+
let r_wins : type a . a key -> a -> a -> a option = fun _ _ v' -> Some v'
138
+
let no_wins : type a . a key -> a -> a -> a option = fun _ _ _ -> None
139
+
140
+
let union () =
141
+
let m = M.add I 100 (M.singleton S "foo") in
142
+
Alcotest.check m_check "union map left wins is good" m
143
+
(M.union { f = l_wins } m (M.singleton S "bar"));
144
+
Alcotest.check m_check "union map right wins is good"
145
+
(M.add I 100 (M.singleton S "bar"))
146
+
(M.union { f = r_wins } m (M.singleton S "bar"));
147
+
Alcotest.check m_check "union map right wins is good"
148
+
(M.singleton I 100)
149
+
(M.union { f = no_wins } m (M.singleton S "bar"))
150
+
151
+
let tests = [
152
+
"empty gmap", `Quick, empty ;
153
+
"basic gmap", `Quick, basic ;
154
+
"equality", `Quick, eq ;
155
+
"predicates", `Quick, preds ;
156
+
"map", `Quick, map ;
157
+
"union", `Quick, union ;
158
+
]
159
+
160
+
let () = Alcotest.run "gmap tests" [ "gmap suite", tests ]