package acgtk

  1. Overview
  2. Docs
Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source

Source file idGenerator.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
(** This module implements various useful modules to generate IDs and
    to keep track of there association with string as in a symbol table *)

(** Signature of modules encoding symbol tables *)
module type CorrespondanceTableTYPE=
sig
  (** [identifier] is the type of the identifier stored in the
      table. It is meant to be associated with a [string] *)
  type identifier

  (** The type of the table *)
  type table

  (** This exception can be raised when some identifier or some symbol
      is not found in a query *)
  exception Not_found

  (** [empty] is an empty table *)
  val empty:table

  (** [find_id_of_sym sym t] returns the identifier of the string
      [sym] stored in [t]. Raises [Not_found] if no such identifier
      exists. *)
  val find_id_of_sym : string -> table -> identifier

  (** [find_sym_from_id id t] returns the string (i.e. the symbol)
      corresponding to the identifier [id] in table [t] *)
  val find_sym_from_id : identifier -> table -> string

  (** [add_sym sym t] returns a pair [(id,t')] where [id] is the
      identifier associated with [sym] in [t']. If [sym] already was
      in [t] then [t']=[t] and [id] is the identifier which it was
      associated with. Otherwise, a new identifier is generated and
      the new association is stored in [t'].*)
  val add_sym : string -> table -> identifier*table

  (** [to_string t] outputs the table [t] in a string.*)
  val to_string : table -> string

  (** [log_content level t] logs the content of table [t].*)
  val log_content : Logs.level -> table -> unit

  (** [fold f table a] returns [f id1 sym1 (f id2 sym2 ( ... ( f idN
      symN a) ... ))] where the [(id,sym)] pairs are the ones that are
      stored in the table [table]. The order of these key-value pairs in
      the table is unspecified. *)
  val fold : (identifier -> string -> 'a -> 'a) -> table -> 'a -> 'a

end

(** Signature of modules encoding a generator of identifiers *)
module type IdGen_TYPE =
sig
  (** The type of the identifier generated *)
  type id

  (** The type of the generator *)
  type t

  (** [init ()] returns a new generator *)
  val init : unit -> t

  (** [get_fresh_id gen] returnds a pair [(id,gen')] where [id] is a
      fresh [id] and [gen'] a new generator that knows [id] was already
      generated.*)
  val get_fresh_id : t -> (id*t)

  (** [eq id1 id2] returns [true] if [id1=id2] and [fase] otherwise. *)
  val eq : id -> id -> bool

  (** [compare id1 id2] returns an integer which is [0] if [id1=id2],
      negative of [id1] is less than [id2] and positive otherwise. *)
  val compare : id -> id -> int

  val id_to_string : id -> string
    
  (** [IdMap] implements maps whose keys are identifiers *)
  module IdMap : Map.S with type key=id

  (** [Table] implements correspondance tables with the current
      identifiers *)
  module Table : CorrespondanceTableTYPE with type identifier=id
end

(** Signature of encoding identifiers *)
module type IdType=
sig
  (** The type of the identifiers *)
  type t

  (** [compare id1 id2] returns an integer which is [0] if [id1=id2],
      negative of [id1] is less than [id2] and positive otherwise. *)
  val compare : t -> t -> int

  (** [succ id] returns a new identifer strictly greater than [id] *)
  val succ: t -> t

  (** [start] is some identifer *)
  val start: t

  (** [to_string id] returns a string describing the identifier *)
  val to_string: t->string
end

module Log = (val Logs.src_log (Logs.Src.create "ACGtkLib.idGenerator" ~doc:"logs ACGtkLib idGenerator events") : Logs.LOG) 
  
(** This module is a functor that generates a identifier generator
    from a module implementing these identifiers *)

module IdGen(ID:IdType) =
struct
  type id=ID.t
  type t=Generator of id
  let init () = Generator ID.start
  let get_fresh_id (Generator n) = n, Generator (ID.succ n)
  let eq i j = ID.compare i j=0
  let compare = ID.compare
  let id_to_string = ID.to_string
  module IdMap=Map.Make(ID)
  module Table=
    struct
      type identifier=id
      type table= {symbols:id Tries.Tries.t;
	       ids:string IdMap.t;
	       gen: t}
      exception Not_found

      let empty = {symbols=Tries.Tries.empty;
		   ids=IdMap.empty;
		   gen=init ()}
	
      let find_id_of_sym symbol {symbols=table;ids=_;gen=_} = 
	try
	  Tries.Tries.find symbol table
	with
	| Tries.Tries.Not_found -> raise Not_found
	  
      let find_sym_from_id id {symbols=_;ids=table;gen=_} = 
	try
	  IdMap.find id table
	with
	| Not_found -> raise Not_found
	  
      let add_sym sym ({symbols=syms;ids=ids;gen=vargen} as table) = 
	try
	  Tries.Tries.find sym syms,table
	with
	| Tries.Tries.Not_found -> 
	  let new_var,new_vargen=get_fresh_id vargen in
	  new_var,{symbols=Tries.Tries.add sym new_var syms;
		   ids=IdMap.add new_var sym ids;
		   gen=new_vargen}
	    
      let to_string {symbols=syms;ids=ids;gen=_} =
	let buff=Buffer.create 20 in
	let () = Buffer.add_string buff "Table from symbols to ids\n" in
	let () = Tries.Tries.fold
	  (fun key value () -> Buffer.add_string buff (Printf.sprintf "\t%s\t<->\t%s\n" key (ID.to_string value)))
	  ()
	  syms in
	let () = Buffer.add_string buff "Table from symbols to ids\n" in
	let () =
	  IdMap.iter
	    (fun key value -> Buffer.add_string buff (Printf.sprintf "\t%s\t<->\t%s\n%!" (ID.to_string key) value))
	    ids in
	Buffer.contents buff

      let log_content level {symbols=syms;ids=ids;gen=_} =
        Log.msg level (fun m -> m "Table from symbols to ids");
        Log.msg level (fun m ->
                  let () = 
                    Tries.Tries.fold
	              (fun key value () -> Log.msg level (fun m -> m "\t%s\t<->\t%s\n" key (ID.to_string value)))
	              ()
	              syms in
                  m "Done.");
        Log.msg level (fun m -> m "Table from symbols to ids");
        Log.msg level (fun m ->
                  let () = 
	            IdMap.iter
	              (fun key value -> Log.msg level (fun m -> m "\t%s\t<->\t%s\n%!" (ID.to_string key) value))
	              ids in
                  m "Done.")
                                  
      let fold f table start =
	IdMap.fold f table.ids start
    end
end

module IntId=
struct
  type t = int
  let compare i j = i-j
  let succ i = i+1
  let start =0
  let to_string = string_of_int
end

(** Module implementing the special case where identifiers ar
    integers. *)
module IntIdGen=IdGen(IntId)
OCaml

Innovation. Community. Security.