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
|
open StdLabels
type t =
[ (* Parsing bytecode *)
`Integer_overflow
| `Missing_debug_event
| `Missing_cmi
| `Effect_handlers_without_effect_backend
| (* runtime *)
`Missing_primitive
| `Missing_define
| `Missing_deps
| `Deprecated_joo_global_object
| `Overriding_primitive
| `Overriding_primitive_purity
| `Deprecated_primitive
| `Unused_js_variable
| `Free_variables_in_primitive
]
module StringTable = Hashtbl.Make (struct
type t = string
let equal = String.equal
let hash = Hashtbl.hash
end)
module Table = Hashtbl.Make (struct
type nonrec t = t
let hash = Hashtbl.hash
let equal (a : t) b = a = b
end)
let state = Table.create 0
let enable t = Table.add state t true
let disable t = Table.add state t false
let default = function
(* Parsing bytecode *)
| `Integer_overflow | `Missing_debug_event | `Missing_cmi -> true
(* effects *)
| `Effect_handlers_without_effect_backend -> true
(* runtime *)
| `Missing_primitive | `Missing_define | `Missing_deps | `Free_variables_in_primitive ->
true
| `Deprecated_joo_global_object -> true
| `Overriding_primitive | `Overriding_primitive_purity -> true
| `Deprecated_primitive -> true
| `Unused_js_variable -> false
let all =
[ (* Parsing bytecode *)
`Integer_overflow
; `Missing_debug_event
; `Missing_cmi
; `Effect_handlers_without_effect_backend
; (* runtime *)
`Missing_primitive
; `Missing_define
; `Missing_deps
; `Deprecated_joo_global_object
; `Overriding_primitive
; `Overriding_primitive_purity
; `Deprecated_primitive
; `Unused_js_variable
; `Free_variables_in_primitive
]
let name = function
(* Parsing bytecode *)
| `Integer_overflow -> "integer-overflow"
| `Missing_debug_event -> "missing-debug-event"
| `Missing_cmi -> "missing-cmi"
(* effects *)
| `Effect_handlers_without_effect_backend -> "missing-effects-backend"
(* runtime *)
| `Missing_primitive -> "missing-primitive"
| `Missing_define -> "missing-define"
| `Missing_deps -> "missing-deps"
| `Free_variables_in_primitive -> "free-variables"
| `Deprecated_joo_global_object -> "deprecated-joo-global-object"
| `Overriding_primitive -> "overriding-primitive"
| `Overriding_primitive_purity -> "overriding-primitive-purity"
| `Deprecated_primitive -> "deprecated-primitive"
| `Unused_js_variable -> "unused-js-vars"
let parse : string -> t option =
let h = StringTable.create 18 in
List.iter all ~f:(fun t ->
let name = name t in
(* We use the no- prefix to disable warnings *)
assert (not (String.starts_with ~prefix:"no-" name));
StringTable.add h name t);
fun s -> StringTable.find_opt h s
let enabled t =
match Table.find_opt state t with
| Some b -> b
| None -> default t
let quiet = ref false
let werror = ref false
let warnings = ref 0
let warn (t : t) fmt =
Format.kasprintf
(fun s ->
if enabled t && not !quiet
then (
incr warnings;
Format.eprintf "Warning%s: %s%!" (Printf.sprintf " [%s]" (name t)) s))
fmt
let process_warnings () =
if !warnings > 0 && !werror
then (
Format.eprintf "%s: all warnings being treated as errors@." Sys.argv.(0);
exit 1)
|
