forked from ocaml/ocaml
-
Notifications
You must be signed in to change notification settings - Fork 6
/
Copy pathwarnings.mli
133 lines (120 loc) · 5.69 KB
/
warnings.mli
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
(**************************************************************************)
(* *)
(* OCaml *)
(* *)
(* Pierre Weis && Damien Doligez, INRIA Rocquencourt *)
(* *)
(* Copyright 1998 Institut National de Recherche en Informatique et *)
(* en Automatique. *)
(* *)
(* All rights reserved. This file is distributed under the terms of *)
(* the GNU Lesser General Public License version 2.1, with the *)
(* special exception on linking described in the file LICENSE. *)
(* *)
(**************************************************************************)
type loc = {
loc_start: Lexing.position;
loc_end: Lexing.position;
loc_ghost: bool;
}
type t =
| Comment_start (* 1 *)
| Comment_not_end (* 2 *)
| Deprecated of string * loc * loc (* 3 *)
| Fragile_match of string (* 4 *)
| Partial_application (* 5 *)
| Labels_omitted of string list (* 6 *)
| Method_override of string list (* 7 *)
| Partial_match of string (* 8 *)
| Non_closed_record_pattern of string (* 9 *)
| Statement_type (* 10 *)
| Unused_match (* 11 *)
| Unused_pat (* 12 *)
| Instance_variable_override of string list (* 13 *)
| Illegal_backslash (* 14 *)
| Implicit_public_methods of string list (* 15 *)
| Unerasable_optional_argument (* 16 *)
| Undeclared_virtual_method of string (* 17 *)
| Not_principal of string (* 18 *)
| Without_principality of string (* 19 *)
| Unused_argument (* 20 *)
| Nonreturning_statement (* 21 *)
| Preprocessor of string (* 22 *)
| Useless_record_with (* 23 *)
| Bad_module_name of string (* 24 *)
| All_clauses_guarded (* 8, used to be 25 *)
| Unused_var of string (* 26 *)
| Unused_var_strict of string (* 27 *)
| Wildcard_arg_to_constant_constr (* 28 *)
| Eol_in_string (* 29 *)
| Duplicate_definitions of string * string * string * string (* 30 *)
| Multiple_definition of string * string * string (* 31 *)
| Unused_value_declaration of string (* 32 *)
| Unused_open of string (* 33 *)
| Unused_type_declaration of string (* 34 *)
| Unused_for_index of string (* 35 *)
| Unused_ancestor of string (* 36 *)
| Unused_constructor of string * bool * bool (* 37 *)
| Unused_extension of string * bool * bool * bool (* 38 *)
| Unused_rec_flag (* 39 *)
| Name_out_of_scope of string * string list * bool (* 40 *)
| Ambiguous_name of string list * string list * bool (* 41 *)
| Disambiguated_name of string (* 42 *)
| Nonoptional_label of string (* 43 *)
| Open_shadow_identifier of string * string (* 44 *)
| Open_shadow_label_constructor of string * string (* 45 *)
| Bad_env_variable of string * string (* 46 *)
| Attribute_payload of string * string (* 47 *)
| Eliminated_optional_arguments of string list (* 48 *)
| No_cmi_file of string * string option (* 49 *)
| Bad_docstring of bool (* 50 *)
| Expect_tailcall (* 51 *)
| Fragile_literal_pattern (* 52 *)
| Misplaced_attribute of string (* 53 *)
| Duplicated_attribute of string (* 54 *)
| Inlining_impossible of string (* 55 *)
| Unreachable_case (* 56 *)
| Ambiguous_pattern of string list (* 57 *)
| No_cmx_file of string (* 58 *)
| Assignment_to_non_mutable_value (* 59 *)
| Unused_module of string (* 60 *)
| Unboxable_type_in_prim_decl of string (* 61 *)
| Constraint_on_gadt (* 62 *)
#if undefined BS_NO_COMPILER_PATCH then
| Bs_unused_attribute of string (* 101 *)
| Bs_polymorphic_comparison (* 102 *)
| Bs_ffi_warning of string (* 103 *)
| Bs_derive_warning of string (* 104 *)
| Bs_fragile_external of string (* 105 *)
#end
;;
val parse_options : bool -> string -> unit;;
val without_warnings : (unit -> 'a) -> 'a
val is_active : t -> bool;;
val is_error : t -> bool;;
val defaults_w : string;;
val defaults_warn_error : string;;
type reporting_information =
{ number : int
; message : string
; is_error : bool
; sub_locs : (loc * string) list;
}
val report : t -> [ `Active of reporting_information | `Inactive ]
exception Errors;;
val check_fatal : unit -> unit;;
val reset_fatal: unit -> unit
val help_warnings: unit -> unit
type state
val backup: unit -> state
val restore: state -> unit
val mk_lazy: (unit -> 'a) -> 'a Lazy.t
(** Like [Lazy.of_fun], but the function is applied with
the warning settings at the time [mk_lazy] is called. *)
#if undefined BS_NO_COMPILER_PATCH then
val message : t -> string
val number: t -> int
val super_report :
(t -> string) ->
t -> [ `Active of reporting_information | `Inactive ]
#end