diff options
-rw-r--r-- | lib/dyn.ml | 56 | ||||
-rw-r--r-- | lib/dyn.mli | 29 |
2 files changed, 84 insertions, 1 deletions
diff --git a/lib/dyn.ml b/lib/dyn.ml index 826cfaf8d..660ffc44e 100644 --- a/lib/dyn.ml +++ b/lib/dyn.ml @@ -6,6 +6,11 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) +module type TParam = +sig + type 'a t +end + module type S = sig type 'a tag @@ -14,6 +19,30 @@ type t = Dyn : 'a tag * 'a -> t val create : string -> 'a tag val eq : 'a tag -> 'b tag -> ('a, 'b) CSig.eq option val repr : 'a tag -> string + +type any = Any : 'a tag -> any + +val name : string -> any option + +module Map(M : TParam) : +sig + type t + val empty : t + val add : 'a tag -> 'a M.t -> t -> t + val remove : 'a tag -> t -> t + val find : 'a tag -> t -> 'a M.t + val mem : 'a tag -> t -> bool + + type any = Any : 'a tag * 'a M.t -> any + + type map = { map : 'a. 'a tag -> 'a M.t -> 'a M.t } + val map : map -> t -> t + + val iter : (any -> unit) -> t -> unit + val fold : (any -> 'r -> 'r) -> t -> 'r -> 'r + +end + val dump : unit -> (int * string) list end @@ -25,6 +54,8 @@ type 'a tag = int type t = Dyn : 'a tag * 'a -> t +type any = Any : 'a tag -> any + let dyntab = ref (Int.Map.empty : string Int.Map.t) (** Instead of working with tags as strings, which are costly, we use their hash. We ensure unicity of the hash in the [create] function. If ever a @@ -51,6 +82,29 @@ let repr s = let () = Printf.eprintf "Unknown dynamic tag %i\n%!" s in assert false +let name s = + let hash = Hashtbl.hash s in + if Int.Map.mem hash !dyntab then Some (Any hash) else None + let dump () = Int.Map.bindings !dyntab -end
\ No newline at end of file +module Map(M : TParam) = +struct +type t = Obj.t M.t Int.Map.t +let cast : 'a M.t -> 'b M.t = Obj.magic +let empty = Int.Map.empty +let add tag v m = Int.Map.add tag (cast v) m +let remove tag m = Int.Map.remove tag m +let find tag m = cast (Int.Map.find tag m) +let mem = Int.Map.mem + +type any = Any : 'a tag * 'a M.t -> any + +type map = { map : 'a. 'a tag -> 'a M.t -> 'a M.t } +let map f m = Int.Map.mapi f.map m + +let iter f m = Int.Map.iter (fun k v -> f (Any (k, v))) m +let fold f m accu = Int.Map.fold (fun k v accu -> f (Any (k, v)) accu) m accu +end + +end diff --git a/lib/dyn.mli b/lib/dyn.mli index 28587859e..d39acdf5d 100644 --- a/lib/dyn.mli +++ b/lib/dyn.mli @@ -7,6 +7,10 @@ (************************************************************************) (** Dynamics. Use with extreme care. Not for kids. *) +module type TParam = +sig + type 'a t +end module type S = sig @@ -16,7 +20,32 @@ type t = Dyn : 'a tag * 'a -> t val create : string -> 'a tag val eq : 'a tag -> 'b tag -> ('a, 'b) CSig.eq option val repr : 'a tag -> string + +type any = Any : 'a tag -> any + +val name : string -> any option + +module Map(M : TParam) : +sig + type t + val empty : t + val add : 'a tag -> 'a M.t -> t -> t + val remove : 'a tag -> t -> t + val find : 'a tag -> t -> 'a M.t + val mem : 'a tag -> t -> bool + + type any = Any : 'a tag * 'a M.t -> any + + type map = { map : 'a. 'a tag -> 'a M.t -> 'a M.t } + val map : map -> t -> t + + val iter : (any -> unit) -> t -> unit + val fold : (any -> 'r -> 'r) -> t -> 'r -> 'r + +end + val dump : unit -> (int * string) list + end (** FIXME: use OCaml 4.02 generative functors when available *) |