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
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
|
(** Signature for a module describing an identifier.
We often need identifiers (for definitions, variables, etc.) and in
order to make sure we don't mix them, we use a generative functor
(see [IdGen]).
*)
module type Id = sig
type id
type generator
(** Id generator - simply a counter *)
type set_t
type +!'a map_t
val zero : id
val generator_zero : generator
val fresh_stateful_generator : unit -> generator ref * (unit -> id)
(* TODO: this is stateful! - but we may want to be able to duplicate contexts... *)
val fresh : generator -> id * generator
(* TODO: change the order of the returned types *)
val to_string : id -> string
val pp_id : Format.formatter -> id -> unit
val show_id : id -> string
val pp_generator : Format.formatter -> generator -> unit
val show_generator : generator -> string
val to_int : id -> int
val of_int : int -> id
val nth : 'a list -> id -> 'a
val nth_opt : 'a list -> id -> 'a option
val update_nth : 'a list -> id -> 'a -> 'a list
(** Update the nth element of the list.
Raises [Invalid_argument] if the identifier is out of range.
*)
val mapi : (id -> 'a -> 'b) -> 'a list -> 'b list
val mapi_from1 : (id -> 'a -> 'b) -> 'a list -> 'b list
(** Same as [mapi], but where the indices start with 1 *)
val pp_set_t : Format.formatter -> set_t -> unit
val show_set_t : set_t -> string
val pp_map_t :
(Format.formatter -> 'a -> unit) -> Format.formatter -> 'a map_t -> unit
val show_map_t : ('a -> string) -> 'a map_t -> string
module Ord : Map.OrderedType with type t = id
module Set : Set.S with type elt = id with type t = set_t
val set_to_string : string option -> Set.t -> string
(** Convert a set to a string.
Takes an indentation as parameter, in case you want to insert a breakline
for every binding.
*)
module Map : Map.S with type key = id with type 'a t = 'a map_t
val map_to_string : string option -> ('a -> string) -> 'a map_t -> string
(** Convert a map to a string.
Takes an indentation as parameter, in case you want to insert a breakline
for every binding.
*)
val id_of_json : Yojson.Basic.t -> (id, string) result
end
(** Generative functor for identifiers.
See [Id].
*)
module IdGen () : Id = struct
(* TODO: use Z.t *)
type id = int [@@deriving show]
type generator = id [@@deriving show]
let zero = 0
let generator_zero = 0
let incr x =
(* Identifiers should never overflow (because max_int is a really big
* value - but we really want to make sure we detect overflows if
* they happen *)
if x == max_int then raise (Errors.IntegerOverflow ()) else x + 1
let fresh_stateful_generator () =
let g = ref 0 in
let fresh () =
let id = !g in
g := incr id;
id
in
(g, fresh)
let fresh gen = (gen, incr gen)
let to_string = string_of_int
let to_int x = x
let of_int x = x
let nth v id = List.nth v id
let nth_opt v id = List.nth_opt v id
let rec update_nth vec id v =
match (vec, id) with
| [], _ -> raise (Invalid_argument "Out of range")
| _ :: vec', 0 -> v :: vec'
| x :: vec', _ -> x :: update_nth vec' (id - 1) v
let mapi = List.mapi
let mapi_from1 f ls =
let rec aux i ls =
match ls with [] -> [] | x :: ls' -> f i x :: aux (i + 1) ls'
in
aux 1 ls
module Ord = struct
type t = id
let compare = compare
end
module Set = Set.Make (Ord)
module Map = Map.Make (Ord)
type set_t = Set.t
type +!'a map_t = 'a Map.t
let show_set_t s =
let ids = Set.fold (fun id s -> to_string id :: s) s [] in
let ids = List.rev ids in
"{" ^ String.concat "," ids ^ "}"
let pp_set_t fmt s =
let pp_string = Format.pp_print_string fmt in
pp_string "{";
Set.iter (fun id -> pp_string (to_string id ^ ",")) s;
pp_string "}"
let show_map_t show_a s =
let ids =
Map.fold (fun id x s -> (to_string id ^ " -> " ^ show_a x) :: s) s []
in
let ids = List.rev ids in
"{" ^ String.concat "," ids ^ "}"
let pp_map_t (pp_a : Format.formatter -> 'a -> unit) (fmt : Format.formatter)
(m : 'a map_t) : unit =
let pp_string = Format.pp_print_string fmt in
pp_string "{";
Map.iter
(fun id x ->
pp_string (to_string id ^ " -> ");
pp_a fmt x;
pp_string ",")
m;
pp_string "}"
let set_to_string indent_opt ids =
let indent, sep =
match indent_opt with Some indent -> (indent, ",\n") | None -> ("", ",")
in
let ids = Set.fold (fun id ids -> (indent ^ to_string id) :: ids) ids [] in
match ids with
| [] -> "{}"
| _ -> "{\n" ^ String.concat sep (List.rev ids) ^ "\n}"
let map_to_string indent_opt a_to_string ids =
let indent, sep =
match indent_opt with Some indent -> (indent, ",\n") | None -> ("", ",")
in
let ids =
Map.fold
(fun id v ids ->
(indent ^ to_string id ^ " -> " ^ a_to_string v) :: ids)
ids []
in
match ids with
| [] -> "{}"
| _ -> "{\n" ^ String.concat sep (List.rev ids) ^ "\n}"
let id_of_json js =
(* TODO: check boundaries ? *)
match js with
| `Int i -> Ok i
| _ -> Error ("id_of_json: failed on " ^ Yojson.Basic.show js)
end
type name = string list [@@deriving show]
(** A name such as: `std::collections::vector` (which would be represented as
[["std"; "collections"; "vector"]]) *)
|
