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
|
open Errors
(** 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 'a vector
val zero : id
val fresh : generator -> id * generator
val to_string : id -> string
val empty_vector : 'a vector
val vector_to_list : 'a vector -> 'a list
val vector_of_list : 'a list -> 'a vector
val length : 'a vector -> int
val nth : 'a vector -> id -> 'a
val nth_opt : 'a vector -> id -> 'a option
val update_nth : 'a vector -> id -> 'a -> 'a vector
val iter : ('a -> unit) -> 'a vector -> unit
val map : ('a -> 'b) -> 'a vector -> 'b vector
module Set : Set.S with type elt = id
val set_to_string : Set.t -> string
module Map : Map.S with type key = id
val id_of_json : Yojson.Basic.t -> (id, string) result
val vector_of_json :
(Yojson.Basic.t -> ('a, string) result) ->
Yojson.Basic.t ->
('a vector, string) result
end
(** Generative functor for identifiers.
See [Id].
*)
module IdGen () : Id = struct
(* TODO: use Z.t *)
type id = int
type generator = id
type 'a vector = 'a list
let 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 gen = (gen, incr gen)
let to_string = string_of_int
let empty_vector = []
let vector_to_list v = v
let vector_of_list v = v
let length v = List.length v
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
| [], _ -> failwith "Unreachable"
| _ :: vec', 0 -> v :: vec'
| x :: vec', _ -> x :: update_nth vec' (id - 1) v
let iter = List.iter
let map = List.map
module Set = Set.Make (struct
type t = id
let compare = compare
end)
module Map = Map.Make (struct
type t = id
let compare = compare
end)
let set_to_string ids =
let ids = Set.fold (fun id ids -> to_string id :: ids) ids [] in
"{" ^ String.concat ", " (List.rev ids) ^ "}"
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)
let vector_of_json a_of_json js =
OfJsonBasic.combine_error_msgs js "vector_of_json"
(OfJsonBasic.list_of_json a_of_json js)
end
type name = string list [@@deriving yojson]
(** A name such as: `std::collections::vector` (which would be represented as
[["std"; "collections"; "vector"]]) *)
|
