simon/sidekick
1
0
Fork 0
mirror of https://github.com/c-cube/sidekick.git synced 2025-12-06 03:05:31 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

format

Browse source
This commit is contained in:
Simon Cruanes 2022-08-27 20:48:32 -04:00
parent df287e4ef7
commit 2a0feed32c
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4
2 changed files with 35 additions and 36 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

55
src/smt/registry.ml
View file

@ -1,37 +1,38 @@
(* registry keys *)
module type KEY = sig
type elt
(* registry keys *)
module type KEY = sig
type elt
val id : int
val id : int
exception E of elt
end
exception E of elt
end
type 'a key = (module KEY with type elt = 'a)
type t = { tbl: exn Util.Int_tbl.t } [@@unboxed]
type 'a key = (module KEY with type elt = 'a)
type t = { tbl: exn Util.Int_tbl.t } [@@unboxed]
let create () : t = { tbl = Util.Int_tbl.create 8 }
let create () : t = { tbl = Util.Int_tbl.create 8 }
let n_ = ref 0
(* TODO: use atomic *)
let n_ = ref 0
let create_key (type a) () : a key =
let id = !n_ in
incr n_;
let module K = struct
type elt = a
let create_key (type a) () : a key =
let id = !n_ in
incr n_;
let module K = struct
type elt = a
exception E of a
exception E of a
let id = id
end in
(module K)
let id = id
end in
(module K)
let get (type a) (self : t) (k : a key) : _ option =
let (module K : KEY with type elt = a) = k in
match Util.Int_tbl.get self.tbl K.id with
| Some (K.E x) -> Some x
| _ -> None
let get (type a) (self : t) (k : a key) : _ option =
let (module K : KEY with type elt = a) = k in
match Util.Int_tbl.get self.tbl K.id with
| Some (K.E x) -> Some x
| _ -> None
let set (type a) (self : t) (k : a key) (v : a) : unit =
let (module K) = k in
Util.Int_tbl.replace self.tbl K.id (K.E v)
let set (type a) (self : t) (k : a key) (v : a) : unit =
let (module K) = k in
Util.Int_tbl.replace self.tbl K.id (K.E v)

16
src/smt/registry.mli
View file

@ -1,14 +1,12 @@
(** Registry to extract values *)
type t
type 'a key
type t
type 'a key
val create_key : unit -> 'a key
(** Call this statically, typically at program initialization, for
val create_key : unit -> 'a key
(** Call this statically, typically at program initialization, for
each distinct key. *)
val create : unit -> t
val get : t -> 'a key -> 'a option
val set : t -> 'a key -> 'a -> unit
val create : unit -> t
val get : t -> 'a key -> 'a option
val set : t -> 'a key -> 'a -> unit