Poor man's backtraces for "assert false"
[hiphop-php.git] / hphp / hack / src / utils / errors.ml
blob83ce16a5bae9eecd5d8c5c0ba61dbc2d7889f95b
1 (**
2 * Copyright (c) 2014, Facebook, Inc.
3 * All rights reserved.
5 * This source code is licensed under the BSD-style license found in the
6 * LICENSE file in the "hack" directory of this source tree. An additional grant
7 * of patent rights can be found in the PATENTS file in the same directory.
9 *)
11 open Core
12 open Utils
14 (*****************************************************************************)
15 (* Types *)
16 (*****************************************************************************)
18 type error_code = int
19 (* We use `Pos.t message` on the server and convert to `Pos.absolute message`
20 * before sending it to the client *)
21 type 'a message = 'a * string
22 type 'a error_ = error_code * 'a message list
23 type error = Pos.t error_
24 type t = error list
26 (*****************************************************************************)
27 (* HH_FIXMEs hook *)
28 (*****************************************************************************)
30 let (is_hh_fixme: (Pos.t -> error_code -> bool) ref) = ref (fun _ _ -> false)
32 (*****************************************************************************)
33 (* Errors accumulator. *)
34 (*****************************************************************************)
36 let (error_list: t ref) = ref []
37 let accumulate_errors = ref false
39 let add_error error =
40 if !accumulate_errors
41 then error_list := error :: !error_list
42 else
43 (* We have an error, but haven't handled it in any way *)
44 assert_false_log_backtrace ()
46 let add code pos msg =
47 if !is_hh_fixme pos code then () else
48 add_error (code, [pos, msg])
50 let add_list code pos_msg_l =
51 let pos = fst (List.hd_exn pos_msg_l) in
52 if !is_hh_fixme pos code then () else
53 add_error (code, pos_msg_l)
55 (*****************************************************************************)
56 (* Accessors. *)
57 (*****************************************************************************)
59 let get_code (error: 'a error_) = ((fst error): error_code)
60 let get_pos (error : error) = fst (List.hd_exn (snd error))
61 let to_list (error : 'a error_) = snd error
63 let make_error code (x: (Pos.t * string) list) = ((code, x): error)
65 (*****************************************************************************)
66 (* Error code printing. *)
67 (*****************************************************************************)
69 let error_kind error_code =
70 match error_code / 1000 with
71 | 1 -> "Parsing"
72 | 2 -> "Naming"
73 | 3 -> "NastCheck"
74 | 4 -> "Typing"
75 | 5 -> "Lint"
76 | _ -> "Other"
78 let error_code_to_string error_code =
79 let error_kind = error_kind error_code in
80 let error_number = string_of_int error_code in
81 error_kind^"["^error_number^"]"
83 (*****************************************************************************)
84 (* Error codes.
85 * Each error has a unique number associated with it. The following modules
86 * define the error code associated with each kind of error.
87 * It is ok to extend the codes with new values, it is NOT OK to change the
88 * value of an existing error to a different error code!
89 * I added some comments to make that extra clear :-)
91 (*****************************************************************************)
93 module Parsing = struct
94 let fixme_format = 1001 (* DONT MODIFY!!!! *)
95 let parsing_error = 1002 (* DONT MODIFY!!!! *)
96 let unexpected_eof = 1003 (* DONT MODIFY!!!! *)
97 let unterminated_comment = 1004 (* DONT MODIFY!!!! *)
98 let unterminated_xhp_comment = 1005 (* DONT MODIFY!!!! *)
100 (* EXTEND HERE WITH NEW VALUES IF NEEDED *)
103 module Naming = struct
104 let add_a_typehint = 2001 (* DONT MODIFY!!!! *)
105 let typeparam_alok = 2002 (* DONT MODIFY!!!! *)
106 let assert_arity = 2003 (* DONT MODIFY!!!! *)
107 let primitive_invalid_alias = 2004 (* DONT MODIFY!!!! *)
108 let cyclic_constraint = 2005 (* DONT MODIFY!!!! *)
109 let did_you_mean_naming = 2006 (* DONT MODIFY!!!! *)
110 let different_scope = 2007 (* DONT MODIFY!!!! *)
111 let disallowed_xhp_type = 2008 (* DONT MODIFY!!!! *)
112 (* DEPRECATED let double_instead_of_float = 2009 *)
113 (* DEPRECATED let dynamic_class = 2010 *)
114 let dynamic_method_call = 2011 (* DONT MODIFY!!!! *)
115 let error_name_already_bound = 2012 (* DONT MODIFY!!!! *)
116 let expected_collection = 2013 (* DONT MODIFY!!!! *)
117 let expected_variable = 2014 (* DONT MODIFY!!!! *)
118 let fd_name_already_bound = 2015 (* DONT MODIFY!!!! *)
119 let gen_array_rec_arity = 2016 (* DONT MODIFY!!!! *)
120 (* let gen_array_va_rec_arity = 2017 *)
121 let gena_arity = 2018 (* DONT MODIFY!!!! *)
122 let generic_class_var = 2019 (* DONT MODIFY!!!! *)
123 let genva_arity = 2020 (* DONT MODIFY!!!! *)
124 let illegal_CLASS = 2021 (* DONT MODIFY!!!! *)
125 let illegal_class_meth = 2022 (* DONT MODIFY!!!! *)
126 let illegal_constant = 2023 (* DONT MODIFY!!!! *)
127 let illegal_fun = 2024 (* DONT MODIFY!!!! *)
128 let illegal_inst_meth = 2025 (* DONT MODIFY!!!! *)
129 let illegal_meth_caller = 2026 (* DONT MODIFY!!!! *)
130 let illegal_meth_fun = 2027 (* DONT MODIFY!!!! *)
131 (* DEPRECATED integer_instead_of_int = 2028 *)
132 let invalid_req_extends = 2029 (* DONT MODIFY!!!! *)
133 let invalid_req_implements = 2030 (* DONT MODIFY!!!! *)
134 let local_const = 2031 (* DONT MODIFY!!!! *)
135 let lowercase_this = 2032 (* DONT MODIFY!!!! *)
136 let method_name_already_bound = 2033 (* DONT MODIFY!!!! *)
137 let missing_arrow = 2034 (* DONT MODIFY!!!! *)
138 let missing_typehint = 2035 (* DONT MODIFY!!!! *)
139 let name_already_bound = 2036 (* DONT MODIFY!!!! *)
140 let naming_too_few_arguments = 2037 (* DONT MODIFY!!!! *)
141 let naming_too_many_arguments = 2038 (* DONT MODIFY!!!! *)
142 let primitive_toplevel = 2039 (* DONT MODIFY!!!! *)
143 (* DEPRECATED let real_instead_of_float = 2040 *)
144 let shadowed_type_param = 2041 (* DONT MODIFY!!!! *)
145 let start_with_T = 2042 (* DONT MODIFY!!!! *)
146 let this_must_be_return = 2043 (* DONT MODIFY!!!! *)
147 let this_no_argument = 2044 (* DONT MODIFY!!!! *)
148 let this_hint_outside_class = 2045 (* DONT MODIFY!!!! *)
149 let this_reserved = 2046 (* DONT MODIFY!!!! *)
150 let tparam_with_tparam = 2047 (* DONT MODIFY!!!! *)
151 let typedef_constraint = 2048 (* DONT MODIFY!!!! *)
152 let unbound_name = 2049 (* DONT MODIFY!!!! *)
153 let undefined = 2050 (* DONT MODIFY!!!! *)
154 let unexpected_arrow = 2051 (* DONT MODIFY!!!! *)
155 let unexpected_typedef = 2052 (* DONT MODIFY!!!! *)
156 let using_internal_class = 2053 (* DONT MODIFY!!!! *)
157 let void_cast = 2054 (* DONT MODIFY!!!! *)
158 let object_cast = 2055 (* DONT MODIFY!!!! *)
159 let unset_cast = 2056 (* DONT MODIFY!!!! *)
160 (* DEPRECATED let nullsafe_property_access = 2057 *)
161 let illegal_TRAIT = 2058 (* DONT MODIFY!!!! *)
162 (* DEPRECATED let shape_typehint = 2059 *)
163 let dynamic_new_in_strict_mode = 2060 (* DONT MODIFY!!!! *)
164 let invalid_type_access_root = 2061 (* DONT MODIFY!!!! *)
165 let duplicate_user_attribute = 2062 (* DONT MODIFY!!!! *)
166 let return_only_typehint = 2063 (* DONT MODIFY!!!! *)
167 let unexpected_type_arguments = 2064 (* DONT MODIFY!!!! *)
168 let too_many_type_arguments = 2065 (* DONT MODIFY!!!! *)
169 let classname_param = 2066 (* DONT MODIFY!!!! *)
171 (* EXTEND HERE WITH NEW VALUES IF NEEDED *)
174 module NastCheck = struct
175 let abstract_body = 3001 (* DONT MODIFY!!!! *)
176 let abstract_with_body = 3002 (* DONT MODIFY!!!! *)
177 let await_in_sync_function = 3003 (* DONT MODIFY!!!! *)
178 let call_before_init = 3004 (* DONT MODIFY!!!! *)
179 let case_fallthrough = 3005 (* DONT MODIFY!!!! *)
180 let continue_in_switch = 3006 (* DONT MODIFY!!!! *)
181 let dangerous_method_name = 3007 (* DONT MODIFY!!!! *)
182 let default_fallthrough = 3008 (* DONT MODIFY!!!! *)
183 let interface_with_member_variable = 3009 (* DONT MODIFY!!!! *)
184 let interface_with_static_member_variable = 3010 (* DONT MODIFY!!!! *)
185 let magic = 3011 (* DONT MODIFY!!!! *)
186 let no_construct_parent = 3012 (* DONT MODIFY!!!! *)
187 let non_interface = 3013 (* DONT MODIFY!!!! *)
188 let not_abstract_without_body = 3014 (* DONT MODIFY!!!! *)
189 let not_initialized = 3015 (* DONT MODIFY!!!! *)
190 let not_public_interface = 3016 (* DONT MODIFY!!!! *)
191 let requires_non_class = 3017 (* DONT MODIFY!!!! *)
192 let return_in_finally = 3018 (* DONT MODIFY!!!! *)
193 let return_in_gen = 3019 (* DONT MODIFY!!!! *)
194 let toString_returns_string = 3020 (* DONT MODIFY!!!! *)
195 let toString_visibility = 3021 (* DONT MODIFY!!!! *)
196 let toplevel_break = 3022 (* DONT MODIFY!!!! *)
197 let toplevel_continue = 3023 (* DONT MODIFY!!!! *)
198 let uses_non_trait = 3024 (* DONT MODIFY!!!! *)
199 let illegal_function_name = 3025 (* DONT MODIFY!!!! *)
200 let not_abstract_without_typeconst = 3026 (* DONT MODIFY!!!! *)
201 let typeconst_depends_on_external_tparam = 3027 (* DONT MODIFY!!!! *)
202 let typeconst_assigned_tparam = 3028 (* DONT MODIFY!!!! *)
203 let abstract_with_typeconst = 3029 (* DONT MODIFY!!!! *)
204 let constructor_required = 3030 (* DONT MODIFY!!!! *)
205 let interface_with_partial_typeconst = 3031 (* DONT MODIFY!!!! *)
206 (* EXTEND HERE WITH NEW VALUES IF NEEDED *)
209 module Typing = struct
210 (* let abstract_class_final = 4001 (\* DONT MODIFY!!!! *\) *)
211 let uninstantiable_class = 4002 (* DONT MODIFY!!!! *)
212 let anonymous_recursive = 4003 (* DONT MODIFY!!!! *)
213 let anonymous_recursive_call = 4004 (* DONT MODIFY!!!! *)
214 let array_access = 4005 (* DONT MODIFY!!!! *)
215 let array_append = 4006 (* DONT MODIFY!!!! *)
216 let array_cast = 4007 (* DONT MODIFY!!!! *)
217 let array_get_arity = 4008 (* DONT MODIFY!!!! *)
218 let bad_call = 4009 (* DONT MODIFY!!!! *)
219 let class_arity = 4010 (* DONT MODIFY!!!! *)
220 let const_mutation = 4011 (* DONT MODIFY!!!! *)
221 let constructor_no_args = 4012 (* DONT MODIFY!!!! *)
222 let cyclic_class_def = 4013 (* DONT MODIFY!!!! *)
223 let cyclic_typedef = 4014 (* DONT MODIFY!!!! *)
224 let discarded_awaitable = 4015 (* DONT MODIFY!!!! *)
225 let isset_empty_in_strict = 4016 (* DONT MODIFY!!!! *)
226 (* DEPRECATED dynamic_yield_private = 4017 *)
227 let enum_constant_type_bad = 4018 (* DONT MODIFY!!!! *)
228 let enum_switch_nonexhaustive = 4019 (* DONT MODIFY!!!! *)
229 let enum_switch_not_const = 4020 (* DONT MODIFY!!!! *)
230 let enum_switch_redundant = 4021 (* DONT MODIFY!!!! *)
231 let enum_switch_redundant_default = 4022 (* DONT MODIFY!!!! *)
232 let enum_switch_wrong_class = 4023 (* DONT MODIFY!!!! *)
233 let enum_type_bad = 4024 (* DONT MODIFY!!!! *)
234 let enum_type_typedef_mixed = 4025 (* DONT MODIFY!!!! *)
235 let expected_class = 4026 (* DONT MODIFY!!!! *)
236 let expected_literal_string = 4027 (* DONT MODIFY!!!! *)
237 (* DEPRECATED expected_static_int = 4028 *)
238 let expected_tparam = 4029 (* DONT MODIFY!!!! *)
239 let expecting_return_type_hint = 4030 (* DONT MODIFY!!!! *)
240 let expecting_return_type_hint_suggest = 4031 (* DONT MODIFY!!!! *)
241 let expecting_type_hint = 4032 (* DONT MODIFY!!!! *)
242 let expecting_type_hint_suggest = 4033 (* DONT MODIFY!!!! *)
243 let extend_final = 4035 (* DONT MODIFY!!!! *)
244 let field_kinds = 4036 (* DONT MODIFY!!!! *)
245 (* DEPRECATED field_missing = 4037 *)
246 let format_string = 4038 (* DONT MODIFY!!!! *)
247 let fun_arity_mismatch = 4039 (* DONT MODIFY!!!! *)
248 let fun_too_few_args = 4040 (* DONT MODIFY!!!! *)
249 let fun_too_many_args = 4041 (* DONT MODIFY!!!! *)
250 let fun_unexpected_nonvariadic = 4042 (* DONT MODIFY!!!! *)
251 let fun_variadicity_hh_vs_php56 = 4043 (* DONT MODIFY!!!! *)
252 let gena_expects_array = 4044 (* DONT MODIFY!!!! *)
253 let generic_array_strict = 4045 (* DONT MODIFY!!!! *)
254 let generic_static = 4046 (* DONT MODIFY!!!! *)
255 let implement_abstract = 4047 (* DONT MODIFY!!!! *)
256 let interface_final = 4048 (* DONT MODIFY!!!! *)
257 let invalid_shape_field_const = 4049 (* DONT MODIFY!!!! *)
258 let invalid_shape_field_literal = 4050 (* DONT MODIFY!!!! *)
259 let invalid_shape_field_name = 4051 (* DONT MODIFY!!!! *)
260 let invalid_shape_field_type = 4052 (* DONT MODIFY!!!! *)
261 let member_not_found = 4053 (* DONT MODIFY!!!! *)
262 let member_not_implemented = 4054 (* DONT MODIFY!!!! *)
263 let missing_assign = 4055 (* DONT MODIFY!!!! *)
264 let missing_constructor = 4056 (* DONT MODIFY!!!! *)
265 let missing_field = 4057 (* DONT MODIFY!!!! *)
266 (* DEPRECATED negative_tuple_index = 4058 *)
267 let self_outside_class = 4059 (* DONT MODIFY!!!! *)
268 let new_static_inconsistent = 4060 (* DONT MODIFY!!!! *)
269 let static_outside_class = 4061 (* DONT MODIFY!!!! *)
270 let non_object_member = 4062 (* DONT MODIFY!!!! *)
271 let null_container = 4063 (* DONT MODIFY!!!! *)
272 let null_member = 4064 (* DONT MODIFY!!!! *)
273 let nullable_parameter = 4065 (* DONT MODIFY!!!! *)
274 let option_return_only_typehint = 4066 (* DONT MODIFY!!!! *)
275 let object_string = 4067 (* DONT MODIFY!!!! *)
276 let option_mixed = 4068 (* DONT MODIFY!!!! *)
277 let overflow = 4069 (* DONT MODIFY!!!! *)
278 let override_final = 4070 (* DONT MODIFY!!!! *)
279 let override_per_trait = 4071 (* DONT MODIFY!!!! *)
280 let pair_arity = 4072 (* DONT MODIFY!!!! *)
281 let abstract_call = 4073 (* DONT MODIFY!!!! *)
282 let parent_in_trait = 4074 (* DONT MODIFY!!!! *)
283 let parent_outside_class = 4075 (* DONT MODIFY!!!! *)
284 let parent_undefined = 4076 (* DONT MODIFY!!!! *)
285 let previous_default = 4077 (* DONT MODIFY!!!! *)
286 let private_class_meth = 4078 (* DONT MODIFY!!!! *)
287 let private_inst_meth = 4079 (* DONT MODIFY!!!! *)
288 let private_override = 4080 (* DONT MODIFY!!!! *)
289 let protected_class_meth = 4081 (* DONT MODIFY!!!! *)
290 let protected_inst_meth = 4082 (* DONT MODIFY!!!! *)
291 let read_before_write = 4083 (* DONT MODIFY!!!! *)
292 let return_in_void = 4084 (* DONT MODIFY!!!! *)
293 let shape_field_class_mismatch = 4085 (* DONT MODIFY!!!! *)
294 let shape_field_type_mismatch = 4086 (* DONT MODIFY!!!! *)
295 let should_be_override = 4087 (* DONT MODIFY!!!! *)
296 let sketchy_null_check = 4088 (* DONT MODIFY!!!! *)
297 let sketchy_null_check_primitive = 4089 (* DONT MODIFY!!!! *)
298 let smember_not_found = 4090 (* DONT MODIFY!!!! *)
299 let static_dynamic = 4091 (* DONT MODIFY!!!! *)
300 (* DEPRECATED let static_overflow = 4092 *)
301 let this_in_static = 4094 (* DONT MODIFY!!!! *)
302 let this_var_outside_class = 4095 (* DONT MODIFY!!!! *)
303 let trait_final = 4096 (* DONT MODIFY!!!! *)
304 let tuple_arity = 4097 (* DONT MODIFY!!!! *)
305 let tuple_arity_mismatch = 4098 (* DONT MODIFY!!!! *)
306 (* DEPRECATED tuple_index_too_large = 4099 *)
307 let tuple_syntax = 4100 (* DONT MODIFY!!!! *)
308 let type_arity_mismatch = 4101 (* DONT MODIFY!!!! *)
309 let type_param_arity = 4102 (* DONT MODIFY!!!! *)
310 let typing_too_few_args = 4104 (* DONT MODIFY!!!! *)
311 let typing_too_many_args = 4105 (* DONT MODIFY!!!! *)
312 let unbound_global = 4106 (* DONT MODIFY!!!! *)
313 let unbound_name_typing = 4107 (* DONT MODIFY!!!! *)
314 let undefined_field = 4108 (* DONT MODIFY!!!! *)
315 let undefined_parent = 4109 (* DONT MODIFY!!!! *)
316 let unify_error = 4110 (* DONT MODIFY!!!! *)
317 let unsatisfied_req = 4111 (* DONT MODIFY!!!! *)
318 let visibility = 4112 (* DONT MODIFY!!!! *)
319 let visibility_extends = 4113 (* DONT MODIFY!!!! *)
320 (* DEPRECATED void_parameter = 4114 *)
321 let wrong_extend_kind = 4115 (* DONT MODIFY!!!! *)
322 let generic_unify = 4116 (* DONT MODIFY!!!! *)
323 let nullsafe_not_needed = 4117 (* DONT MODIFY!!!! *)
324 let trivial_strict_eq = 4118 (* DONT MODIFY!!!! *)
325 let void_usage = 4119 (* DONT MODIFY!!!! *)
326 let declared_covariant = 4120 (* DONT MODIFY!!!! *)
327 let declared_contravariant = 4121 (* DONT MODIFY!!!! *)
328 (* DEPRECATED unset_in_strict = 4122 *)
329 let strict_members_not_known = 4123 (* DONT MODIFY!!!! *)
330 let generic_at_runtime = 4124 (* DONT MODIFY!!!! *)
331 let dynamic_class = 4125 (* DONT MODIFY!!!! *)
332 let attribute_arity = 4126 (* DONT MODIFY!!!! *)
333 let attribute_param_type = 4127 (* DONT MODIFY!!!! *)
334 let deprecated_use = 4128 (* DONT MODIFY!!!! *)
335 let abstract_const_usage = 4129 (* DONT MODIFY!!!! *)
336 let cannot_declare_constant = 4130 (* DONT MODIFY!!!! *)
337 let cyclic_typeconst = 4131 (* DONT MODIFY!!!! *)
338 let nullsafe_property_write_context = 4132 (* DONT MODIFY!!!! *)
339 let noreturn_usage = 4133 (* DONT MODIFY!!!! *)
340 let this_lvalue = 4134 (* DONT MODIFY!!!! *)
341 let unset_nonidx_in_strict = 4135 (* DONT MODIFY!!!! *)
342 let invalid_shape_field_name_empty = 4136 (* DONT MODIFY!!!! *)
343 let invalid_shape_field_name_number = 4137 (* DONT MODIFY!!!! *)
344 let shape_fields_unknown = 4138 (* DONT MODIFY!!!! *)
345 let invalid_shape_remove_key = 4139 (* DONT MODIFY!!!! *)
346 let missing_optional_field = 4140 (* DONT MODIFY!!!! *)
347 let shape_field_unset = 4141 (* DONT MODIFY!!!! *)
348 let abstract_concrete_override = 4142 (* DONT MODIFY!!!! *)
349 let local_variable_modifed_and_used = 4143 (* DONT MODIFY!!!! *)
350 let local_variable_modifed_twice = 4144 (* DONT MODIFY!!!! *)
351 let assign_during_case = 4145 (* DONT MODIFY!!!! *)
352 let cyclic_enum_constraint = 4146 (* DONT MODIFY!!!! *)
353 let unpacking_disallowed = 4147 (* DONT MODIFY!!!! *)
354 let invalid_classname = 4148 (* DONT MODIFY!!!! *)
355 (* EXTEND HERE WITH NEW VALUES IF NEEDED *)
358 (*****************************************************************************)
359 (* Parsing errors. *)
360 (*****************************************************************************)
362 let fixme_format pos =
363 add Parsing.fixme_format pos
364 "HH_FIXME wrong format, expected '/* HH_FIXME[ERROR_NUMBER] */'"
366 let unexpected_eof pos =
367 add Parsing.unexpected_eof pos "Unexpected end of file"
369 let unterminated_comment pos =
370 add Parsing.unterminated_comment pos "unterminated comment"
372 let unterminated_xhp_comment pos =
373 add Parsing.unterminated_xhp_comment pos "unterminated xhp comment"
375 let parsing_error (p, msg) =
376 add Parsing.parsing_error p msg
378 (*****************************************************************************)
379 (* Naming errors *)
380 (*****************************************************************************)
382 let typeparam_alok (pos, x) =
383 add Naming.typeparam_alok pos (
384 "You probably forgot to bind this type parameter right?\nAdd <"^x^
385 "> somewhere (after the function name definition, \
386 or after the class name)\nExamples: "^"function foo<T> or class A<T>")
388 let generic_class_var pos =
389 add Naming.generic_class_var pos
390 "A class variable cannot be generic"
392 let unexpected_arrow pos cname =
393 add Naming.unexpected_arrow pos (
394 "Keys may not be specified for "^cname^" initialization"
397 let missing_arrow pos cname =
398 add Naming.missing_arrow pos (
399 "Keys must be specified for "^cname^" initialization"
402 let disallowed_xhp_type pos name =
403 add Naming.disallowed_xhp_type pos (
404 name^" is not a valid type. Use :xhp or XHPChild."
407 let name_already_bound name pos1 pos2 =
408 let name = Utils.strip_ns name in
409 add_list Naming.name_already_bound [
410 pos1, "Name already bound: "^name;
411 pos2, "Previous definition is here"
414 let method_name_already_bound pos name =
415 add Naming.method_name_already_bound pos (
416 "Method name already bound: "^name
419 let error_name_already_bound name name_prev p p_prev =
420 let name = Utils.strip_ns name in
421 let name_prev = Utils.strip_ns name_prev in
422 let errs = [
423 p, "Name already bound: "^name;
424 p_prev, (if String.compare name name_prev == 0
425 then "Previous definition is here"
426 else "Previous definition "^name_prev^" differs only in capitalization ")
427 ] in
428 let hhi_msg =
429 "This appears to be defined in an hhi file included in your project "^
430 "root. The hhi files for the standard library are now a part of the "^
431 "typechecker and must be removed from your project. Typically, you can "^
432 "do this by deleting the \"hhi\" directory you copied into your "^
433 "project when first starting with Hack." in
434 let errs =
435 if (Relative_path.prefix p.Pos.pos_file) = Relative_path.Hhi
436 then errs @ [p_prev, hhi_msg]
437 else if (Relative_path.prefix p_prev.Pos.pos_file) = Relative_path.Hhi
438 then errs @ [p, hhi_msg]
439 else errs in
440 add_list Naming.error_name_already_bound errs
442 let unbound_name pos name kind =
443 let kind_str = match kind with
444 | `cls -> "an object type"
445 | `func -> "a global function"
446 | `const -> "a global constant"
448 add Naming.unbound_name pos
449 ("Unbound name: "^(strip_ns name)^" ("^kind_str^")")
451 let different_scope pos var_name pos' =
452 add_list Naming.different_scope [
453 pos, ("The variable "^ var_name ^" is defined");
454 pos', ("But in a different scope")
457 let undefined pos var_name =
458 add Naming.undefined pos ("Undefined variable: "^var_name)
460 let this_reserved pos =
461 add Naming.this_reserved pos
462 "The type parameter \"this\" is reserved"
464 let start_with_T pos =
465 add Naming.start_with_T pos
466 "Please make your type parameter start with the letter T (capital)"
468 let already_bound pos name =
469 add Naming.name_already_bound pos ("Argument already bound: "^name)
471 let unexpected_typedef pos def_pos =
472 add_list Naming.unexpected_typedef [
473 pos, "Unexpected typedef";
474 def_pos, "Definition is here";
477 let fd_name_already_bound pos =
478 add Naming.fd_name_already_bound pos
479 "Field name already bound"
481 let primitive_toplevel pos =
482 add Naming.primitive_toplevel pos (
483 "Primitive type annotations are always available and may no \
484 longer be referred to in the toplevel namespace."
487 let primitive_invalid_alias pos used valid =
488 add Naming.primitive_invalid_alias pos
489 ("Invalid Hack type. Using '"^used^"' in Hack is considered \
490 an error. Use '"^valid^"' instead, to keep the codebase \
491 consistent.")
493 let dynamic_new_in_strict_mode pos =
494 add Naming.dynamic_new_in_strict_mode pos
495 "Cannot use dynamic new in strict mode"
497 let invalid_type_access_root (pos, id) =
498 add Naming.invalid_type_access_root pos
499 (id^" must be an identifier for a class, \"self\", or \"this\"")
501 let duplicate_user_attribute (pos, name) existing_attr_pos =
502 add_list Naming.duplicate_user_attribute [
503 pos, "You cannot reuse the attribute "^name;
504 existing_attr_pos, name^" was already used here";
507 let unbound_attribute_name pos name =
508 let reason = if (str_starts_with name "__")
509 then "starts with __ but is not a standard attribute"
510 else "is not listed in .hhconfig"
511 in add Naming.unbound_name pos
512 ("Unrecognized user attribute: "^name^" "^reason)
514 let this_no_argument pos =
515 add Naming.this_no_argument pos "\"this\" expects no arguments"
517 let void_cast pos =
518 add Naming.void_cast pos "Cannot cast to void."
520 let unset_cast pos =
521 add Naming.unset_cast pos "Don't use (unset), just assign null!"
523 let object_cast pos x =
524 add Naming.object_cast pos ("Object casts are unsupported. "^
525 "Try 'if ($var instanceof "^x^")' or "^
526 "'invariant($var instanceof "^x^", ...)'.")
528 let this_hint_outside_class pos =
529 add Naming.this_hint_outside_class pos
530 "Cannot use \"this\" outside of a class"
532 let this_type_forbidden pos =
533 add Naming.this_must_be_return pos
534 "The type \"this\" cannot be used as a constraint on a class' generic, \
535 or as the type of a static member variable"
537 let lowercase_this pos type_ =
538 add Naming.lowercase_this pos (
539 "Invalid Hack type \""^type_^"\". Use \"this\" instead"
542 let classname_param pos =
543 add Naming.classname_param pos
544 ("Missing type parameter to classname; classname is entirely"
545 ^" meaningless without one")
547 let tparam_with_tparam pos x =
548 add Naming.tparam_with_tparam pos (
549 Printf.sprintf "%s is a type parameter. Type parameters cannot \
550 themselves take type parameters (e.g. %s<int> doesn't make sense)" x x
553 let shadowed_type_param p pos name =
554 add_list Naming.shadowed_type_param [
555 p, Printf.sprintf "You cannot re-bind the type parameter %s" name;
556 pos, Printf.sprintf "%s is already bound here" name
559 let missing_typehint pos =
560 add Naming.missing_typehint pos
561 "Please add a type hint"
563 let expected_variable pos =
564 add Naming.expected_variable pos
565 "Was expecting a variable name"
567 let naming_too_few_arguments pos =
568 add Naming.naming_too_few_arguments pos
569 "Too few arguments"
571 let naming_too_many_arguments pos =
572 add Naming.naming_too_many_arguments pos
573 "Too many arguments"
575 let expected_collection pos cn =
576 add Naming.expected_collection pos (
577 "Unexpected collection type " ^ (Utils.strip_ns cn)
580 let illegal_CLASS pos =
581 add Naming.illegal_CLASS pos
582 "Using __CLASS__ outside a class or trait"
584 let illegal_TRAIT pos =
585 add Naming.illegal_TRAIT pos
586 "Using __TRAIT__ outside a trait"
588 let dynamic_method_call pos =
589 add Naming.dynamic_method_call pos
590 "Dynamic method call"
592 let nullsafe_property_write_context pos =
593 add Typing.nullsafe_property_write_context pos
594 "?-> syntax not supported here, this function effectively does a write"
596 let illegal_fun pos =
597 let msg = "The argument to fun() must be a single-quoted, constant "^
598 "literal string representing a valid function name." in
599 add Naming.illegal_fun pos msg
601 let illegal_meth_fun pos =
602 let msg = "String argument to fun() contains ':';"^
603 " for static class methods, use"^
604 " class_meth(Cls::class, 'method_name'), not fun('Cls::method_name')" in
605 add Naming.illegal_meth_fun pos msg
607 let illegal_inst_meth pos =
608 let msg = "The argument to inst_meth() must be an expression and a "^
609 "constant literal string representing a valid method name." in
610 add Naming.illegal_inst_meth pos msg
612 let illegal_meth_caller pos =
613 let msg =
614 "The two arguments to meth_caller() must be:"
615 ^"\n - first: ClassOrInterface::class"
616 ^"\n - second: a single-quoted string literal containing the name"
617 ^" of a non-static method of that class" in
618 add Naming.illegal_meth_caller pos msg
620 let illegal_class_meth pos =
621 let msg =
622 "The two arguments to class_meth() must be:"
623 ^"\n - first: ValidClassname::class"
624 ^"\n - second: a single-quoted string literal containing the name"
625 ^" of a static method of that class" in
626 add Naming.illegal_class_meth pos msg
628 let assert_arity pos =
629 add Naming.assert_arity pos
630 "assert expects exactly one argument"
632 let gena_arity pos =
633 add Naming.gena_arity pos
634 "gena() expects exactly 1 argument"
636 let genva_arity pos =
637 add Naming.genva_arity pos
638 "genva() expects at least 1 argument"
640 let gen_array_rec_arity pos =
641 add Naming.gen_array_rec_arity pos
642 "gen_array_rec() expects exactly 1 argument"
644 let dynamic_class pos =
645 add Typing.dynamic_class pos
646 "Don't use dynamic classes"
648 let uninstantiable_class usage_pos decl_pos name =
649 let name = strip_ns name in
650 add_list Typing.uninstantiable_class [
651 usage_pos, (name^" is uninstantiable");
652 decl_pos, "Declaration is here"
655 let abstract_const_usage usage_pos decl_pos name =
656 let name = strip_ns name in
657 add_list Typing.abstract_const_usage [
658 usage_pos, ("Cannot reference abstract constant "^name^" directly");
659 decl_pos, "Declaration is here"
662 let typedef_constraint pos =
663 add Naming.typedef_constraint pos
664 "Constraints on typedefs are not supported"
666 let add_a_typehint pos =
667 add Naming.add_a_typehint pos
668 "Please add a type hint"
670 let local_const var_pos =
671 add Naming.local_const var_pos
672 "You cannot use a local variable in a constant definition"
674 let illegal_constant pos =
675 add Naming.illegal_constant pos
676 "Illegal constant value"
678 let cyclic_constraint pos =
679 add Naming.cyclic_constraint pos
680 "Cyclic constraint"
682 let invalid_req_implements pos =
683 add Naming.invalid_req_implements pos
684 "Only traits may use 'require implements'"
686 let invalid_req_extends pos =
687 add Naming.invalid_req_extends pos
688 "Only traits and interfaces may use 'require extends'"
690 let did_you_mean_naming pos name suggest_pos suggest_name =
691 add_list Naming.did_you_mean_naming [
692 pos, "Could not find "^(strip_ns name);
693 suggest_pos, "Did you mean "^(strip_ns suggest_name)^"?"
696 let using_internal_class pos name =
697 add Naming.using_internal_class pos (
698 name^" is an implementation internal class that cannot be used directly"
701 (*****************************************************************************)
702 (* Init check errors *)
703 (*****************************************************************************)
705 let no_construct_parent pos =
706 add NastCheck.no_construct_parent pos (
707 sl["You are extending a class that needs to be initialized\n";
708 "Make sure you call parent::__construct.\n"
712 let constructor_required (pos, name) prop_names =
713 let name = Utils.strip_ns name in
714 let props_str = SSet.fold (fun x acc -> x^" "^acc) prop_names "" in
715 add NastCheck.constructor_required pos
716 ("Lacking __construct, class "^name^" does not initialize its private member(s): "^props_str)
718 let not_initialized (pos, cname) prop_names =
719 let cname = Utils.strip_ns cname in
720 let props_str = SSet.fold (fun x acc -> x^" "^acc) prop_names "" in
721 let members, verb = if 1 == SSet.cardinal prop_names then "member", "is"
722 else "members", "are" in
723 let setters_str = SSet.fold (fun x acc -> "$this->"^x^" "^acc) prop_names "" in
724 add NastCheck.not_initialized pos (
726 "Class "; cname ; " does not initialize all of its members; ";
727 props_str; verb; " not always initialized.";
728 "\nMake sure you systematically set "; setters_str;
729 "when the method __construct is called.";
730 "\nAlternatively, you can define the "; members ;" as optional (?...)\n"
733 let call_before_init pos cv =
734 add NastCheck.call_before_init pos (
735 sl([
736 "Until the initialization of $this is over,";
737 " you can only call private methods\n";
738 "The initialization is not over because ";
740 if cv = "parent::__construct"
741 then ["you forgot to call parent::__construct"]
742 else ["$this->"; cv; " can still potentially be null"])
745 (*****************************************************************************)
746 (* Nast errors check *)
747 (*****************************************************************************)
749 let type_arity pos name nargs =
750 add Typing.type_arity_mismatch pos (
751 sl["The type ";(Utils.strip_ns name);
752 " expects ";nargs;" type parameter(s)"]
755 let abstract_with_body (p, _) =
756 add NastCheck.abstract_with_body p
757 "This method is declared as abstract, but has a body"
759 let not_abstract_without_body (p, _) =
760 add NastCheck.not_abstract_without_body p
761 "This method is not declared as abstract, it must have a body"
763 let not_abstract_without_typeconst (p, _) =
764 add NastCheck.not_abstract_without_typeconst p
765 ("This type constant is not declared as abstract, it must have"^
766 " an assigned type")
768 let abstract_with_typeconst (p, _) =
769 add NastCheck.abstract_with_typeconst p
770 ("This type constant is declared as abstract, it cannot be assigned a type")
772 let typeconst_depends_on_external_tparam pos ext_pos ext_name =
773 add_list NastCheck.typeconst_depends_on_external_tparam [
774 pos, ("A type constant can only use type parameters declared in its own"^
775 " type parameter list");
776 ext_pos, (ext_name ^ " was declared as a type parameter here");
779 let typeconst_assigned_tparam pos tp_name =
780 add NastCheck.typeconst_assigned_tparam pos
781 (tp_name ^" is a type parameter. It cannot be assigned to a type constant")
783 let interface_with_partial_typeconst tconst_pos =
784 add NastCheck.interface_with_partial_typeconst tconst_pos
785 "An interface cannot contain a partially abstract type constant"
787 let return_in_gen p =
788 add NastCheck.return_in_gen p
789 ("You cannot return a value in a generator (a generator"^
790 " is a function that uses yield)")
792 let return_in_finally p =
793 add NastCheck.return_in_finally p
794 ("Don't use return in a finally block;"^
795 " there's nothing to receive the return value")
797 let toplevel_break p =
798 add NastCheck.toplevel_break p
799 "break can only be used inside loops or switch statements"
801 let toplevel_continue p =
802 add NastCheck.toplevel_continue p
803 "continue can only be used inside loops"
805 let continue_in_switch p =
806 add NastCheck.continue_in_switch p
807 ("In PHP, 'continue;' inside a switch \
808 statement is equivalent to 'break;'."^
809 " Hack does not support this; use 'break' if that is what you meant.")
811 let await_in_sync_function p =
812 add NastCheck.await_in_sync_function p
813 "await can only be used inside async functions"
815 let magic (p, s) =
816 add NastCheck.magic p
817 ("Don't call "^s^" it's one of these magic things we want to avoid")
819 let non_interface (p : Pos.t) (c2: string) (verb: string): 'a =
820 add NastCheck.non_interface p
821 ("Cannot " ^ verb ^ " " ^ (strip_ns c2) ^ " - it is not an interface")
823 let toString_returns_string pos =
824 add NastCheck.toString_returns_string pos "__toString should return a string"
826 let toString_visibility pos =
827 add NastCheck.toString_visibility pos
828 "__toString must have public visibility and cannot be static"
830 let uses_non_trait (p: Pos.t) (n: string) (t: string) =
831 add NastCheck.uses_non_trait p
832 ((Utils.strip_ns n) ^ " is not a trait. It is " ^ t ^ ".")
834 let requires_non_class (p: Pos.t) (n: string) (t: string) =
835 add NastCheck.requires_non_class p
836 ((Utils.strip_ns n) ^ " is not a class. It is " ^ t ^ ".")
838 let abstract_body pos =
839 add NastCheck.abstract_body pos "This method shouldn't have a body"
841 let not_public_interface pos =
842 add NastCheck.not_public_interface pos
843 "Access type for interface method must be public"
845 let interface_with_member_variable pos =
846 add NastCheck.interface_with_member_variable pos
847 "Interfaces cannot have member variables"
849 let interface_with_static_member_variable pos =
850 add NastCheck.interface_with_static_member_variable pos
851 "Interfaces cannot have static variables"
853 let illegal_function_name pos mname =
854 add NastCheck.illegal_function_name pos
855 ("Illegal function name: " ^ strip_ns mname)
857 let dangerous_method_name pos =
858 add NastCheck.dangerous_method_name pos (
859 "This is a dangerous method name, "^
860 "if you want to define a constructor, use "^
861 "__construct"
864 (*****************************************************************************)
865 (* Nast terminality *)
866 (*****************************************************************************)
868 let case_fallthrough pos1 pos2 =
869 add_list NastCheck.case_fallthrough [
870 pos1, ("This switch has a case that implicitly falls through and is "^
871 "not annotated with // FALLTHROUGH");
872 pos2, "This case implicitly falls through"
875 let default_fallthrough pos =
876 add NastCheck.default_fallthrough pos
877 ("This switch has a default case that implicitly falls "^
878 "through and is not annotated with // FALLTHROUGH")
880 (*****************************************************************************)
881 (* Typing errors *)
882 (*****************************************************************************)
884 let visibility_extends vis pos parent_pos parent_vis =
885 let msg1 = pos, "This member visibility is: " ^ vis in
886 let msg2 = parent_pos, parent_vis ^ " was expected" in
887 add_list Typing.visibility_extends [msg1; msg2]
889 let member_not_implemented member_name parent_pos pos defn_pos =
890 let msg1 = pos, "This object doesn't implement the method "^member_name in
891 let msg2 = parent_pos, "Which is required by this interface" in
892 let msg3 = defn_pos, "As defined here" in
893 add_list Typing.member_not_implemented [msg1; msg2; msg3]
895 let bad_decl_override parent_pos parent_name pos name (error: error) =
896 let msg1 = pos, ("This object is of type "^(strip_ns name)) in
897 let msg2 = parent_pos,
898 ("It is incompatible with this object of type "^(strip_ns parent_name)^
899 "\nbecause some declarations are incompatible."^
900 "\nRead the following to see why:"
901 ) in
902 (* This is a cascading error message *)
903 let code, msgl = error in
904 add_list code (msg1 :: msg2 :: msgl)
906 let bad_enum_decl pos (error: error) =
907 let msg = pos,
908 "This enum declaration is invalid.\n\
909 Read the following to see why:"
911 (* This is a cascading error message *)
912 let code, msgl = error in
913 add_list code (msg :: msgl)
915 let missing_constructor pos =
916 add Typing.missing_constructor pos
917 "The constructor is not implemented"
919 let typedef_trail_entry pos =
920 pos, "Typedef definition comes from here"
922 let add_with_trail code errs trail =
923 add_list code (errs @ List.map trail typedef_trail_entry)
925 let enum_constant_type_bad pos ty_pos ty trail =
926 add_with_trail Typing.enum_constant_type_bad
927 [pos, "Enum constants must be an int or string";
928 ty_pos, "Not " ^ ty]
929 trail
931 let enum_type_bad pos ty trail =
932 add_with_trail Typing.enum_type_bad
933 [pos, "Enums must be int or string, not " ^ ty]
934 trail
936 let enum_type_typedef_mixed pos =
937 add Typing.enum_type_typedef_mixed pos
938 "Can't use typedef that resolves to mixed in enum"
940 let enum_switch_redundant const first_pos second_pos =
941 add_list Typing.enum_switch_redundant [
942 second_pos, "Redundant case statement";
943 first_pos, const ^ " already handled here"
946 let enum_switch_nonexhaustive pos missing enum_pos =
947 add_list Typing.enum_switch_nonexhaustive [
948 pos, "Switch statement nonexhaustive; the following cases are missing: " ^
949 String.concat ", " missing;
950 enum_pos, "Enum declared here"
953 let enum_switch_redundant_default pos enum_pos =
954 add_list Typing.enum_switch_redundant_default [
955 pos, "All cases already covered; a redundant default case prevents "^
956 "detecting future errors";
957 enum_pos, "Enum declared here"
960 let enum_switch_not_const pos =
961 add Typing.enum_switch_not_const pos
962 "Case in switch on enum is not an enum constant"
964 let enum_switch_wrong_class pos expected got =
965 add Typing.enum_switch_wrong_class pos
966 ("Switching on enum " ^ expected ^ " but using constant from " ^ got)
968 let invalid_shape_field_name p =
969 add Typing.invalid_shape_field_name p
970 "Was expecting a constant string or class constant (for shape access)"
972 let invalid_shape_field_name_empty p =
973 add Typing.invalid_shape_field_name_empty p
974 "A shape field name cannot be an empty string"
976 let invalid_shape_field_name_number p =
977 add Typing.invalid_shape_field_name_number p
978 "A shape field name cannot start with numbers"
980 let invalid_shape_field_type pos ty_pos ty trail =
981 add_with_trail Typing.invalid_shape_field_type
982 [pos, "A shape field name must be an int or string";
983 ty_pos, "Not " ^ ty]
984 trail
986 let invalid_shape_field_literal key_pos witness_pos =
987 add_list Typing.invalid_shape_field_literal
988 [key_pos, "Shape uses literal string as field name";
989 witness_pos, "But expected a class constant"]
991 let invalid_shape_field_const key_pos witness_pos =
992 add_list Typing.invalid_shape_field_const
993 [key_pos, "Shape uses class constant as field name";
994 witness_pos, "But expected a literal string"]
996 let shape_field_class_mismatch key_pos witness_pos key_class witness_class =
997 add_list Typing.shape_field_class_mismatch
998 [key_pos, "Shape field name is class constant from " ^ key_class;
999 witness_pos, "But expected constant from " ^ witness_class]
1001 let shape_field_type_mismatch key_pos witness_pos key_ty witness_ty =
1002 add_list Typing.shape_field_type_mismatch
1003 [key_pos, "Shape field name is " ^ key_ty ^ " class constant";
1004 witness_pos, "But expected " ^ witness_ty]
1006 let missing_field pos1 pos2 name =
1007 add_list Typing.missing_field (
1008 (pos1, "The field '"^name^"' is missing")::
1009 [pos2, "The field '"^name^"' is defined"])
1011 let missing_optional_field pos1 pos2 name =
1012 add_list Typing.missing_optional_field
1013 (* We have the position of shape type that is marked as optional -
1014 * explain why we can't omit it despite this.*)
1015 (if pos2 <> Pos.none then (
1016 (pos1, "The field '"^name^"' may be set to an unknown type. " ^
1017 "Explicitly null out the field, or remove it " ^
1018 "(with Shapes::removeKey(...))")::
1019 [pos2, "The field '"^name^"' is defined as optional"])
1020 else
1021 [pos1, "The field '"^name^"' is missing"])
1023 let shape_fields_unknown pos1 pos2 =
1024 add_list Typing.shape_fields_unknown
1025 [pos1, "This is a shape type coming from a type annotation. Because of " ^
1026 "structural subtyping it might have some other fields besides " ^
1027 "those listed in its declaration.";
1028 pos2, "It is incompatible with a shape created using \"shape\" "^
1029 "constructor, which has all the fields known"]
1031 let shape_field_unset pos1 pos2 name =
1032 add_list Typing.shape_field_unset (
1033 [(pos1, "The field '"^name^"' was unset here");
1034 (pos2, "The field '"^name^"' might be present in this shape because of " ^
1035 "structural subtyping")]
1038 let invalid_shape_remove_key p =
1039 add Typing.invalid_shape_remove_key p
1040 "You can only unset fields of local variables"
1042 let explain_constraint p_inst pos name (error : error) =
1043 let inst_msg = "Some type constraint(s) here are violated" in
1044 let code, msgl = error in
1045 (* There may be multiple constraints instantiated at one spot; avoid
1046 * duplicating the instantiation message *)
1047 let msgl = match msgl with
1048 | (p, x) :: rest when x = inst_msg && p = p_inst -> rest
1049 | _ -> msgl in
1050 let name = Utils.strip_ns name in
1051 add_list code begin
1052 [p_inst, inst_msg;
1053 pos, "'"^name^"' is a constrained type"] @ msgl
1056 let explain_type_constant reason_msgl (error: error) =
1057 let code, msgl = error in
1058 add_list code (msgl @ reason_msgl)
1060 let overflow p =
1061 add Typing.overflow p "Value is too large"
1063 let format_string pos snippet s class_pos fname class_suggest =
1064 add_list Typing.format_string [
1065 (pos, "I don't understand the format string " ^ snippet ^ " in " ^ s);
1066 (class_pos,
1067 "You can add a new format specifier by adding "
1068 ^fname^"() to "^class_suggest)]
1070 let expected_literal_string pos =
1071 add Typing.expected_literal_string pos
1072 "This argument must be a literal string"
1074 let generic_array_strict p =
1075 add Typing.generic_array_strict p
1076 "You cannot have an array without generics in strict mode"
1078 let strict_members_not_known p name =
1079 let name = Utils.strip_ns name in
1080 add Typing.strict_members_not_known p
1081 (name^" has a non-<?hh grandparent; this is not allowed in strict mode"
1082 ^" because that parent may define methods of unknowable name and type")
1084 let option_return_only_typehint p kind =
1085 let (typehint, reason) = match kind with
1086 | `void -> ("?void", "only return implicitly")
1087 | `noreturn -> ("?noreturn", "never return")
1089 add Typing.option_return_only_typehint p
1090 (typehint^" is a nonsensical typehint; a function cannot both "^reason
1091 ^" and return null.")
1093 let tuple_syntax p =
1094 add Typing.tuple_syntax p
1095 ("Did you want a tuple? Try (X,Y), not tuple<X,Y>")
1097 let class_arity usage_pos class_pos class_name arity =
1098 add_list Typing.class_arity
1099 [usage_pos, ("The class "^(Utils.strip_ns class_name)^" expects "^
1100 soi arity^" arguments");
1101 class_pos, "Definition is here"]
1103 let expecting_type_hint p =
1104 add Typing.expecting_type_hint p "Was expecting a type hint"
1106 let expecting_type_hint_suggest p ty =
1107 add Typing.expecting_type_hint_suggest p
1108 ("Was expecting a type hint (what about: "^ty^")")
1110 let expecting_return_type_hint p =
1111 add Typing.expecting_return_type_hint p
1112 "Was expecting a return type hint"
1114 let expecting_return_type_hint_suggest p ty =
1115 add Typing.expecting_return_type_hint_suggest p
1116 ("Was expecting a return type hint (what about: ': "^ty^"')")
1118 let field_kinds pos1 pos2 =
1119 add_list Typing.field_kinds
1120 [pos1, "You cannot use this kind of field (value)";
1121 pos2, "Mixed with this kind of field (key => value)"]
1123 let unbound_name_typing pos name =
1124 add Typing.unbound_name_typing pos
1125 ("Unbound name (typing): "^(strip_ns name))
1127 let previous_default p =
1128 add Typing.previous_default p
1129 ("A previous parameter has a default value.\n"^
1130 "Remove all the default values for the preceding parameters,\n"^
1131 "or add a default value to this one.")
1133 let return_only_typehint p kind =
1134 let msg = match kind with
1135 | `void -> "void"
1136 | `noreturn -> "noreturn" in
1137 add Naming.return_only_typehint p
1138 ("The "^msg^" typehint can only be used to describe a function return type")
1140 let unexpected_type_arguments p =
1141 add Naming.unexpected_type_arguments p
1142 ("Type arguments are not expected for this type")
1144 let too_many_type_arguments p =
1145 add Naming.too_many_type_arguments p
1146 ("Too many type arguments for this type")
1148 let nullable_parameter pos =
1149 add Typing.nullable_parameter pos
1150 "Please add a ?, this argument can be null"
1152 let return_in_void pos1 pos2 =
1153 add_list Typing.return_in_void [
1154 pos1,
1155 "You cannot return a value";
1156 pos2,
1157 "This is a void function"
1160 let this_in_static p =
1161 add Typing.this_in_static p "Don't use $this in a static method"
1163 let this_var_outside_class p =
1164 add Typing.this_var_outside_class p "Can't use $this outside of a class"
1166 let unbound_global cst_pos =
1167 add Typing.unbound_global cst_pos "Unbound global constant (Typing)"
1169 let private_inst_meth method_pos p =
1170 add_list Typing.private_inst_meth [
1171 method_pos, "This is a private method";
1172 p, "you cannot use it with inst_meth \
1173 (whether you are in the same class or not)."
1176 let protected_inst_meth method_pos p =
1177 add_list Typing.protected_inst_meth [
1178 method_pos, "This is a protected method";
1179 p, "you cannot use it with inst_meth \
1180 (whether you are in the same class hierarchy or not)."
1183 let private_class_meth pos1 pos2 =
1184 add_list Typing.private_class_meth [
1185 pos1, "This is a private method";
1186 pos2, "you cannot use it with class_meth \
1187 (whether you are in the same class or not)."
1190 let protected_class_meth pos1 pos2 =
1191 add_list Typing.protected_class_meth [
1192 pos1, "This is a protected method";
1193 pos2, "you cannot use it with class_meth \
1194 (whether you are in the same class hierarchy or not)."
1197 let array_cast pos =
1198 add Typing.array_cast pos
1199 "(array) cast forbidden in strict mode; arrays with unspecified \
1200 key and value types are not allowed"
1202 let anonymous_recursive pos =
1203 add Typing.anonymous_recursive pos
1204 "Anonymous functions cannot be recursive"
1206 let static_outside_class pos =
1207 add Typing.static_outside_class pos
1208 "'static' is undefined outside of a class"
1210 let self_outside_class pos =
1211 add Typing.self_outside_class pos
1212 "'self' is undefined outside of a class"
1214 let new_inconsistent_construct new_pos (cpos, cname) kind =
1215 let name = Utils.strip_ns cname in
1216 let preamble = match kind with
1217 | `static -> "Can't use new static() for "^name
1218 | `classname -> "Can't use new on classname<"^name^">"
1220 add_list Typing.new_static_inconsistent [
1221 new_pos, preamble^"; __construct arguments are not \
1222 guaranteed to be consistent in child classes";
1223 cpos, ("This declaration neither defines an abstract/final __construct"
1224 ^" nor uses <<__ConsistentConstruct>> attribute")]
1226 let pair_arity pos =
1227 add Typing.pair_arity pos "A pair has exactly 2 elements"
1229 let tuple_arity pos2 size2 pos1 size1 =
1230 add_list Typing.tuple_arity [
1231 pos2, "This tuple has "^ string_of_int size2^" elements";
1232 pos1, string_of_int size1 ^ " were expected"]
1234 let undefined_parent pos =
1235 add Typing.undefined_parent pos
1236 "The parent class is undefined"
1238 let parent_outside_class pos =
1239 add Typing.parent_outside_class pos
1240 "'parent' is undefined outside of a class"
1242 let parent_abstract_call meth_name call_pos decl_pos =
1243 add_list Typing.abstract_call [
1244 call_pos, ("Cannot call parent::"^meth_name^"(); it is abstract");
1245 decl_pos, "Declaration is here"
1248 let self_abstract_call meth_name call_pos decl_pos =
1249 add_list Typing.abstract_call [
1250 call_pos, ("Cannot call self::"^meth_name^"(); it is abstract. Did you mean static::"^meth_name^"()?");
1251 decl_pos, "Declaration is here"
1254 let classname_abstract_call cname meth_name call_pos decl_pos =
1255 let cname = Utils.strip_ns cname in
1256 add_list Typing.abstract_call [
1257 call_pos, ("Cannot call "^cname^"::"^meth_name^"(); it is abstract");
1258 decl_pos, "Declaration is here"
1261 let isset_empty_in_strict pos name =
1262 let name = Utils.strip_ns name in
1263 add Typing.isset_empty_in_strict pos
1264 (name^" cannot be used in a completely type safe way and so is banned in "
1265 ^"strict mode")
1267 let unset_nonidx_in_strict pos msgs =
1268 add_list Typing.unset_nonidx_in_strict
1269 ([pos, "In strict mode, unset is banned except on array indexing"] @
1270 msgs)
1272 let unpacking_disallowed_builtin_function pos name =
1273 let name = Utils.strip_ns name in
1274 add Typing.unpacking_disallowed pos
1275 ("Arg unpacking is disallowed for "^name)
1277 let array_get_arity pos1 name pos2 =
1278 add_list Typing.array_get_arity [
1279 pos1, "You cannot use this "^(Utils.strip_ns name);
1280 pos2, "It is missing its type parameters"
1283 let typing_error pos msg =
1284 add Typing.generic_unify pos msg
1286 let typing_error_l err =
1287 add_error err
1289 let undefined_field p name =
1290 add Typing.undefined_field p ("The field "^name^" is undefined")
1292 let array_access pos1 pos2 ty =
1293 add_list Typing.array_access ((pos1,
1294 "This is not an object of type KeyedContainer, this is "^ty) ::
1295 if pos2 != Pos.none
1296 then [pos2, "You might want to check this out"]
1297 else [])
1299 let array_append pos1 pos2 ty =
1300 add_list Typing.array_append
1301 ((pos1, ty^" does not allow array append") ::
1302 if pos2 != Pos.none
1303 then [pos2, "You might want to check this out"]
1304 else [])
1306 let const_mutation pos1 pos2 ty =
1307 add_list Typing.const_mutation
1308 ((pos1, "You cannot mutate this") ::
1309 if pos2 != Pos.none
1310 then [(pos2, "This is " ^ ty)]
1311 else [])
1313 let expected_class pos =
1314 add Typing.expected_class pos
1315 "Was expecting a class"
1317 let snot_found_hint = function
1318 | `no_hint ->
1320 | `closest (pos, v) ->
1321 [pos, "The closest thing is "^v^" but it's not a static method"]
1322 | `did_you_mean (pos, v) ->
1323 [pos, "Did you mean: "^v]
1325 let string_of_class_member_kind = function
1326 | `class_constant -> "class constant"
1327 | `static_method -> "static method"
1328 | `class_variable -> "class variable"
1329 | `class_typeconst -> "type constant"
1331 let smember_not_found kind pos (cpos, class_name) member_name hint =
1332 let kind = string_of_class_member_kind kind in
1333 let class_name = strip_ns class_name in
1334 let msg = "Could not find "^kind^" "^member_name^" in type "^class_name in
1335 add_list Typing.smember_not_found
1336 ((pos, msg) :: (snot_found_hint hint
1337 @ [(cpos, "Declaration of "^class_name^" is here")]))
1339 let not_found_hint = function
1340 | `no_hint ->
1342 | `closest (pos, v) ->
1343 [pos, "The closest thing is "^v^" but it's a static method"]
1344 | `did_you_mean (pos, v) ->
1345 [pos, "Did you mean: "^v]
1347 let member_not_found kind pos (cpos, type_name) member_name hint reason =
1348 let type_name = strip_ns type_name in
1349 let kind =
1350 match kind with
1351 | `method_ -> "method"
1352 | `member -> "member"
1354 let msg = "Could not find "^kind^" "^member_name^" in an object of type "^
1355 type_name in
1356 add_list Typing.member_not_found
1357 ((pos, msg) :: (not_found_hint hint @ reason
1358 @ [(cpos, "Declaration of "^type_name^" is here")]))
1360 let parent_in_trait pos =
1361 add Typing.parent_in_trait pos
1362 ("parent:: inside a trait is undefined"
1363 ^" without 'require extends' of a class defined in <?hh")
1365 let parent_undefined pos =
1366 add Typing.parent_undefined pos
1367 "parent is undefined"
1369 let constructor_no_args pos =
1370 add Typing.constructor_no_args pos
1371 "This constructor expects no argument"
1373 let visibility p msg1 p_vis msg2 =
1374 add_list Typing.visibility [p, msg1; p_vis, msg2]
1376 let typing_too_many_args pos pos_def =
1377 add_list Typing.typing_too_many_args
1378 [pos, "Too many arguments"; pos_def, "Definition is here"]
1380 let typing_too_few_args pos pos_def =
1381 add_list Typing.typing_too_few_args
1382 [pos, "Too few arguments"; pos_def, "Definition is here"]
1384 let anonymous_recursive_call pos =
1385 add Typing.anonymous_recursive_call pos
1386 "recursive call to anonymous function"
1388 let bad_call pos ty =
1389 add Typing.bad_call pos
1390 ("This call is invalid, this is not a function, it is "^ty)
1392 let sketchy_null_check pos =
1393 add Typing.sketchy_null_check pos (
1394 "You are using a sketchy null check ...\n"^
1395 "Use is_null, or $x === null instead"
1398 let sketchy_null_check_primitive pos =
1399 add Typing.sketchy_null_check_primitive pos (
1400 "You are using a sketchy null check on a primitive type ...\n"^
1401 "Use is_null, or $x === null instead"
1404 let extend_final extend_pos decl_pos name =
1405 let name = (strip_ns name) in
1406 add_list Typing.extend_final [
1407 extend_pos, ("You cannot extend final class "^name);
1408 decl_pos, "Declaration is here"
1411 let read_before_write (pos, v) =
1412 add Typing.read_before_write pos (
1414 "Read access to $this->"; v; " before initialization"
1417 let interface_final pos =
1418 add Typing.interface_final pos
1419 "Interfaces cannot be final"
1421 let trait_final pos =
1422 add Typing.trait_final pos
1423 "Traits cannot be final"
1425 let implement_abstract ~is_final pos1 pos2 kind x =
1426 let name = "abstract "^kind^" '"^x^"'" in
1427 let msg1 =
1428 if is_final then
1429 "This class was declared as final. It must provide an implementation \
1430 for the "^name
1431 else
1432 "This class must be declared abstract, or provide an implementation \
1433 for the "^name in
1434 add_list Typing.implement_abstract [
1435 pos1, msg1;
1436 pos2, "Declaration is here";
1439 let generic_static pos x =
1440 add Typing.generic_static pos (
1441 "This static variable cannot use the type parameter "^x^"."
1444 let fun_too_many_args pos1 pos2 =
1445 add_list Typing.fun_too_many_args [
1446 pos1, "Too many mandatory arguments";
1447 pos2, "Because of this definition";
1450 let fun_too_few_args pos1 pos2 =
1451 add_list Typing.fun_too_few_args [
1452 pos1, "Too few arguments";
1453 pos2, "Because of this definition";
1456 let fun_unexpected_nonvariadic pos1 pos2 =
1457 add_list Typing.fun_unexpected_nonvariadic [
1458 pos1, "Should have a variadic argument";
1459 pos2, "Because of this definition";
1462 let fun_variadicity_hh_vs_php56 pos1 pos2 =
1463 add_list Typing.fun_variadicity_hh_vs_php56 [
1464 pos1, "Variadic arguments: ...-style is not a subtype of ...$args";
1465 pos2, "Because of this definition";
1468 let expected_tparam pos n =
1469 add Typing.expected_tparam pos (
1470 "Expected " ^
1471 (match n with
1472 | 0 -> "no type parameter"
1473 | 1 -> "a type parameter"
1474 | n -> string_of_int n ^ " type parameters"
1478 let object_string pos1 pos2 =
1479 add_list Typing.object_string [
1480 pos1, "You cannot use this object as a string";
1481 pos2, "This object doesn't implement __toString";
1484 let type_param_arity pos x n =
1485 add Typing.type_param_arity pos (
1486 "The type "^x^" expects "^n^" parameters"
1489 let cyclic_typedef p =
1490 add Typing.cyclic_typedef p
1491 "Cyclic typedef"
1493 let type_arity_mismatch pos1 n1 pos2 n2 =
1494 add_list Typing.type_arity_mismatch [
1495 pos1, "This type has "^n1^" arguments";
1496 pos2, "This one has "^n2;
1499 let this_final id pos2 (error: error) =
1500 let n = Utils.strip_ns (snd id) in
1501 let message1 = "Since "^n^" is not final" in
1502 let message2 = "this might not be a "^n in
1503 let code, msgl = error in
1504 add_list code (msgl @ [(fst id, message1); (pos2, message2)])
1506 let exact_class_final id pos2 (error: error) =
1507 let n = Utils.strip_ns (snd id) in
1508 let message1 = "This requires the late-bound type to be exactly "^n in
1509 let message2 =
1510 "Since " ^n^" is not final this might be an instance of a child class" in
1511 let code, msgl = error in
1512 add_list code (msgl @ [(fst id, message1); (pos2, message2)])
1514 let tuple_arity_mismatch pos1 n1 pos2 n2 =
1515 add_list Typing.tuple_arity_mismatch [
1516 pos1, "This tuple has "^n1^" elements";
1517 pos2, "This one has "^n2^" elements"
1520 let fun_arity_mismatch pos1 pos2 =
1521 add_list Typing.fun_arity_mismatch [
1522 pos1, "Number of arguments doesn't match";
1523 pos2, "Because of this definition";
1526 let discarded_awaitable pos1 pos2 =
1527 add_list Typing.discarded_awaitable [
1528 pos1, "This expression is of type Awaitable, but it's "^
1529 "either being discarded or used in a dangerous way before "^
1530 "being awaited";
1531 pos2, "This is why I think it is Awaitable"
1534 let gena_expects_array pos1 pos2 ty_str =
1535 add_list Typing.gena_expects_array [
1536 pos1, "gena expects an array";
1537 pos2, "It is incompatible with " ^ ty_str;
1540 let unify_error left right =
1541 add_list Typing.unify_error (left @ right)
1543 let static_dynamic static_position dyn_position method_name =
1544 let msg_static = "The function "^method_name^" is static" in
1545 let msg_dynamic = "It is defined as dynamic here" in
1546 add_list Typing.static_dynamic [
1547 static_position, msg_static;
1548 dyn_position, msg_dynamic
1551 let null_member s pos r =
1552 add_list Typing.null_member ([
1553 pos,
1554 "You are trying to access the member "^s^
1555 " but this object can be null. "
1556 ] @ r
1559 let non_object_member s pos1 ty pos2 =
1560 add_list Typing.non_object_member [
1561 pos1,
1562 ("You are trying to access the member "^s^
1563 " but this is not an object, it is "^
1564 ty);
1565 pos2,
1566 "Check this out"
1569 let null_container p null_witness =
1570 add_list Typing.null_container (
1573 "You are trying to access an element of this container"^
1574 " but the container could be null. "
1575 ] @ null_witness)
1577 let option_mixed pos =
1578 add Typing.option_mixed pos
1579 "?mixed is a redundant typehint - just use mixed"
1581 let declared_covariant pos1 pos2 emsg =
1582 add_list Typing.declared_covariant (
1583 [pos2, "Illegal usage of a covariant type parameter";
1584 pos1, "This is where the parameter was declared as covariant (+)"
1585 ] @ emsg
1588 let declared_contravariant pos1 pos2 emsg =
1589 add_list Typing.declared_contravariant (
1590 [pos2, "Illegal usage of a contravariant type parameter";
1591 pos1, "This is where the parameter was declared as contravariant (-)"
1592 ] @ emsg
1595 let cyclic_typeconst pos sl =
1596 let sl = List.map sl strip_ns in
1597 add Typing.cyclic_typeconst pos
1598 ("Cyclic type constant:\n "^String.concat " -> " sl)
1600 let this_lvalue pos =
1601 add Typing.this_lvalue pos "Cannot assign a value to $this"
1603 let abstract_concrete_override pos parent_pos kind =
1604 let kind_str = match kind with
1605 | `method_ -> "method"
1606 | `typeconst -> "type constant"
1607 | `constant -> "constant" in
1608 add_list Typing.abstract_concrete_override ([
1609 pos, "Cannot re-declare this " ^ kind_str ^ " as abstract";
1610 parent_pos, "Previously defined here"
1613 (*****************************************************************************)
1614 (* Typing decl errors *)
1615 (*****************************************************************************)
1617 let wrong_extend_kind child_pos child parent_pos parent =
1618 let msg1 = child_pos, child^" cannot extend "^parent in
1619 let msg2 = parent_pos, "This is "^parent in
1620 add_list Typing.wrong_extend_kind [msg1; msg2]
1622 let unsatisfied_req parent_pos req_name req_pos =
1623 let s1 = "Failure to satisfy requirement: "^(Utils.strip_ns req_name) in
1624 let s2 = "Required here" in
1625 if req_pos = parent_pos
1626 then add Typing.unsatisfied_req parent_pos s1
1627 else add_list Typing.unsatisfied_req [parent_pos, s1; req_pos, s2]
1629 let cyclic_class_def stack pos =
1630 let stack = SSet.fold (fun x y -> (Utils.strip_ns x)^" "^y) stack "" in
1631 add Typing.cyclic_class_def pos ("Cyclic class definition : "^stack)
1633 let override_final ~parent ~child =
1634 add_list Typing.override_final [child, "You cannot override this method";
1635 parent, "It was declared as final"]
1637 let should_be_override pos class_id id =
1638 add Typing.should_be_override pos
1639 ((Utils.strip_ns class_id)^"::"^id^"() is marked as override; \
1640 no non-private parent definition found \
1641 or overridden parent is defined in non-<?hh code")
1643 let override_per_trait class_name id m_pos =
1644 let c_pos, c_name = class_name in
1645 let err_msg =
1646 ("Method "^(Utils.strip_ns c_name)^"::"^id^" is should be an override \
1647 per the declaring trait; no non-private parent definition found \
1648 or overridden parent is defined in non-<?hh code")
1649 in add_list Typing.override_per_trait [
1650 c_pos, err_msg;
1651 m_pos, "Declaration of "^id^"() is here"
1654 let missing_assign pos =
1655 add Typing.missing_assign pos "Please assign a value"
1657 let private_override pos class_id id =
1658 add Typing.private_override pos ((Utils.strip_ns class_id)^"::"^id
1659 ^": combining private and override is nonsensical")
1661 let nullsafe_not_needed p nonnull_witness =
1662 add_list Typing.nullsafe_not_needed (
1665 "You are using the ?-> operator but this object cannot be null. "
1666 ] @ nonnull_witness)
1668 let generic_at_runtime p =
1669 add Typing.generic_at_runtime p
1670 "Generics can only be used in type hints since they are erased at runtime."
1672 let trivial_strict_eq p b left right left_trail right_trail =
1673 let msg = "This expression is always "^b in
1674 let left_trail = List.map left_trail typedef_trail_entry in
1675 let right_trail = List.map right_trail typedef_trail_entry in
1676 add_list Typing.trivial_strict_eq
1677 ((p, msg) :: left @ left_trail @ right @ right_trail)
1679 let void_usage p void_witness =
1680 let msg = "You are using the return value of a void function" in
1681 add_list Typing.void_usage ((p, msg) :: void_witness)
1683 let noreturn_usage p noreturn_witness =
1684 let msg = "You are using the return value of a noreturn function" in
1685 add_list Typing.noreturn_usage ((p, msg) :: noreturn_witness)
1687 let attribute_arity pos x n =
1688 let n = string_of_int n in
1689 add Typing.attribute_arity pos (
1690 "The attribute "^x^" expects "^n^" parameters"
1693 let attribute_param_type pos x =
1694 add Typing.attribute_param_type pos (
1695 "This attribute parameter should be "^x
1698 let deprecated_use pos pos_def msg =
1699 add_list Typing.deprecated_use [
1700 pos, msg;
1701 pos_def, "Definition is here";
1704 let cannot_declare_constant kind pos (class_pos, class_name) =
1705 let kind_str =
1706 match kind with
1707 | `enum -> "an enum"
1708 | `trait -> "a trait"
1710 add_list Typing.cannot_declare_constant [
1711 pos, "Cannot declare a constant in "^kind_str;
1712 class_pos, (strip_ns class_name)^" was defined as "^kind_str^" here";
1715 let ambiguous_inheritance pos class_ origin (error: error) =
1716 let origin = strip_ns origin in
1717 let class_ = strip_ns class_ in
1718 let message = "This declaration was inherited from an object of type "^origin^
1719 ". Redeclare this member in "^class_^" with a compatible signature." in
1720 let code, msgl = error in
1721 add_list code (msgl @ [pos, message])
1723 let explain_contravariance pos c_name error =
1724 let message = "Considering that this type argument is contravariant "^
1725 "with respect to " ^ strip_ns c_name in
1726 let code, msgl = error in
1727 add_list code (msgl @ [pos, message])
1729 let explain_invariance pos c_name suggestion error =
1730 let message = "Considering that this type argument is invariant "^
1731 "with respect to " ^ strip_ns c_name ^ suggestion in
1732 let code, msgl = error in
1733 add_list code (msgl @ [pos, message])
1735 let local_variable_modified_and_used pos_modified pos_used_l =
1736 let used_msg p = p, "And accessed here" in
1737 add_list Typing.local_variable_modifed_and_used
1738 ((pos_modified, "Unsequenced modification and access to local \
1739 variable. Modified here") ::
1740 List.map pos_used_l used_msg)
1742 let local_variable_modified_twice pos_modified pos_modified_l =
1743 let modified_msg p = p, "And also modified here" in
1744 add_list Typing.local_variable_modifed_twice
1745 ((pos_modified, "Unsequenced modifications to local variable. \
1746 Modified here") ::
1747 List.map pos_modified_l modified_msg)
1749 let assign_during_case p =
1750 add Typing.assign_during_case p
1751 "Don't assign to variables inside of case labels"
1753 let cyclic_enum_constraint pos =
1754 add Typing.cyclic_enum_constraint pos "Cyclic enum constraint"
1756 let invalid_classname p =
1757 add Typing.invalid_classname p "Not a valid class name"
1759 (*****************************************************************************)
1760 (* Convert relative paths to absolute. *)
1761 (*****************************************************************************)
1763 let to_absolute (code, msg_l) =
1764 let msg_l = List.map msg_l (fun (p, s) -> Pos.to_absolute p, s) in
1765 code, msg_l
1767 (*****************************************************************************)
1768 (* Printing *)
1769 (*****************************************************************************)
1771 let to_json ((error_code, msgl) : Pos.absolute error_) = Hh_json.(
1772 let elts = List.map msgl begin fun (p, w) ->
1773 let line, scol, ecol = Pos.info_pos p in
1774 JAssoc [ "descr", JString w;
1775 "path", JString p.Pos.pos_file;
1776 "line", JInt line;
1777 "start", JInt scol;
1778 "end", JInt ecol;
1779 "code", JInt error_code
1781 end in
1782 JAssoc [ "message", JList elts ]
1785 let to_string ((error_code, msgl) : Pos.absolute error_) : string =
1786 let buf = Buffer.create 50 in
1787 (match msgl with
1788 | [] -> assert false
1789 | (pos1, msg1) :: rest_of_error ->
1790 Buffer.add_string buf begin
1791 let error_code = error_code_to_string error_code in
1792 Printf.sprintf "%s\n%s (%s)\n"
1793 (Pos.string pos1) msg1 error_code
1794 end;
1795 List.iter rest_of_error begin fun (p, w) ->
1796 let msg = Printf.sprintf "%s\n%s\n" (Pos.string p) w in
1797 Buffer.add_string buf msg
1800 Buffer.contents buf
1802 (*****************************************************************************)
1803 (* Try if errors. *)
1804 (*****************************************************************************)
1806 let try_with_result f1 f2 =
1807 let error_list_copy = !error_list in
1808 let accumulate_errors_copy = !accumulate_errors in
1809 error_list := [];
1810 accumulate_errors := true;
1811 let result = f1 () in
1812 let errors = !error_list in
1813 error_list := error_list_copy;
1814 accumulate_errors := accumulate_errors_copy;
1815 match List.rev errors with
1816 | [] -> result
1817 | l :: _ -> f2 result l
1819 let try_ f1 f2 =
1820 try_with_result f1 (fun _ l -> f2 l)
1822 let try_with_error f1 f2 =
1823 try_ f1 (fun err -> add_error err; f2())
1825 let try_add_err pos err f1 f2 =
1826 try_ f1 begin fun (error_code, l) ->
1827 add_list error_code ((pos, err) :: l);
1828 f2()
1831 let has_no_errors f =
1832 try_ (fun () -> f(); true) (fun _ -> false)
1834 (*****************************************************************************)
1835 (* Do. *)
1836 (*****************************************************************************)
1838 let do_ f =
1839 let error_list_copy = !error_list in
1840 let accumulate_errors_copy = !accumulate_errors in
1841 error_list := [];
1842 accumulate_errors := true;
1843 let result = f () in
1844 let out_errors = !error_list in
1845 error_list := error_list_copy;
1846 accumulate_errors := accumulate_errors_copy;
1847 List.rev out_errors, result
1849 let ignore_ f =
1850 snd (do_ f)
1852 let try_when f ~when_ ~do_ =
1853 try_with_result f begin fun result (error: error) ->
1854 if when_()
1855 then do_ error
1856 else add_error error;
1857 result
1860 (* Runs the first function that is expected to produce an error. If it doesn't
1861 * then we run the second function we are given
1863 let must_error f error_fun =
1864 let had_no_errors = try_with_error (fun () -> f(); true) (fun _ -> false) in
1865 if had_no_errors then error_fun();