├── .gitignore ├── .merlin ├── .ocp-indent ├── CHANGES.md ├── LICENSE.md ├── README.md ├── _tags ├── doc ├── api.odocl └── dev.odocl ├── opam ├── pkg ├── META └── pkg.ml ├── src ├── hmap.ml ├── hmap.mli └── hmap.mllib └── test └── test.ml /.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | tmp 3 | *~ 4 | \.\#* 5 | \#*# 6 | *.install 7 | *.native 8 | *.byte -------------------------------------------------------------------------------- /.merlin: -------------------------------------------------------------------------------- 1 | S src 2 | S test 3 | B _build/** 4 | -------------------------------------------------------------------------------- /.ocp-indent: -------------------------------------------------------------------------------- 1 | strict_with=always,match_clause=4,strict_else=never 2 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | 2 | * Build depend on topkg. 3 | 4 | v0.8.0 2016-03-08 La Forclaz (VS) 5 | --------------------------------- 6 | 7 | First release. 8 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | Copyright (c) 2016 Daniel C. Bünzli 2 | 3 | Permission to use, copy, modify, and/or distribute this software for any 4 | purpose with or without fee is hereby granted, provided that the above 5 | copyright notice and this permission notice appear in all copies. 6 | 7 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 8 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 9 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 10 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 11 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 12 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 13 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 14 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Hmap — Heterogeneous value maps for OCaml 2 | ------------------------------------------------------------------------------- 3 | %%VERSION%% 4 | 5 | Hmap provides heterogeneous value maps for OCaml. These maps bind keys 6 | to values with arbitrary types. Keys witness the type of the value 7 | they are bound to which allows to add and lookup bindings in a type 8 | safe manner. 9 | 10 | Hmap has no dependency and is distributed under the ISC license. 11 | 12 | Home page: http://erratique.ch/software/hmap 13 | Contact: Daniel Bünzli `` 14 | 15 | ## Installation 16 | 17 | Hmap can be installed with `opam`: 18 | 19 | opam install hmap 20 | 21 | If you don't use `opam` consult the [`opam`](opam) file for build 22 | instructions. 23 | 24 | ## Documentation 25 | 26 | The documentation and API reference is automatically generated by 27 | `ocamldoc` from the interfaces. It can be consulted [online][doc] 28 | and there is a generated version in the `doc` directory of the 29 | distribution. 30 | 31 | [doc]: http://erratique.ch/software/hmap/doc 32 | 33 | ## Sample programs 34 | 35 | If you installed Hmap with `opam` sample programs are located in 36 | the directory `opam config var hmap:doc`. 37 | 38 | In the distribution sample programs and tests are located in the 39 | [`test`](test) directory of the distribution. They can be built an run 40 | with 41 | 42 | topkg build --tests true 43 | topkg test 44 | -------------------------------------------------------------------------------- /_tags: -------------------------------------------------------------------------------- 1 | true : bin_annot, safe_string 2 | 3 | : include 4 | : include -------------------------------------------------------------------------------- /doc/api.odocl: -------------------------------------------------------------------------------- 1 | Hmap -------------------------------------------------------------------------------- /doc/dev.odocl: -------------------------------------------------------------------------------- 1 | Hmap -------------------------------------------------------------------------------- /opam: -------------------------------------------------------------------------------- 1 | opam-version: "1.2" 2 | maintainer: "Daniel Bünzli " 3 | authors: ["Daniel Bünzli "] 4 | homepage: "http://erratique.ch/software/hmap" 5 | doc: "http://erratique.ch/software/hmap/doc" 6 | license: "ISC" 7 | dev-repo: "http://erratique.ch/repos/hmap.git" 8 | bug-reports: "http://github.com/dbuenzli/hmap/issues" 9 | tags: ["data-structure" "org:erratique"] 10 | available: [ ocaml-version >= "4.02.0"] 11 | depends: [ 12 | "ocamlfind" {build} 13 | "ocamlbuild" {build} 14 | "topkg" {build} 15 | ] 16 | depopts: [ ] 17 | build: [[ 18 | "ocaml" "pkg/pkg.ml" "build" 19 | "--pinned" "%{pinned}%" ]] -------------------------------------------------------------------------------- /pkg/META: -------------------------------------------------------------------------------- 1 | description = "Heterogeneous value maps for OCaml" 2 | version = "%%VERSION_NUM%%" 3 | requires = "" 4 | archive(byte) = "hmap.cma" 5 | archive(native) = "hmap.cmxa" 6 | plugin(byte) = "hmap.cma" 7 | plugin(native) = "hmap.cmxs" 8 | -------------------------------------------------------------------------------- /pkg/pkg.ml: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ocaml 2 | #use "topfind";; 3 | #require "topkg" 4 | open Topkg 5 | 6 | let () = 7 | Pkg.describe "hmap" @@ fun c -> 8 | Ok [ Pkg.mllib "src/hmap.mllib"; 9 | Pkg.test "test/test"; ] 10 | -------------------------------------------------------------------------------- /src/hmap.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | Distributed under the ISC license, see terms at the end of the file. 4 | %%NAME%% %%VERSION%% 5 | ---------------------------------------------------------------------------*) 6 | 7 | (* Type identifiers. 8 | See http://alan.petitepomme.net/cwn/2015.03.24.html#1 *) 9 | 10 | module Tid = struct type _ t = .. end 11 | module type Tid = sig 12 | type t 13 | type _ Tid.t += Tid : t Tid.t 14 | end 15 | 16 | type 'a tid = (module Tid with type t = 'a) 17 | 18 | let tid () (type s) = 19 | let module M = struct 20 | type t = s 21 | type _ Tid.t += Tid : t Tid.t 22 | end 23 | in 24 | (module M : Tid with type t = s) 25 | 26 | type ('a, 'b) teq = Teq : ('a, 'a) teq 27 | 28 | let eq : type r s. r tid -> s tid -> (r, s) teq option = 29 | fun r s -> 30 | let module R = (val r : Tid with type t = r) in 31 | let module S = (val s : Tid with type t = s) in 32 | match R.Tid with 33 | | S.Tid -> Some Teq 34 | | _ -> None 35 | 36 | (* Heterogeneous maps *) 37 | 38 | module type KEY_INFO = sig 39 | type 'a t 40 | end 41 | 42 | module type S = sig 43 | 44 | type 'a key 45 | 46 | module Key : sig 47 | type 'a info 48 | val create : 'a info -> 'a key 49 | val info : 'a key -> 'a info 50 | 51 | type t 52 | val hide_type : 'a key -> t 53 | val equal : t -> t -> bool 54 | val compare : t -> t -> int 55 | end 56 | 57 | type t 58 | val empty : t 59 | val is_empty : t -> bool 60 | val mem : 'a key -> t -> bool 61 | val add : 'a key -> 'a -> t -> t 62 | val singleton : 'a key -> 'a -> t 63 | val rem : 'a key -> t -> t 64 | val find : 'a key -> t -> 'a option 65 | val get : 'a key -> t -> 'a 66 | 67 | type binding = B : 'a key * 'a -> binding 68 | val iter : (binding -> unit) -> t -> unit 69 | val fold : (binding -> 'a -> 'a) -> t -> 'a -> 'a 70 | val for_all : (binding -> bool) -> t -> bool 71 | val exists : (binding -> bool) -> t -> bool 72 | val filter : (binding -> bool) -> t -> t 73 | val cardinal : t -> int 74 | val any_binding : t -> binding option 75 | val get_any_binding : t -> binding 76 | end 77 | 78 | 79 | module Make (Key_info : KEY_INFO) : S 80 | with type 'a Key.info = 'a Key_info.t = struct 81 | 82 | (* Keys *) 83 | 84 | module Key = struct 85 | 86 | type 'a info = 'a Key_info.t 87 | type 'a key = { uid : int; tid : 'a tid; info : 'a Key_info.t } 88 | 89 | let uid = 90 | let id = ref (-1) in 91 | fun () -> incr id; !id 92 | 93 | let create info = 94 | let uid = uid () in 95 | let tid = tid () in 96 | { uid; tid; info } 97 | 98 | let info k = k.info 99 | 100 | type t = V : 'a key -> t 101 | let hide_type k = V k 102 | let equal (V k0) (V k1) = (compare : int -> int -> int) k0.uid k1.uid = 0 103 | let compare (V k0) (V k1) = (compare : int -> int -> int) k0.uid k1.uid 104 | end 105 | 106 | type 'a key = 'a Key.key 107 | 108 | (* Maps *) 109 | 110 | module M = Map.Make (Key) 111 | type binding = B : 'a key * 'a -> binding 112 | type t = binding M.t 113 | 114 | let empty = M.empty 115 | let is_empty = M.is_empty 116 | let mem k m = M.mem (Key.V k) m 117 | let add k v m = M.add (Key.V k) (B (k, v)) m 118 | let singleton k v = M.singleton (Key.V k) (B (k, v)) 119 | let rem k m = M.remove (Key.V k) m 120 | let find : type a. a key -> t -> a option = 121 | fun k s -> 122 | try match M.find (Key.V k) s with 123 | | B (k', v) -> 124 | match eq k.Key.tid k'.Key.tid with 125 | | None -> None 126 | | Some Teq -> Some v 127 | with Not_found -> None 128 | 129 | let get k s = match find k s with 130 | | None -> invalid_arg "key not found in map" 131 | | Some v -> v 132 | 133 | let iter f m = M.iter (fun _ b -> f b) m 134 | let fold f m acc = M.fold (fun _ b acc -> f b acc) m acc 135 | let for_all p m = M.for_all (fun _ b -> p b) m 136 | let exists p m = M.exists (fun _ b -> p b) m 137 | let filter p m = M.filter (fun _ b -> p b) m 138 | let cardinal m = M.cardinal m 139 | let any_binding m = try Some (snd (M.choose m)) with 140 | | Not_found -> None 141 | 142 | let get_any_binding m = try snd (M.choose m) with 143 | | Not_found -> invalid_arg "empty map" 144 | end 145 | 146 | include Make (struct type 'a t = unit end) 147 | 148 | (*--------------------------------------------------------------------------- 149 | Copyright (c) 2016 Daniel C. Bünzli 150 | 151 | Permission to use, copy, modify, and/or distribute this software for any 152 | purpose with or without fee is hereby granted, provided that the above 153 | copyright notice and this permission notice appear in all copies. 154 | 155 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 156 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 157 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 158 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 159 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 160 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 161 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 162 | ---------------------------------------------------------------------------*) 163 | -------------------------------------------------------------------------------- /src/hmap.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | Distributed under the ISC license, see terms at the end of the file. 4 | %%NAME%% %%VERSION%% 5 | ---------------------------------------------------------------------------*) 6 | 7 | (** Heterogeneous value maps. 8 | 9 | {e %%VERSION%% - {{:%%PKG_HOMEPAGE%% }homepage}} *) 10 | 11 | (** {1:keys Keys} *) 12 | 13 | type 'a key 14 | (** The type for keys whose lookup value is of type ['a]. *) 15 | 16 | (** Keys. *) 17 | module Key : sig 18 | 19 | (** {1:keys Keys} *) 20 | 21 | val create : unit -> 'a key 22 | (** [create ()] is a new key. *) 23 | 24 | (** {1:exists Existential keys} 25 | 26 | Exisential keys allows to compare keys. This can be useful for functions 27 | like {!filter}. *) 28 | 29 | type t 30 | (** The type for existential keys. *) 31 | 32 | val hide_type : 'a key -> t 33 | (** [hide_type k] is an existential key for [k]. *) 34 | 35 | val equal : t -> t -> bool 36 | (** [equal k k'] is [true] iff [k] and [k'] are the same key. *) 37 | 38 | val compare : t -> t -> int 39 | (** [compare k k'] is a total order on keys compatible with {!equal}. *) 40 | end 41 | 42 | (** {1:maps Maps} *) 43 | 44 | type t 45 | (** The type for heterogeneous value maps. *) 46 | 47 | val empty : t 48 | (** [empty] is the empty map. *) 49 | 50 | val is_empty : t -> bool 51 | (** [is_empty m] is [true] iff [m] is empty. *) 52 | 53 | val mem : 'a key -> t -> bool 54 | (** [mem k m] is [true] iff [k] is bound in [m]. *) 55 | 56 | val add : 'a key -> 'a -> t -> t 57 | (** [add k v m] is [m] with [k] bound to [v]. *) 58 | 59 | val singleton : 'a key -> 'a -> t 60 | (** [singleton k v] is [add k v empty]. *) 61 | 62 | val rem : 'a key -> t -> t 63 | (** [rem k m] is [m] with [k] unbound. *) 64 | 65 | val find : 'a key -> t -> 'a option 66 | (** [find k m] is the value of [k]'s binding in [m], if any. *) 67 | 68 | val get : 'a key -> t -> 'a 69 | (** [get k m] is the value of [k]'s binding in [m]. 70 | 71 | @raise Invalid_argument if [k] is not bound in [m]. *) 72 | 73 | (** The type for bindings. *) 74 | type binding = B : 'a key * 'a -> binding 75 | 76 | val iter : (binding -> unit) -> t -> unit 77 | (** [iter f m] applies [f] to all bindings of [m]. *) 78 | 79 | val fold : (binding -> 'a -> 'a) -> t -> 'a -> 'a 80 | (** [fold f m acc] folds over the bindings of [m] with [f], starting with 81 | [acc] *) 82 | 83 | val for_all : (binding -> bool) -> t -> bool 84 | (** [for_all p m] is [true] iff all bindings of [m] satisfy [p]. *) 85 | 86 | val exists : (binding -> bool) -> t -> bool 87 | (** [exists p m] is [true] iff there exists a bindings of [m] that 88 | satisfies [p]. *) 89 | 90 | val filter : (binding -> bool) -> t -> t 91 | (** [filter p m] are the bindings of [m] that satisfy [p]. *) 92 | 93 | val cardinal : t -> int 94 | (** [cardinal m] is the number of bindings in [m]. *) 95 | 96 | val any_binding : t -> binding option 97 | (** [any_binding m] is a binding of [m] (if not empty). *) 98 | 99 | val get_any_binding : t -> binding 100 | (** [get_any_binding m] is a binding of [m]. 101 | 102 | @raise Invalid_argument if [m] is empty. *) 103 | 104 | (** {1:func Functorial interface} 105 | 106 | The functorial interface allows to associate more information to the 107 | keys. For example a key name or a key value pretty-printer. *) 108 | 109 | (** The type for key information. *) 110 | module type KEY_INFO = sig 111 | type 'a t 112 | (** The type for key information. *) 113 | end 114 | 115 | (** Output signature of the functor {!Make} *) 116 | module type S = sig 117 | 118 | (** {1:keys Keys} *) 119 | 120 | type 'a key 121 | (** The type for keys whose lookup value is of type ['a]. *) 122 | 123 | (** Keys. *) 124 | module Key : sig 125 | 126 | (** {1:keys Keys} *) 127 | 128 | type 'a info 129 | (** The type for key information. *) 130 | 131 | val create : 'a info -> 'a key 132 | (** [create i] is a new key with information [i]. *) 133 | 134 | val info : 'a key -> 'a info 135 | (** [info k] is [k]'s information. *) 136 | 137 | (** {1:exists Existential keys} 138 | 139 | Exisential keys allow to compare keys. This can be useful for 140 | functions like {!filter}. *) 141 | 142 | type t 143 | (** The type for existential keys. *) 144 | 145 | val hide_type : 'a key -> t 146 | (** [hide_type k] is an existential key for [k]. *) 147 | 148 | val equal : t -> t -> bool 149 | (** [equal k k'] is [true] iff [k] and [k'] are the same key. *) 150 | 151 | val compare : t -> t -> int 152 | (** [compare k k'] is a total order on keys compatible with {!equal}. *) 153 | end 154 | 155 | (** {1:maps Maps} *) 156 | 157 | type t 158 | (** The type for heterogeneous value maps. *) 159 | 160 | val empty : t 161 | (** [empty] is the empty map. *) 162 | 163 | val is_empty : t -> bool 164 | (** [is_empty m] is [true] iff [m] is empty. *) 165 | 166 | val mem : 'a key -> t -> bool 167 | (** [mem k m] is [true] iff [k] is bound in [m]. *) 168 | 169 | val add : 'a key -> 'a -> t -> t 170 | (** [add k v m] is [m] with [k] bound to [v]. *) 171 | 172 | val singleton : 'a key -> 'a -> t 173 | (** [singleton k v] is [add k v empty]. *) 174 | 175 | val rem : 'a key -> t -> t 176 | (** [rem k m] is [m] with [k] unbound. *) 177 | 178 | val find : 'a key -> t -> 'a option 179 | (** [find k m] is the value of [k]'s binding in [m], if any. *) 180 | 181 | val get : 'a key -> t -> 'a 182 | (** [get k m] is the value of [k]'s binding in [m]. 183 | 184 | @raise Invalid_argument if [k] is not bound in [m]. *) 185 | 186 | (** The type for bindings. *) 187 | type binding = B : 'a key * 'a -> binding 188 | 189 | val iter : (binding -> unit) -> t -> unit 190 | (** [iter f m] applies [f] to all bindings of [m]. *) 191 | 192 | val fold : (binding -> 'a -> 'a) -> t -> 'a -> 'a 193 | (** [fold f m acc] folds over the bindings of [m] with [f], starting with 194 | [acc] *) 195 | 196 | val for_all : (binding -> bool) -> t -> bool 197 | (** [for_all p m] is [true] iff all bindings of [m] satisfy [p]. *) 198 | 199 | val exists : (binding -> bool) -> t -> bool 200 | (** [exists p m] is [true] iff there exists a bindings of [m] that 201 | satisfies [p]. *) 202 | 203 | val filter : (binding -> bool) -> t -> t 204 | (** [filter p m] are the bindings of [m] that satisfy [p]. *) 205 | 206 | val cardinal : t -> int 207 | (** [cardinal m] is the number of bindings in [m]. *) 208 | 209 | val any_binding : t -> binding option 210 | (** [any_binding m] is a binding of [m] (if not empty). *) 211 | 212 | val get_any_binding : t -> binding 213 | (** [get_any_binding m] is a binding of [m]. 214 | 215 | @raise Invalid_argument if [m] is empty. *) 216 | end 217 | 218 | (** Functor for heterogeneous maps whose keys hold information 219 | of type [Key_info.t] *) 220 | module Make : 221 | functor (Key_info : KEY_INFO) -> S with type 'a Key.info = 'a Key_info.t 222 | 223 | (*--------------------------------------------------------------------------- 224 | Copyright (c) 2016 Daniel C. Bünzli 225 | 226 | Permission to use, copy, modify, and/or distribute this software for any 227 | purpose with or without fee is hereby granted, provided that the above 228 | copyright notice and this permission notice appear in all copies. 229 | 230 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 231 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 232 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 233 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 234 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 235 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 236 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 237 | ---------------------------------------------------------------------------*) 238 | -------------------------------------------------------------------------------- /src/hmap.mllib: -------------------------------------------------------------------------------- 1 | Hmap 2 | -------------------------------------------------------------------------------- /test/test.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | Distributed under the ISC license, see terms at the end of the file. 4 | %%NAME%% %%VERSION%% 5 | ---------------------------------------------------------------------------*) 6 | 7 | let test () = 8 | let ik = Hmap.Key.create () in 9 | let sk = Hmap.Key.create () in 10 | let uk = Hmap.Key.create () in 11 | let m = Hmap.(empty |> add ik 5 |> add sk "hey") in 12 | assert (Hmap.mem ik m); 13 | assert (Hmap.mem sk m); 14 | assert (not (Hmap.mem uk m)); 15 | assert (Hmap.find ik m = Some 5); 16 | assert (Hmap.get ik m = 5); 17 | assert (Hmap.find sk m = Some "hey"); 18 | assert (Hmap.get sk m = "hey"); 19 | assert (Hmap.find uk m = None); 20 | assert (try Hmap.get uk m; false with Invalid_argument _ -> true); 21 | Printf.printf "Success!\n%!"; 22 | () 23 | 24 | let () = test () 25 | 26 | (*--------------------------------------------------------------------------- 27 | Copyright (c) 2016 Daniel C. Bünzli 28 | 29 | Permission to use, copy, modify, and/or distribute this software for any 30 | purpose with or without fee is hereby granted, provided that the above 31 | copyright notice and this permission notice appear in all copies. 32 | 33 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 34 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 35 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 36 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 37 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 38 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 39 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 40 | ---------------------------------------------------------------------------*) 41 | --------------------------------------------------------------------------------