-
Notifications
You must be signed in to change notification settings - Fork 0
/
Error.ml
106 lines (93 loc) · 3.2 KB
/
Error.ml
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
open Format
open Lexing
exception Terminate
type verbose = Vquiet | Vnormal | Vverbose
let flagVerbose = ref Vnormal
let numErrors = ref 0
let maxErrors = ref 10
let flagWarnings = ref true
let numWarnings = ref 0
let maxWarnings = ref 200
type position =
PosPoint of Lexing.position
| PosContext of Lexing.position * Lexing.position
| PosDummy
let position_point lpos = PosPoint lpos
let position_context lpos_start lpos_end = PosContext (lpos_start, lpos_end)
let position_dummy = PosDummy
let print_position ppf pos =
match pos with
| PosPoint lpos ->
fprintf ppf "@[file \"%s\",@ line %d,@ character %d:@]@ "
lpos.pos_fname lpos.pos_lnum (lpos.pos_cnum - lpos.pos_bol)
| PosContext (lpos_start, lpos_end) ->
if lpos_start.pos_fname != lpos_end.pos_fname then
fprintf ppf "@[file \"%s\",@ line %d,@ character %d to@ \
file %s,@ line %d,@ character %d:@]@ "
lpos_start.pos_fname lpos_start.pos_lnum
(lpos_start.pos_cnum - lpos_start.pos_bol)
lpos_end.pos_fname lpos_end.pos_lnum
(lpos_end.pos_cnum - lpos_end.pos_bol)
else if lpos_start.pos_lnum != lpos_end.pos_lnum then
fprintf ppf "@[file \"%s\",@ line %d,@ character %d to@ \
line %d,@ character %d:@]@ "
lpos_start.pos_fname lpos_start.pos_lnum
(lpos_start.pos_cnum - lpos_start.pos_bol)
lpos_end.pos_lnum
(lpos_end.pos_cnum - lpos_end.pos_bol)
else if lpos_start.pos_cnum - lpos_start.pos_bol !=
lpos_end.pos_cnum - lpos_end.pos_bol then
fprintf ppf "@[file \"%s\",@ line %d,@ characters %d to %d:@]@ "
lpos_start.pos_fname lpos_start.pos_lnum
(lpos_start.pos_cnum - lpos_start.pos_bol)
(lpos_end.pos_cnum - lpos_end.pos_bol)
else
fprintf ppf "@[file \"%s\", line %d, character %d:@]@ "
lpos_start.pos_fname lpos_start.pos_lnum
(lpos_start.pos_cnum - lpos_start.pos_bol)
| PosDummy ->
()
let no_out buf pos len = ()
let no_flush () = ()
let null_formatter = make_formatter no_out no_flush
let internal_raw (fname, lnum) fmt =
let fmt = "@[<v 2>" ^^ fmt ^^ "@]@;@?" in
incr numErrors;
let cont ppf =
raise Terminate in
eprintf "Internal error occurred at %s:%d,@ " fname lnum;
kfprintf cont err_formatter fmt
and fatal fmt =
let fmt = "@[<v 2>Fatal error: " ^^ fmt ^^ "@]@;@?" in
incr numErrors;
let cont ppf =
raise Terminate in
kfprintf cont err_formatter fmt
and error fmt =
let fmt = "@[<v 2>Error: " ^^ fmt ^^ "@]@;@?" in
incr numErrors;
if !numErrors >= !maxErrors then
let cont ppf =
eprintf "Too many errors, aborting...\n";
raise Terminate in
kfprintf cont err_formatter fmt
else
eprintf fmt
and warning fmt =
let fmt = "@[<v 2>Warning: " ^^ fmt ^^ "@]@;@?" in
if !flagWarnings then
begin
incr numWarnings;
if !numWarnings >= !maxWarnings then
let cont ppf =
eprintf "Too many warnings, no more will be shown...\n";
flagWarnings := false in
kfprintf cont err_formatter fmt
else
eprintf fmt
end
else
fprintf null_formatter fmt
and message fmt =
let fmt = "@[<v 2>" ^^ fmt ^^ "@]@;@?" in
eprintf fmt