Module Dpds_gui.Make_StmtMapState.D

module D: Datatype

Type declarations

type 'a t = private {
   equal : 'a -> 'a -> bool;
   compare : 'a -> 'a -> int;
   hash : 'a -> int;
   copy : 'a -> 'a;
   internal_pretty_code : Type.precedence -> Format.formatter -> 'a -> unit;
   pretty_code : Format.formatter -> 'a -> unit;
   pretty : Format.formatter -> 'a -> unit;
   varname : 'a -> string;
   mem_project : (Project_skeleton.t -> bool) -> 'a -> bool;
}

Values associated to each datatype. Some others are provided directly in module Type.

module type Ty = sig .. end

A type with its type value.

module type S_no_copy = sig .. end

All values associated to a datatype, excepted copy.

module type S = sig .. end

All values associated to a datatype.

Getters from a type value

val info : 'a Type.t -> 'a t
val equal : 'a Type.t -> 'a -> 'a -> bool
val compare : 'a Type.t -> 'a -> 'a -> int
val hash : 'a Type.t -> 'a -> int
val copy : 'a Type.t -> 'a -> 'a
val internal_pretty_code : 'a Type.t -> Type.precedence -> Format.formatter -> 'a -> unit
val pretty_code : 'a Type.t -> Format.formatter -> 'a -> unit
val pretty : 'a Type.t -> Format.formatter -> 'a -> unit
val varname : 'a Type.t -> 'a -> string
val mem_project : 'a Type.t -> (Project_skeleton.t -> bool) -> 'a -> bool

Easy builders

val undefined : 'a -> 'b

Must be used if you don't want to implement a required function.

val identity : 'a -> 'a

Must be used if you want to implement a required function by fun x ->
    x
. Only useful for implementing rehash and copy.

val from_compare : 'a -> 'a -> bool

Must be used for equal in order to implement it by compare x y = 0 (with your own compare function).

val from_pretty_code : Format.formatter -> 'a -> unit

Must be used for pretty in order to implement it by pretty_code provided by the datatype from your own internal_pretty_code function.

val never_any_project : (Project_skeleton.t -> bool) -> 'a -> bool

Must be used for mem_project if values of your type does never contain any project.

val pp_fail : Type.precedence -> Format.formatter -> 'a -> unit

Must be used for internal_pretty_code if this pretty-printer must fail only when called.

module type Undefined = sig .. end

Sub-signature of Datatype.S.

module Undefined: Undefined 

Each values in these modules are undefined.

module Serializable_undefined: Undefined 

Same as Datatype.Undefined, but the type is supposed to be marshallable by the standard OCaml way (in particular, no hash-consing or projects inside the type).

Generic builders

module type Make_input = sig .. end

Input signature of Datatype.Make and Datatype.Make_with_collections.

module Make: 
functor (X : Make_input-> S with type t = X.t

Generic datatype builder.

module type Functor_info = sig .. end

Additional info for building Set, Map and Hashtbl.

module type Set = sig .. end

A standard OCaml set signature extended with datatype operations.

module type Map = sig .. end

A standard OCaml map signature extended with datatype operations.

module type Hashtbl_with_descr = sig .. end

Marshallable collectors with hashtbl-like interface.

module type Hashtbl = sig .. end

A standard OCaml hashtbl signature extended with datatype operations.

module type S_with_collections = sig .. end

A datatype for a type t extended with predefined set, map and hashtbl over t.

module Make_with_collections: 
functor (X : Make_input-> S_with_collections with type t = X.t

Generic comparable datatype builder: functions equal, compare and hash must not be Datatype.undefined.

module With_collections: 
functor (X : S-> 
functor (Info : Functor_info-> S_with_collections with type t = X.t

Add sets, maps and hashtables modules to an existing datatype, provided the equal, compare and hash functions are not Datatype.undefined.

Predefined datatype

module Unit: S_with_collections  with type t = unit
val unit : unit Type.t
module Bool: S_with_collections  with type t = bool
val bool : bool Type.t
module Int: S_with_collections  with type t = int
val int : int Type.t
module Int32: S_with_collections  with type t = int32
val int32 : int32 Type.t
module Int64: S_with_collections  with type t = int64
val int64 : int64 Type.t
module Nativeint: S_with_collections  with type t = nativeint
val nativeint : nativeint Type.t
module Float: S_with_collections  with type t = float
val float : float Type.t
module Char: S_with_collections  with type t = char
val char : char Type.t
module String: S_with_collections  with type t = string
val string : string Type.t
module Formatter: S  with type t = Format.formatter
val formatter : Format.formatter Type.t
module Integer: S_with_collections  with type t = Integer.t
val integer : Integer.t Type.t

Generic functors for polymorphic types

module type Polymorphic = sig .. end

Output signature of Datatype.Polymorphic.

module Polymorphic: 
functor (P : sig
include Type.Polymorphic_input
val mk_equal : ('a -> 'a -> bool) -> 'a Datatype.t -> 'a Datatype.t -> bool
val mk_compare : ('a -> 'a -> int) -> 'a Datatype.t -> 'a Datatype.t -> int
val mk_hash : ('a -> int) -> 'a Datatype.t -> int
val map : ('a -> 'a) -> 'a Datatype.t -> 'a Datatype.t
val mk_internal_pretty_code : (Type.precedence -> Format.formatter -> 'a -> unit) ->
Type.precedence -> Format.formatter -> 'a Datatype.t -> unit
val mk_pretty : (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a Datatype.t -> unit
val mk_varname : ('a -> string) -> 'a Datatype.t -> string
val mk_mem_project : ((Project_skeleton.t -> bool) -> 'a -> bool) ->
(Project_skeleton.t -> bool) -> 'a Datatype.t -> bool
end-> Polymorphic  with type 'a poly = 'a P.t

Functor for polymorphic types with only 1 type variable.

module type Polymorphic2 = sig .. end

Output signature of Datatype.Polymorphic2.

module Polymorphic2: 
functor (P : sig
include Type.Polymorphic2_input
val mk_equal : ('a -> 'a -> bool) ->
('b -> 'b -> bool) -> ('a, 'b) Datatype.t -> ('a, 'b) Datatype.t -> bool
val mk_compare : ('a -> 'a -> int) ->
('b -> 'b -> int) -> ('a, 'b) Datatype.t -> ('a, 'b) Datatype.t -> int
val mk_hash : ('a -> int) -> ('b -> int) -> ('a, 'b) Datatype.t -> int
val map : ('a -> 'a) -> ('b -> 'b) -> ('a, 'b) Datatype.t -> ('a, 'b) Datatype.t
val mk_internal_pretty_code : (Type.precedence -> Format.formatter -> 'a -> unit) ->
(Type.precedence -> Format.formatter -> 'b -> unit) ->
Type.precedence -> Format.formatter -> ('a, 'b) Datatype.t -> unit
val mk_pretty : (Format.formatter -> 'a -> unit) ->
(Format.formatter -> 'b -> unit) ->
Format.formatter -> ('a, 'b) Datatype.t -> unit
val mk_varname : ('a -> string) -> ('b -> string) -> ('a, 'b) Datatype.t -> string
val mk_mem_project : ((Project_skeleton.t -> bool) -> 'a -> bool) ->
((Project_skeleton.t -> bool) -> 'b -> bool) ->
(Project_skeleton.t -> bool) -> ('a, 'b) Datatype.t -> bool
end-> Polymorphic2  with type ('a, 'b) poly = ('a, 'b) P.t

Functor for polymorphic types with 2 type variables.

module type Polymorphic3 = sig .. end

Output signature of Datatype.Polymorphic3.

module Polymorphic3: 
functor (P : sig
include Type.Polymorphic3_input
val mk_equal : ('a -> 'a -> bool) ->
('b -> 'b -> bool) ->
('c -> 'c -> bool) ->
('a, 'b, 'c) Datatype.t -> ('a, 'b, 'c) Datatype.t -> bool
val mk_compare : ('a -> 'a -> int) ->
('b -> 'b -> int) ->
('c -> 'c -> int) ->
('a, 'b, 'c) Datatype.t -> ('a, 'b, 'c) Datatype.t -> int
val mk_hash : ('a -> int) -> ('b -> int) -> ('c -> int) -> ('a, 'b, 'c) Datatype.t -> int
val map : ('a -> 'a) ->
('b -> 'b) ->
('c -> 'c) -> ('a, 'b, 'c) Datatype.t -> ('a, 'b, 'c) Datatype.t
val mk_internal_pretty_code : (Type.precedence -> Format.formatter -> 'a -> unit) ->
(Type.precedence -> Format.formatter -> 'b -> unit) ->
(Type.precedence -> Format.formatter -> 'c -> unit) ->
Type.precedence -> Format.formatter -> ('a, 'b, 'c) Datatype.t -> unit
val mk_pretty : (Format.formatter -> 'a -> unit) ->
(Format.formatter -> 'b -> unit) ->
(Format.formatter -> 'c -> unit) ->
Format.formatter -> ('a, 'b, 'c) Datatype.t -> unit
val mk_varname : ('a -> string) ->
('b -> string) -> ('c -> string) -> ('a, 'b, 'c) Datatype.t -> string
val mk_mem_project : ((Project_skeleton.t -> bool) -> 'a -> bool) ->
((Project_skeleton.t -> bool) -> 'b -> bool) ->
((Project_skeleton.t -> bool) -> 'c -> bool) ->
(Project_skeleton.t -> bool) -> ('a, 'b, 'c) Datatype.t -> bool
end-> Polymorphic3  with type ('a, 'b, 'c) poly = ('a, 'b, 'c) P.t

Functor for polymorphic types with 3 type variables.

module type Polymorphic4 = sig .. end

Output signature of Datatype.Polymorphic4.

module Polymorphic4: 
functor (P : sig
include Type.Polymorphic4_input
val mk_equal : ('a -> 'a -> bool) ->
('b -> 'b -> bool) ->
('c -> 'c -> bool) ->
('d -> 'd -> bool) ->
('a, 'b, 'c, 'd) Datatype.t -> ('a, 'b, 'c, 'd) Datatype.t -> bool
val mk_compare : ('a -> 'a -> int) ->
('b -> 'b -> int) ->
('c -> 'c -> int) ->
('d -> 'd -> int) ->
('a, 'b, 'c, 'd) Datatype.t -> ('a, 'b, 'c, 'd) Datatype.t -> int
val mk_hash : ('a -> int) ->
('b -> int) ->
('c -> int) -> ('d -> int) -> ('a, 'b, 'c, 'd) Datatype.t -> int
val map : ('a -> 'a) ->
('b -> 'b) ->
('c -> 'c) ->
('d -> 'd) -> ('a, 'b, 'c, 'd) Datatype.t -> ('a, 'b, 'c, 'd) Datatype.t
val mk_internal_pretty_code : (Type.precedence -> Format.formatter -> 'a -> unit) ->
(Type.precedence -> Format.formatter -> 'b -> unit) ->
(Type.precedence -> Format.formatter -> 'c -> unit) ->
(Type.precedence -> Format.formatter -> 'd -> unit) ->
Type.precedence -> Format.formatter -> ('a, 'b, 'c, 'd) Datatype.t -> unit
val mk_pretty : (Format.formatter -> 'a -> unit) ->
(Format.formatter -> 'b -> unit) ->
(Format.formatter -> 'c -> unit) ->
(Format.formatter -> 'd -> unit) ->
Format.formatter -> ('a, 'b, 'c, 'd) Datatype.t -> unit
val mk_varname : ('a -> string) ->
('b -> string) ->
('c -> string) -> ('d -> string) -> ('a, 'b, 'c, 'd) Datatype.t -> string
val mk_mem_project : ((Project_skeleton.t -> bool) -> 'a -> bool) ->
((Project_skeleton.t -> bool) -> 'b -> bool) ->
((Project_skeleton.t -> bool) -> 'c -> bool) ->
((Project_skeleton.t -> bool) -> 'd -> bool) ->
(Project_skeleton.t -> bool) -> ('a, 'b, 'c, 'd) Datatype.t -> bool
end-> Polymorphic4  with type ('a, 'b, 'c, 'd) poly = ('a, 'b, 'c, 'd) P.t

Functor for polymorphic types with 4 type variables.

Predefined functors for polymorphic types

module Poly_pair: Polymorphic2  with type ('a, 'b) poly = 'a * 'b
module Pair: 
functor (T1 : S-> 
functor (T2 : S-> S with type t = T1.t * T2.t
module Pair_with_collections: 
functor (T1 : S-> 
functor (T2 : S-> 
functor (Info : Functor_info-> S_with_collections with type t = T1.t * T2.t
val pair : 'a Type.t -> 'b Type.t -> ('a * 'b) Type.t
module Poly_ref: Polymorphic  with type 'a poly = 'a ref
module Ref: 
functor (T : S-> S with type t = T.t ref
val t_ref : 'a Type.t -> 'a Pervasives.ref Type.t
module Poly_option: Polymorphic  with type 'a poly = 'a option
module Option: 
functor (T : S-> S with type t = T.t option
module Option_with_collections: 
functor (T : S-> 
functor (Info : Functor_info-> S_with_collections with type t = T.t option
val option : 'a Type.t -> 'a option Type.t
module Poly_list: Polymorphic  with type 'a poly = 'a list
module List: 
functor (T : S-> S with type t = T.t list
module List_with_collections: 
functor (T : S-> 
functor (Info : Functor_info-> S_with_collections with type t = T.t list
val list : 'a Type.t -> 'a list Type.t
module Poly_array: Polymorphic  with type 'a poly = 'a array
module Array: 
functor (T : S-> S with type t = T.t array
module Array_with_collections: 
functor (T : S-> 
functor (Info : Functor_info-> S_with_collections with type t = T.t array
val array : 'a Type.t -> 'a array Type.t
module Poly_queue: Polymorphic  with type 'a poly = 'a Queue.t
val queue : 'a Type.t -> 'a Queue.t Type.t
module Queue: 
functor (T : S-> S with type t = T.t Queue.t
module Triple: 
functor (T1 : S-> 
functor (T2 : S-> 
functor (T3 : S-> S with type t = T1.t * T2.t * T3.t
val triple : 'a Type.t -> 'b Type.t -> 'c Type.t -> ('a * 'b * 'c) Type.t
module Triple_with_collections: 
functor (T1 : S-> 
functor (T2 : S-> 
functor (T3 : S-> 
functor (Info : Functor_info-> S_with_collections with type t = T1.t * T2.t * T3.t
module Quadruple: 
functor (T1 : S-> 
functor (T2 : S-> 
functor (T3 : S-> 
functor (T4 : S-> S with type t = T1.t * T2.t * T3.t * T4.t
val quadruple : 'a Type.t ->
'b Type.t -> 'c Type.t -> 'd Type.t -> ('a * 'b * 'c * 'd) Type.t
module Quadruple_with_collections: 
functor (T1 : S-> 
functor (T2 : S-> 
functor (T3 : S-> 
functor (T4 : S-> 
functor (Info : Functor_info-> S_with_collections with type t = T1.t * T2.t * T3.t * T4.t
module Function: 
functor (T1 : sig
include Datatype.S
val label : (string * (unit -> Datatype.t) option) option
end-> 
functor (T2 : S-> S with type t = T1.t -> T2.t
val func : ?label:string * (unit -> 'a) option ->
'a Type.t -> 'b Type.t -> ('a -> 'b) Type.t
val optlabel_func : string -> (unit -> 'a) -> 'a Type.t -> 'b Type.t -> ('a -> 'b) Type.t

optlabel_func lab dft ty1 ty2 is equivalent to func ~label:(lab, Some dft) ty1 ty2

val func2 : ?label1:string * (unit -> 'a) option ->
'a Type.t ->
?label2:string * (unit -> 'b) option ->
'b Type.t -> 'c Type.t -> ('a -> 'b -> 'c) Type.t
val func3 : ?label1:string * (unit -> 'a) option ->
'a Type.t ->
?label2:string * (unit -> 'b) option ->
'b Type.t ->
?label3:string * (unit -> 'c) option ->
'c Type.t -> 'd Type.t -> ('a -> 'b -> 'c -> 'd) Type.t
val func4 : ?label1:string * (unit -> 'a) option ->
'a Type.t ->
?label2:string * (unit -> 'b) option ->
'b Type.t ->
?label3:string * (unit -> 'c) option ->
'c Type.t ->
?label4:string * (unit -> 'd) option ->
'd Type.t -> 'e Type.t -> ('a -> 'b -> 'c -> 'd -> 'e) Type.t
module Set: 
functor (S : FCSet.S-> 
functor (E : S with type t = S.elt-> 
functor (Info : Functor_info-> Set with type t = S.t and type elt = E.t
module Map: 
functor (M : FCMap.S-> 
functor (Key : S with type t = M.key-> 
functor (Info : Functor_info-> Map with type 'a t = 'a M.t and type key = M.key and module Key = Key
module Hashtbl: 
functor (H : Hashtbl_with_descr-> 
functor (Key : S with type t = H.key-> 
functor (Info : Functor_info-> Hashtbl with type 'a t = 'a H.t and type key = H.key and module Key = Key
module type Sub_caml_weak_hashtbl = sig .. end
module Caml_weak_hashtbl: 
functor (D : S-> sig .. end
module Weak: 
functor (W : Sub_caml_weak_hashtbl-> 
functor (D : S with type t = W.data-> S with type t = W.t