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
type loc = int * int
type 'a node = 'a * loc
let range (x, y) (l : 'a node list) : loc =
let max = List.fold_left (fun max (_, (_, max')) -> Int.max max max') y l in
(x, max)
type warnor =
| UnusedArgument of {
action_name : string;
argument_name : string;
possible_arguments : string list;
loc : loc;
}
| Parsing_failure of { msg : string; loc : loc }
type 'a t = 'a * warnor list
let errors_acc : warnor list ref = ref []
let add x = errors_acc := x :: !errors_acc
let with_ f =
let old_errors = !errors_acc in
errors_acc := [];
let clean_up () =
let errors = !errors_acc in
errors_acc := old_errors;
errors
in
try
let res = f () in
(res, clean_up ())
with exn ->
let _ = clean_up () in
raise exn
module M = struct
let ( let$ ) (x, warnings) f =
let x, warnings' = f x in
(x, warnings @ warnings')
let ( let$+ ) (x, warnings) f =
let x = f x in
(x, warnings)
end
module RM = struct
let ( let$$ ) x f =
match x with
| Error _ as e -> e
| Ok (x, warnings) -> (
match f x with
| Error _ as e -> e
| Ok (x, warnings') -> Ok (x, warnings @ warnings'))
end