blob: b022b18d064240c524ab11c89dd7561aa383e591 (
plain)
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
|
module C = Collections
(** 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
(** Id generator - simply a counter *)
type generator
val zero : id
val generator_zero : generator
val generator_from_incr_id : id -> generator
val fresh_stateful_generator : unit -> generator ref * (unit -> id)
val mk_stateful_generator : generator -> generator ref * (unit -> id)
val incr : id -> id
(* TODO: this should be stateful! - but we may want to be able to duplicate
contexts...
Maybe we could have a [fresh] and a [global_fresh]
TODO: change the order of the returned types
*)
val fresh : generator -> id * generator
val to_string : id -> string
val pp_id : Format.formatter -> id -> unit
val show_id : id -> string
val id_of_json : Yojson.Basic.t -> (id, string) result
val compare_id : id -> id -> int
val max : id -> id -> id
val min : id -> id -> id
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
(* TODO: change the signature (invert the index and the list *)
val nth_opt : 'a list -> id -> 'a option
(** Update the nth element of the list.
Raises [Invalid_argument] if the identifier is out of range.
*)
val update_nth : 'a list -> id -> 'a -> 'a list
val mapi : (id -> 'a -> 'b) -> 'a list -> 'b list
(** Same as {!mapi}, but where the indices start with 1.
TODO: generalize to [map_from_i]
*)
val mapi_from1 : (id -> 'a -> 'b) -> 'a list -> 'b list
val iteri : (id -> 'a -> unit) -> 'a list -> unit
module Ord : C.OrderedType with type t = id
module Set : C.Set with type elt = id
module Map : C.Map with type key = id
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 generator_from_incr_id id = incr id
let mk_stateful_generator g =
let g = ref g in
let fresh () =
let id = !g in
g := incr id;
id
in
(g, fresh)
let fresh_stateful_generator () = mk_stateful_generator 0
let fresh gen = (gen, incr gen)
let to_string = string_of_int
let to_int x = x
let of_int x = x
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 compare_id = compare
let max id0 id1 = if id0 > id1 then id0 else id1
let min id0 id1 = if id0 < id1 then id0 else id1
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
let iteri = List.iteri
module Ord = struct
type t = id
let compare = compare
let to_string = to_string
let pp_t = pp_id
let show_t = show_id
end
module Set = C.MakeSet (Ord)
module Map = C.MakeMap (Ord)
end
|
