blob: 627c67cc63be979d33b762af3f58dbd7a7634c3a (
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
|
exception IntegerOverflow of unit
(** 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 'a vector
val zero : id
val incr : id -> id
val to_string : id -> string
val empty : 'a vector
val id_of_yojson : Yojson.Safe.t -> (id, string) Result.result
val id_of_json : Yojson.Basic.t -> (id, string) Result.result
val id_to_yojson : id -> Yojson.Safe.t
val vector_of_yojson :
(Yojson.Safe.t -> ('a, string) Result.result) ->
Yojson.Safe.t ->
('a vector, string) Result.result
val vector_of_json :
(Yojson.Basic.t -> ('a, string) Result.result) ->
Yojson.Basic.t ->
('a vector, string) Result.result
val vector_to_yojson : ('a -> Yojson.Safe.t) -> 'a vector -> Yojson.Safe.t
(* TODO: remove *)
(* module Map : Map.S with type key = id *)
end
(** Generative functor for identifiers.
See [Id].
*)
module IdGen () : Id = struct
(* TODO: use Int64.t *)
type id = int [@@deriving yojson]
type 'a vector = 'a list [@@deriving yojson]
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 (IntegerOverflow ()) else x + 1
let to_string = string_of_int
let empty = []
let id_of_json js =
match js with
| `Int i -> Ok i
| _ -> Error ("id_of_json: failed on " ^ Yojson.Basic.show js)
let ( let* ) o f = match o with Error e -> Error e | Ok x -> f x
(* TODO: this duplicates code from CfimToJson *)
let rec of_json_list (a_of_json : Yojson.Basic.t -> ('a, string) result)
(jsl : Yojson.Basic.t list) : ('a list, string) result =
match jsl with
| [] -> Ok []
| x :: jsl' ->
let* x = a_of_json x in
let* jsl' = of_json_list a_of_json jsl' in
Ok (x :: jsl')
let vector_of_json a_of_json js =
match js with
| `List jsl -> (
match of_json_list a_of_json jsl with
| Error msg ->
Error
("vector_of_json failed on: " ^ Yojson.Basic.show js ^ ":\n" ^ msg)
| Ok x -> Ok x)
| _ -> Error ("not a list: " ^ Yojson.Basic.show js)
(* TODO: how to make this work? *)
(* (module Ord : Map.OrderedType = struct
type t = id
let compare t1 t2 = t2 - t1
end)
module IdMap = Map.Make (Ord) *)
(* module Map = Map.Make (struct
type t = id
let compare = Stdlib.compare
end) *)
(* let ord =
(module struct
type t = id
let compare = Stdlib.compare
end)
module Map = Map.Make (ord) *)
end
type name = string list [@@deriving yojson]
(** A name such as: `std::collections::vector` (which would be represented as
[["std"; "collections"; "vector"]]) *)
|
