2 * Copyright (c) 2014, Facebook, Inc.
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.
12 (** Module "naming" a program.
14 * The naming phase consists in several things
15 * 1- get all the global names
16 * 2- transform all the local names into a unique identifier
22 module ShapeMap
= N.ShapeMap
23 module SN
= Naming_special_names
25 (*****************************************************************************)
27 (*****************************************************************************)
29 type fun_set
= Utils.SSet.t
30 type class_set
= Utils.SSet.t
31 type typedef_set
= Utils.SSet.t
32 type const_set
= Utils.SSet.t
33 type decl_set
= fun_set
* class_set
* typedef_set
* const_set
35 type class_cache
= Nast.class_
option Utils.SMap.t
ref
37 (* We want to keep the positions of names that have been
38 * replaced by identifiers.
40 type positioned_ident
= (Pos.t
* Ident.t
)
41 type map
= positioned_ident
SMap.t
42 type canon_names_map
= string SMap.t
43 let canon_key = String.lowercase
45 (* <T as A>, A is a type constraint *)
46 type type_constraint
= hint
option
49 (* strict? decl? partial? *)
52 (* are we in the body of a try statement? *)
55 (* are we in the body of a non-static member function? *)
58 (* In function foo<T1, ..., Tn> or class<T1, ..., Tn>, the field
59 * type_params knows T1 .. Tn. It is able to find out about the
60 * constraint on these parameters. *)
61 type_params
: type_constraint
SMap.t
;
63 (* The parameters is their original order
64 * Necessary to type "this".
66 type_paraml
: Ast.id list
;
68 (* Set of class names defined, and their positions *)
69 classes
: (map
* canon_names_map
) ref;
71 (* Set of function names defined, and their positions *)
74 (* Set of typedef names defined, and their position *)
77 (* Set of constant names defined, and their position *)
80 (* The current class, None if we are in a function *)
81 cclass
: Ast.class_
option;
83 (* Normally we don't need to add dependencies at this stage, but there
84 * are edge cases when we do. *)
85 droot
: Typing_deps.Dep.variant
option;
87 (* Namespace environment, e.g., what namespace we're in and what use
88 * declarations are in play. *)
89 namespace
: Namespace_env.env
;
92 (* How to behave when we see an unbound name. Either we raise an
93 error, or we call a function first and continue if it can resolve
94 the name. This is used to nest environments when processing
98 | UBMFunc
of ((Pos.t
* string) -> positioned_ident
)
100 (* The local environment *)
103 (* The set of locals *)
106 (* The set of constants *)
109 (* A map of variable names to a list of previous references.
110 Only used in find refs mode *)
111 references
: (Pos.t list
) SMap.t
ref;
113 (* Variable name of the target we're finding references for,
115 find_refs_target_name
: string option ref;
117 (* We keep all the locals, even if we are in a different scope
118 * to provide better error messages.
123 * Technically, passed this point, $x is unbound.
124 * But it is much better to keep it somewhere, so that you can
125 * say it is bound, but in a different scope.
127 all_locals
: Pos.t
SMap.t
ref;
129 (* Some statements can define new variables afterwards, e.g.,
135 * We need to give $x the same name in both branches, but we don't want
136 * $x to actually be a local until after the if block. So we stash it here,
137 * to indicate a name has been pre-allocated, but that the variable isn't
138 * actually defined yet.
140 pending_locals
: map
ref;
142 (* Tag controlling what we do when we encounter an unbound name.
143 * This is used when processing a lambda expression body that has
144 * an automatic use list.
146 * See expr_lambda for details.
148 unbound_mode
: unbound_mode
;
150 (* The presence of "yield" in the function body changes the type of the
151 * function into a generator, with no other syntactic indications
152 * elsewhere. For the sanity of the typechecker, we flatten this out into
153 * fun_kind, but need to track if we've seen a "yield" in order to do so.
158 (* The environment VISIBLE to the outside world. *)
160 iclasses
: map
* canon_names_map
;
167 * Returns the list of classes which have been seen.
168 * Useful for things like dumping json formatted information about the www
171 let get_classes env
=
172 SMap.fold
(fun key _ acc
-> key
:: acc
) (fst env
.iclasses
) []
174 (*****************************************************************************)
175 (* Predefined names *)
176 (*****************************************************************************)
178 let predef_funs = ref SMap.empty
180 let var = Pos.none
, Ident.make x
in
181 predef_funs := SMap.add x
var !predef_funs;
184 let anon = predef_fun "?anon"
185 let is_int = predef_fun SN.StdlibFunctions.is_int
186 let is_bool = predef_fun SN.StdlibFunctions.is_bool
187 let is_array = predef_fun SN.StdlibFunctions.is_array
188 let is_float = predef_fun SN.StdlibFunctions.is_float
189 let is_string = predef_fun SN.StdlibFunctions.is_string
190 let is_null = predef_fun SN.StdlibFunctions.is_null
191 let is_resource = predef_fun SN.StdlibFunctions.is_resource
193 let predef_tests_list =
194 [is_int; is_bool; is_float; is_string; is_null; is_array; is_resource]
195 let predef_tests = List.fold_right
SSet.add
predef_tests_list SSet.empty
197 (*****************************************************************************)
198 (* Empty (initial) environments *)
199 (*****************************************************************************)
202 iclasses
= SMap.empty, SMap.empty;
203 ifuns
= !predef_funs;
204 itypedefs
= SMap.empty;
205 iconsts
= SMap.empty;
208 (* The primitives to manipulate the naming environment *)
211 let empty_local() = {
212 locals
= ref SMap.empty;
213 consts
= ref SMap.empty;
214 all_locals
= ref SMap.empty;
215 references
= ref SMap.empty;
216 pending_locals
= ref SMap.empty;
217 find_refs_target_name
= ref None
;
218 unbound_mode
= UBMErr
;
219 has_yield
= ref false;
222 let empty_global env
= {
223 in_mode
= Ast.Mstrict
;
225 in_member_fun
= false;
226 type_params
= SMap.empty;
228 classes
= ref env
.iclasses
;
229 funs
= ref env
.ifuns
;
230 typedefs
= ref env
.itypedefs
;
231 gconsts
= ref env
.iconsts
;
234 namespace
= Namespace_env.empty;
237 let make_class_genv genv params c
= {
239 (if !Autocomplete.auto_complete
then Ast.Mpartial
else c
.c_mode
);
241 in_member_fun
= false;
242 type_params
= params
;
243 type_paraml
= List.map
(fun (_
, x
, _
) -> x
) c
.c_tparams
;
244 classes
= ref genv
.iclasses
;
245 funs
= ref genv
.ifuns
;
246 typedefs
= ref genv
.itypedefs
;
247 gconsts
= ref genv
.iconsts
;
249 droot
= Some
(Typing_deps.Dep.Class
(snd c
.c_name
));
250 namespace
= c
.c_namespace
;
253 let make_class_env genv params c
=
254 let genv = make_class_genv genv params c
in
255 let lenv = empty_local () in
256 let env = genv, lenv in
259 let make_typedef_genv genv cstrs tdef
= {
260 in_mode
= (if !Ide.is_ide_mode
then Ast.Mpartial
else Ast.Mstrict
);
262 in_member_fun
= false;
264 type_paraml
= List.map
(fun (_
, x
, _
) -> x
) tdef
.t_tparams
;
265 classes
= ref genv.iclasses
;
266 funs
= ref genv.ifuns
;
267 typedefs
= ref genv.itypedefs
;
268 gconsts
= ref genv.iconsts
;
271 namespace
= tdef
.t_namespace
;
274 let make_typedef_env genv cstrs tdef
=
275 let genv = make_typedef_genv genv cstrs tdef
in
276 let lenv = empty_local () in
277 let env = genv, lenv in
280 let make_fun_genv genv params f
= {
283 in_member_fun
= false;
284 type_params
= params
;
286 classes
= ref genv.iclasses
;
287 funs
= ref genv.ifuns
;
288 typedefs
= ref genv.itypedefs
;
289 gconsts
= ref genv.iconsts
;
291 droot
= Some
(Typing_deps.Dep.Fun
(snd f
.f_name
));
292 namespace
= f
.f_namespace
;
295 let make_const_genv genv cst
= {
296 in_mode
= cst
.cst_mode
;
298 in_member_fun
= false;
299 type_params
= SMap.empty;
301 classes
= ref genv.iclasses
;
302 funs
= ref genv.ifuns
;
303 typedefs
= ref genv.itypedefs
;
304 gconsts
= ref genv.iconsts
;
306 droot
= Some
(Typing_deps.Dep.GConst
(snd cst
.cst_name
));
307 namespace
= cst
.cst_namespace
;
310 let make_const_env genv cst
=
311 let genv = make_const_genv genv cst
in
312 let lenv = empty_local () in
313 let env = genv, lenv in
316 let new_var env (p
, x
) =
319 let p'
, _
= SMap.find_unsafe x
!env in
320 Errors.error_name_already_bound x x
p p'
322 let y = p, Ident.make x
in
323 env := SMap.add x
y !env;
326 let lookup genv env (p, x
) =
327 let v = SMap.get x
!env in
330 (match genv.in_mode
with
331 | Ast.Mstrict
-> Errors.unbound_name
p x
332 | Ast.Mdecl
| Ast.Mpartial
-> ()
337 (* Check and see if the user might have been trying to use one of the
338 * generics in scope as a runtime value *)
339 let check_no_runtime_generic genv (p, name
) =
340 let tparaml = SMap.keys
genv.type_params
in
341 if List.mem name
tparaml then Errors.generic_at_runtime
p;
344 let canonicalize genv env_and_names
(p, name
) =
345 let env, canon_names
= !env_and_names
in
346 if SMap.mem name
env then (p, name
)
348 let name_key = canon_key name
in
349 match SMap.get
name_key canon_names
with
351 let p_canon, _
= SMap.find_unsafe canonical
env in
352 Errors.did_you_mean_naming
p name
p_canon canonical
;
353 (* Recovering from the capitalization error means
354 * returning the name in its canonical form *)
357 (match genv.in_mode
with
358 | Ast.Mstrict
-> Errors.unbound_name
p name
359 | Ast.Mdecl
| Ast.Mpartial
-> ());
363 (* Is called bad_style, but it is still an error ... Whatever *)
364 let bad_style env (p, x
) =
365 let p'
= SMap.get x
!(env.all_locals
) in
366 match p'
with None
-> assert false | Some
p'
->
367 Errors.different_scope
p x
p'
371 "$GLOBALS"; "$_SERVER"; "$_GET"; "$_POST"; "$_FILES";
372 "$_COOKIE"; "$_SESSION"; "$_REQUEST"; "$_ENV"
374 let h = Hashtbl.create
23 in
375 List.iter
(fun x
-> Hashtbl.add
h x
true) l;
376 fun x
-> Hashtbl.mem
h x
378 (* Adds a local variable, without any check *)
379 let add_lvar (_
, lenv) (_
, name
) (p, x
) =
380 lenv.locals
:= SMap.add name
(p, x
) !(lenv.locals
)
382 (* Saves the position of local variables if we're in find refs mode*)
383 let save_ref x
p lenv =
384 Find_refs.process_var_ref
p x
;
385 (* If we've already located the target and name of this var is
386 the same, add it to the result list *)
387 (match !(lenv.find_refs_target_name
) with
390 Find_refs.find_refs_result
:= p :: !Find_refs.find_refs_result
;
393 (* If we haven't found the target yet: *)
394 match !Find_refs.find_refs_target
with
396 | Some
(line
, char_pos
) ->
397 (* store the location of this reference for later *)
398 lenv.references
:= (match SMap.get x
!(lenv.references
) with
399 | None
-> SMap.add x
(p :: []) !(lenv.references
)
400 | Some lst
-> SMap.add x
(p :: lst
) !(lenv.references
));
402 let l, start
, end_
= Pos.info_pos
p in
403 if l = line
&& start
<= char_pos
&& char_pos
<= end_
405 (* This is the target, so stop looking for it,
406 save the target name, and copy the current references
407 to this target to the result list *)
408 Find_refs.find_refs_target
:= None
;
409 lenv.find_refs_target_name
:= Some x
;
410 Find_refs.find_refs_result
:=
411 (match SMap.get x
!(lenv.references
) with
418 (* Defines a new local variable *)
419 let new_lvar (_
, lenv) (p, x
) =
420 let lcl = SMap.get x
!(lenv.locals
) in
422 | Some
lcl -> p, snd
lcl
425 let ident = match SMap.get x
!(lenv.pending_locals
) with
426 | Some
(_
, ident) -> ident
427 | None
-> Ident.make x
in
429 lenv.all_locals
:= SMap.add x
p !(lenv.all_locals
);
430 lenv.locals
:= SMap.add x
y !(lenv.locals
);
433 let new_pending_lvar (_
, lenv) (p, x
) =
434 match SMap.get x
!(lenv.locals
), SMap.get x
!(lenv.pending_locals
) with
436 let y = p, Ident.make x
in
437 lenv.pending_locals
:= SMap.add x
y !(lenv.pending_locals
)
440 let promote_pending (_
, lenv as env) =
441 SMap.iter
begin fun x
(p, ident) ->
442 add_lvar env (p, x
) (p, ident)
443 end !(lenv.pending_locals
);
444 lenv.pending_locals
:= SMap.empty
446 let handle_undefined_variable (genv, env) (p, x
) =
447 match env.unbound_mode
with
448 | UBMErr
-> Errors.undefined
p x
; p, Ident.make x
449 | UBMFunc f
-> f
(p, x
)
451 (* Function used to name a local variable *)
452 let lvar (genv, env) (p, x
) =
453 if is_superglobal x
&& genv.in_mode
= Ast.Mpartial
456 let lcl = SMap.get x
!(env.locals
) in
458 | Some
lcl -> (if fst
lcl != p then save_ref x
p env); p, snd
lcl
459 | None
when not
!Autocomplete.auto_complete
->
460 if SMap.mem x
!(env.all_locals
)
461 then bad_style env (p, x
);
462 handle_undefined_variable (genv, env) (p, x
)
463 | None
-> p, Ident.tmp
()
465 let get_name genv namespace x
=
466 ignore
(lookup genv namespace x
); x
468 (* For dealing with namespace fallback on functions and constants. *)
469 let elaborate_and_get_name_with_fallback mk_dep
genv genv_sect x
=
470 let fq_x = Namespaces.elaborate_id
genv.namespace x
in
472 genv.namespace
.Namespace_env.ns_name
<> None
&&
473 not
(String.contains
(snd x
) '
\\'
) in
474 if need_fallback then begin
475 let global_x = (fst x
, "\\" ^
(snd x
)) in
476 (* Explicitly add dependencies on both of the functions we could be
477 * referring to here. Normally naming doesn't have to deal with deps at
478 * all -- they are added during typechecking just by the nature of
479 * looking up a class or function name. However, we're flattening
480 * namespaces here, and the fallback behavior of functions means that we
481 * might suddenly be referring to a different function without any
482 * change to the callsite at all. Adding both dependencies explicitly
483 * captures this action-at-a-distance. *)
484 Typing_deps.add_idep
genv.droot
(mk_dep
(snd
fq_x));
485 Typing_deps.add_idep
genv.droot
(mk_dep
(snd
global_x));
486 let mem (_
, s
) = SMap.mem s
!(genv_sect
) in
487 match mem fq_x, mem global_x with
488 (* Found in the current namespace *)
489 | true, _
-> get_name genv genv_sect
fq_x
490 (* Found in the global namespace *)
491 | _
, true -> get_name genv genv_sect
global_x
492 (* Not found. Pick the more specific one to error on. *)
493 | false, false -> get_name genv genv_sect
fq_x
495 get_name genv genv_sect
fq_x
497 let const (genv, env) x
= get_name genv env.consts x
499 let global_const (genv, env) x
=
500 elaborate_and_get_name_with_fallback
501 (* Same idea as Dep.FunName, see below. *)
502 (fun x
-> Typing_deps.Dep.GConstName x
)
507 let class_name (genv, _
) x
=
508 (* Generic names are not allowed to shadow class names *)
509 check_no_runtime_generic genv x
;
510 let x = Namespaces.elaborate_id
genv.namespace
x in
511 let pos, name
= canonicalize genv genv.classes
x in
512 (* Don't let people use strictly internal classes
513 * (except when they are being declared in .hhi files) *)
514 if name
= SN.Classes.cHH_BuiltinEnum
&&
515 not
(str_ends_with
(Relative_path.to_absolute
(Pos.filename
pos)) ".hhi")
516 then Errors.using_internal_class
pos (strip_ns name
);
519 let fun_id (genv, _
) x =
520 elaborate_and_get_name_with_fallback
521 (* Not just Dep.Fun, but Dep.FunName. This forces an incremental full
522 * redeclaration of this class if the name changes, not just a
523 * retypecheck -- the name that is referred to here actually changes as
524 * a result of what else is defined, which is stronger than just the need
526 (fun x -> Typing_deps.Dep.FunName
x)
531 let new_const (genv, env) x =
532 try ignore
(new_var env.consts
x); x with exn
->
533 match genv.in_mode
with
534 | Ast.Mstrict
-> raise exn
535 | Ast.Mpartial
| Ast.Mdecl
-> x
537 let resilient_new_canon_var env_and_names
(p, name
) =
538 let env, canon_names
= !env_and_names
in
539 let name_key = canon_key name
in
540 match SMap.get
name_key canon_names
with
542 let p'
, id
= SMap.find_unsafe canonical
env in
543 if Pos.compare
p p'
= 0 then (p, id
)
545 Errors.error_name_already_bound name canonical
p p'
;
549 let pos_and_id = p, Ident.make name
in
551 SMap.add name
pos_and_id env, SMap.add
name_key name canon_names
;
554 let resilient_new_var env (p, x) =
557 let p'
, y = SMap.find_unsafe
x !env in
558 if Pos.compare
p p'
= 0 then (p, y)
560 Errors.error_name_already_bound
x x p p'
;
565 let y = p, Ident.make
x in
566 env := SMap.add
x y !env;
569 let new_fun_id genv x =
570 if SMap.mem (snd
x) !predef_funs then () else
571 ignore
(resilient_new_var genv.funs
x)
573 let new_class_id genv x =
574 ignore
(resilient_new_canon_var genv.classes
x)
576 let new_typedef_id genv x =
577 let v = resilient_new_canon_var genv.classes
x in
578 genv.typedefs
:= SMap.add
(snd
x) v !(genv.typedefs
);
581 let new_global_const_id genv x =
582 let v = resilient_new_var genv.gconsts
x in
583 genv.gconsts
:= SMap.add
(snd
x) v !(genv.gconsts
);
586 (* Scope, keep the locals, go and name the body, and leave the
587 * local environment intact
590 let genv, lenv = env in
591 let lenv_copy = !(lenv.locals
) in
592 let lenv_pending_copy = !(lenv.pending_locals
) in
594 lenv.locals
:= lenv_copy;
595 lenv.pending_locals
:= lenv_pending_copy;
600 (*****************************************************************************)
601 (* Updating the environment *)
602 (*****************************************************************************)
604 let remove_decls env (funs
, classes
, typedefs
, consts
) =
605 let funs = SSet.diff
funs predef_tests in
606 let ifuns = SSet.fold
SMap.remove
funs env.ifuns in
607 let canonicalize_set = (fun elt acc
-> SSet.add
(canon_key elt
) acc
) in
608 let class_namekeys = SSet.fold
canonicalize_set classes
SSet.empty in
609 let typedef_namekeys = SSet.fold
canonicalize_set typedefs
SSet.empty in
610 let iclassmap, iclassnames
= env.iclasses
in
611 let iclassmap, iclassnames
=
612 SSet.fold
SMap.remove classes
iclassmap,
613 SSet.fold
SMap.remove
class_namekeys iclassnames
615 let iclassmap, iclassnames
=
616 SSet.fold
SMap.remove typedefs
iclassmap,
617 SSet.fold
SMap.remove
typedef_namekeys iclassnames
619 let itypedefs = SSet.fold
SMap.remove typedefs
env.itypedefs in
620 let iconsts = SSet.fold
SMap.remove consts
env.iconsts in
623 iclasses
= iclassmap, iclassnames
;
624 itypedefs = itypedefs;
628 (*****************************************************************************)
630 (*****************************************************************************)
632 (* Alok is constantly complaining that in partial mode,
633 * he forgets to bind a type parameter, for example T,
634 * and because partial assumes T is just a class that lives
635 * in PHP land there is no error message.
636 * So to help him, I am adding a rule that if
637 * the class name starts with a T and is only 2 characters
638 * it is considered a type variable. You will not be able to
639 * define a class T in php land in this scheme ... But it is a bad
640 * name for a class anyway.
642 let is_alok_type_name (_
, x) = String.length
x <= 2 && x.[0] = 'T'
644 let check_constraint (_
, (pos, name
), _
) =
645 (* TODO refactor this in a seperate module for errors *)
646 if String.lowercase name
= "this"
647 then Errors.this_reserved
pos
648 else if name
.[0] <> 'T'
then Errors.start_with_T
pos
650 let check_repetition s param
=
651 let x = snd param
.param_id
in
653 then Errors.already_bound
(fst param
.param_id
) x;
656 (* Check that a name is not a typedef *)
657 let no_typedef (genv, _
) cid
=
658 let (pos, name
) = Namespaces.elaborate_id
genv.namespace cid
in
659 if SMap.mem name
!(genv.typedefs
)
661 let def_pos, _
= SMap.find_unsafe name
!(genv.typedefs
) in
662 Errors.unexpected_typedef
pos def_pos
664 let hint_no_typedef env = function
665 | _
, Happly
(x, _
) -> no_typedef env x
668 let convert_shape_name env = function
669 | SFlit
(pos, s
) -> (pos, N.SFlit
(pos, s
))
670 | SFclass_const
(x, (pos, y)) ->
671 let class_name = Env.class_name env x in
672 (pos, N.SFclass_const
(class_name, (pos, y)))
674 let splat_unexpected = function
676 | (pos, _
) :: _
-> Errors.naming_too_few_arguments
pos; ()
678 (*****************************************************************************)
679 (* The entry point to build the naming environment *)
680 (*****************************************************************************)
682 let make_env old_env ~
funs ~classes ~typedefs ~consts
=
683 let genv = Env.empty_global old_env
in
684 List.iter
(Env.new_fun_id genv) funs;
685 List.iter
(Env.new_class_id genv) classes
;
686 List.iter
(Env.new_typedef_id genv) typedefs
;
687 List.iter
(Env.new_global_const_id genv) consts
;
689 iclasses
= !(genv.classes
);
690 ifuns = !(genv.funs);
691 itypedefs = !(genv.typedefs
);
692 iconsts = !(genv.gconsts
);
696 (*****************************************************************************)
697 (* Naming of type hints *)
698 (*****************************************************************************)
700 let rec hint ?
(is_static_var
=false) ?
(allow_this
=false) env (p, h) =
701 p, hint_ ~allow_this is_static_var
p env h
703 and hint_ ~allow_this is_static_var
p env x =
704 let hint = hint ~is_static_var ~allow_this
in
706 | Htuple hl
-> N.Htuple
(List.map
(hint env) hl
)
707 | Hoption
h -> N.Hoption
(hint env h)
708 | Hfun
(hl
, opt
, h) -> N.Hfun
(List.map
(hint env) hl
, opt
, hint env h)
709 | Happly
((_
, x) as id
, hl
) -> hint_id ~allow_this
env is_static_var id hl
710 | Hshape fdl
-> N.Hshape
712 List.fold_left
begin fun fdm
(pname
, h) ->
713 let pos, name
= convert_shape_name env pname
in
714 if ShapeMap.mem name fdm
715 then Errors.fd_name_already_bound
pos;
716 ShapeMap.add name
(hint env h) fdm
717 end ShapeMap.empty fdl
720 and hint_id ~allow_this
env is_static_var
(p, x as id
) hl
=
721 Naming_hooks.dispatch_hint_hook id
;
722 let hint = hint ~allow_this
in
723 let params = (fst
env).type_params
in
724 if is_alok_type_name id
&& not
(SMap.mem x params)
725 then Errors.typeparam_alok id
;
726 if is_static_var
&& SMap.mem x params
727 then Errors.generic_class_var
(fst id
);
728 (* some common Xhp screw ups *)
729 if (x = "Xhp") || (x = ":Xhp") || (x = "XHP")
730 then Errors.disallowed_xhp_type
p x;
731 match try_castable_hint ~allow_this
env p x hl
with
735 | x when x.[0] = '
\\'
&&
736 ( x = ("\\"^
SN.Typehints.void
)
737 || x = ("\\"^
SN.Typehints.int)
738 || x = ("\\"^
SN.Typehints.bool)
739 || x = ("\\"^
SN.Typehints.float)
740 || x = ("\\"^
SN.Typehints.num
)
741 || x = ("\\"^
SN.Typehints.string)
742 || x = ("\\"^
SN.Typehints.resource
)
743 || x = ("\\"^
SN.Typehints.mixed
)
744 || x = ("\\"^
SN.Typehints.array
)
745 || x = ("\\"^
SN.Typehints.arraykey
)
746 || x = ("\\"^
SN.Typehints.integer
)
747 || x = ("\\"^
SN.Typehints.boolean
)
748 || x = ("\\"^
SN.Typehints.double
)
749 || x = ("\\"^
SN.Typehints.real)
751 Errors.primitive_toplevel
p;
753 | x when x = SN.Typehints.void
-> N.Hprim
N.Tvoid
754 | x when x = SN.Typehints.num
-> N.Hprim
N.Tnum
755 | x when x = SN.Typehints.resource
-> N.Hprim
N.Tresource
756 | x when x = SN.Typehints.arraykey
-> N.Hprim
N.Tarraykey
757 | x when x = SN.Typehints.mixed
-> N.Hmixed
758 | x when x = SN.Typehints.this
&& allow_this
->
760 then Errors.this_no_argument
p;
761 (match (fst
env).cclass
with
763 Errors.this_hint_outside_class
p;
766 let tparaml = (fst
env).type_paraml
in
767 let tparaml = List.map
begin fun (param_pos
, param_name
) ->
768 let _, cstr
= get_constraint
env param_name
in
769 let cstr = opt_map
(hint env) cstr in
770 param_pos
, N.Habstr
(param_name
, cstr)
772 N.Habstr
(SN.Typehints.this
, Some
(fst c
.c_name
, N.Happly
(c
.c_name
, tparaml))))
773 | x when x = SN.Typehints.this
->
774 (match (fst
env).cclass
with
776 Errors.this_hint_outside_class
p
778 Errors.this_must_be_return
p
781 | _ when String.lowercase
x = SN.Typehints.this
->
782 Errors.lowercase_this
p x;
784 | _ when SMap.mem x params ->
786 Errors.tparam_with_tparam
p x;
787 let env, gen_constraint
= get_constraint
env x in
788 N.Habstr
(x, opt_map
(hint env) gen_constraint
)
790 (* In the future, when we have proper covariant support, we can
791 * allow SN.Typehints.this to instantiate any covariant type variable. For
792 * example, let us pretend that we have this defined:
794 * interface IFoo<read Tread, write Twrite>
796 * IFoo<this, int> and IFoo<IFoo<this, int>, int> are ok
797 * IFoo<int, this> and IFoo<int, IFoo<this>> are not ok
799 * For now, we're hardcoding the fact that all type variables for
800 * Awaitable and WaitHandle are covariant (well, there's only one
801 * type variable, but yeah...). We turn on allow_this in
802 * Awaitable and WaitHandle cases to support members that look
805 * private ?WaitHandle<this> wh = ...; // e.g. generic preparables
807 let cname = snd
(Env.class_name env id
) in
808 let gen_read_api_covariance =
809 (cname = SN.FB.cGenReadApi
|| cname = SN.FB.cGenReadIdxApi
) in
810 let privacy_policy_base_covariance =
811 (cname = SN.FB.cPrivacyPolicyBase
) in
812 let data_type_covariance =
813 (cname = SN.FB.cDataType
|| cname = SN.FB.cDataTypeImplProvider
) in
814 let awaitable_covariance =
815 (cname = SN.Classes.cAwaitable
|| cname = SN.Classes.cWaitHandle
) in
816 let allow_this = allow_this &&
817 (awaitable_covariance || gen_read_api_covariance ||
818 privacy_policy_base_covariance || data_type_covariance) in
819 N.Happly
(Env.class_name env id
, hintl ~
allow_this env hl
)
822 (* Hints that are valid both as casts and type annotations. Neither casts nor
823 * annotations are a strict subset of the other: For instance, 'object' is not
824 * a valid annotation. Thus callers will have to handle the remaining cases. *)
825 and try_castable_hint ?
(allow_this=false) env p x hl
=
826 let hint = hint ~
allow_this in
828 | x when x = SN.Typehints.int -> Some
(N.Hprim
N.Tint
)
829 | x when x = SN.Typehints.bool -> Some
(N.Hprim
N.Tbool
)
830 | x when x = SN.Typehints.float -> Some
(N.Hprim
N.Tfloat
)
831 | x when x = SN.Typehints.string -> Some
(N.Hprim
N.Tstring
)
832 | x when x = SN.Typehints.array
->
834 | [] -> N.Harray
(None
, None
)
835 | [x] -> N.Harray
(Some
(hint env x), None
)
836 | [x; y] -> N.Harray
(Some
(hint env x), Some
(hint env y))
837 | _ -> Errors.naming_too_many_arguments
p; N.Hany
839 | x when x = SN.Typehints.integer
->
840 Errors.integer_instead_of_int
p;
841 Some
(N.Hprim
N.Tint
)
842 | x when x = SN.Typehints.boolean
->
843 Errors.boolean_instead_of_bool
p;
844 Some
(N.Hprim
N.Tbool
)
845 | x when x = SN.Typehints.double
->
846 Errors.double_instead_of_float
p;
847 Some
(N.Hprim
N.Tfloat
)
848 | x when x = SN.Typehints.real ->
849 Errors.real_instead_of_float
p;
850 Some
(N.Hprim
N.Tfloat
)
853 and get_constraint
env tparam
=
854 let params = (fst
env).type_params
in
855 let gen_constraint = SMap.find_unsafe tparam
params in
856 let genv, lenv = env in
857 let genv = { genv with type_params
= SMap.add tparam None
params } in
858 let env = genv, lenv in
861 and hintl ~
allow_this env l = List.map
(hint ~
allow_this env) l
863 (*****************************************************************************)
864 (* All the methods and static methods of an interface are "implicitely"
865 * declared as abstract
867 (*****************************************************************************)
869 let add_abstract m
= {m
with N.m_abstract
= true}
871 let add_abstractl methods
= List.map
add_abstract methods
873 let interface c constructor methods smethods
=
874 if c
.c_kind
<> Cinterface
then constructor
, methods
, smethods
else
875 let constructor = opt_map
add_abstract constructor in
876 let methods = add_abstractl methods in
877 let smethods = add_abstractl smethods in
878 constructor, methods, smethods
880 (*****************************************************************************)
881 (* Checking for collision on method names *)
882 (*****************************************************************************)
884 let check_method acc
{ N.m_name
= (p, x); _ } =
886 then Errors.method_name_already_bound
p x;
889 let check_name_collision methods =
890 ignore
(List.fold_left
check_method SSet.empty methods)
892 (*****************************************************************************)
893 (* Checking for shadowing of method type parameters *)
894 (*****************************************************************************)
896 let check_method_tparams class_tparam_names
{ N.m_tparams
= tparams
; _ } =
898 (fun (_, (p,x),_) -> List.iter
899 (fun (pc
,xc
) -> if (x = xc
) then Errors.shadowed_type_param
p pc
x)
903 let check_tparams_shadow class_tparam_names
methods =
904 List.iter
(check_method_tparams class_tparam_names
) methods
906 (*****************************************************************************)
907 (* Check if the body of a method/function is UNSAFE *)
908 (*****************************************************************************)
910 let rec is_unsafe_body = function
912 | Block
x :: rl
-> is_unsafe_body x || is_unsafe_body rl
913 | Unsafe
:: _ -> true
914 | _ :: rl
-> is_unsafe_body rl
916 (*****************************************************************************)
917 (* The entry point to CHECK the program, and transform the program *)
918 (*****************************************************************************)
920 let rec class_constraints genv tparams
=
921 let cstrs = make_constraints tparams
in
922 (* Checking there is no cycle in the type constraints *)
923 List.iter
(Naming_ast_helpers.HintCycle.check_constraint cstrs) tparams
;
926 (* Naming of a class *)
928 let cstrs = class_constraints genv c
.c_tparams
in
929 let env = Env.make_class_env genv cstrs c
in
930 (* Checking for a code smell *)
931 List.iter
check_constraint c
.c_tparams
;
932 List.iter
(hint_no_typedef env) c
.c_extends
;
933 List.iter
(hint_no_typedef env) c
.c_implements
;
934 let name = Env.class_name env c
.c_name
in
935 let smethods = List.fold_right
(class_static_method
env) c
.c_body
[] in
936 let svars = List.fold_right
(class_var_static
env) c
.c_body
[] in
937 let vars = List.fold_right
(class_var
env) c
.c_body
[] in
938 let v_names = List.map
(fun x -> snd
x.N.cv_id
) vars in
939 let v_names = List.fold_right
SSet.add
v_names SSet.empty in
940 let sm_names = List.map
(fun x -> snd
x.N.m_name
) smethods in
941 let sm_names = List.fold_right
SSet.add
sm_names SSet.empty in
942 let parents = List.map
(hint ~
allow_this:true env) c
.c_extends
in
943 let fmethod = class_method
env sm_names v_names in
944 let methods = List.fold_right
fmethod c
.c_body
[] in
945 let uses = List.fold_right
(class_use
env) c
.c_body
[] in
946 let req_implements, req_extends
= List.fold_right
947 (class_require
env c
.c_kind
) c
.c_body
([], []) in
948 let tparam_l = type_paraml
env c
.c_tparams
in
949 let consts = List.fold_right
(class_const
env) c
.c_body
[] in
950 let implements = List.map
(hint ~
allow_this:true env) c
.c_implements
in
951 let constructor = List.fold_left
(constructor env) None c
.c_body
in
952 let constructor, methods, smethods =
953 interface c
constructor methods smethods in
954 let class_tparam_names = List.map
(fun (_, x,_) -> x) c
.c_tparams
in
955 let enum = opt_map
(enum_
env) c
.c_enum
in
956 check_name_collision methods;
957 check_tparams_shadow class_tparam_names methods;
958 check_name_collision smethods;
959 check_tparams_shadow class_tparam_names smethods;
960 { N.c_mode
= c
.c_mode
;
961 N.c_final
= c
.c_final
;
962 N.c_is_xhp
= c
.c_is_xhp
;
965 N.c_tparams
= tparam_l;
966 N.c_extends
= parents;
968 N.c_req_extends
= req_extends
;
969 N.c_req_implements
= req_implements;
970 N.c_implements
= implements;
972 N.c_static_vars
= svars;
974 N.c_constructor
= constructor;
975 N.c_static_methods
= smethods;
976 N.c_methods
= methods;
977 N.c_user_attributes
= c
.c_user_attributes
;
982 { N.e_base
= hint env e
.e_base
;
983 N.e_constraint
= opt_map
(hint env) e
.e_constraint
;
986 and type_paraml
env tparams
=
987 let _, ret
= List.fold_left
988 (fun (seen
, tparaml) ((_, (p, name), _) as tparam
) ->
989 match SMap.get
name seen
with
990 | None
-> (SMap.add
name p seen
, (type_param
env tparam
)::tparaml)
992 Errors.shadowed_type_param
p pos name;
999 and type_param
env (variance
, param_name
, param_constraint
) =
1000 variance
, param_name
, opt_map
(hint env) param_constraint
1002 and class_use
env x acc
=
1004 | Attributes
_ -> acc
1007 hint_no_typedef env h;
1008 hint ~
allow_this:true env h :: acc
1009 | ClassTraitRequire
_ -> acc
1010 | ClassVars
_ -> acc
1013 and class_require
env c_kind
x acc
=
1015 | Attributes
_ -> acc
1018 | ClassTraitRequire
(MustExtend
, h)
1019 when c_kind
<> Ast.Ctrait
&& c_kind
<> Ast.Cinterface
->
1020 let () = Errors.invalid_req_extends
(fst
h) in
1022 | ClassTraitRequire
(MustExtend
, h) ->
1023 hint_no_typedef env h;
1024 let acc_impls, acc_exts
= acc
in
1025 (acc_impls, hint ~
allow_this:true env h :: acc_exts
)
1026 | ClassTraitRequire
(MustImplement
, h) when c_kind
<> Ast.Ctrait
->
1027 let () = Errors.invalid_req_implements
(fst
h) in
1029 | ClassTraitRequire
(MustImplement
, h) ->
1030 hint_no_typedef env h;
1031 let acc_impls, acc_exts
= acc
in
1032 (hint ~
allow_this:true env h :: acc_impls, acc_exts
)
1033 | ClassVars
_ -> acc
1036 and constructor env acc
= function
1037 | Attributes
_ -> acc
1040 | ClassTraitRequire
_ -> acc
1041 | ClassVars
_ -> acc
1042 | Method
({ m_name
= (p, name); _ } as m
) when name = SN.Members.__construct
->
1043 let genv, lenv = env in
1044 let env = ({ genv with in_member_fun
= true}, lenv) in
1046 | None
-> Some
(method_
env m
)
1047 | Some
_ -> Errors.method_name_already_bound
p name; acc
)
1050 and class_const
env x acc
=
1052 | Attributes
_ -> acc
1053 | Const
(h, l) -> const_defl
h env l @ acc
1055 | ClassTraitRequire
_ -> acc
1056 | ClassVars
_ -> acc
1059 and class_var_static
env x acc
=
1061 | Attributes
_ -> acc
1063 | ClassTraitRequire
_ -> acc
1065 | ClassVars
(kl
, h, cvl
) when List.mem Static kl
->
1066 let h = opt_map
(hint ~is_static_var
:true env) h in
1067 let cvl = List.map
(class_var_
env) cvl in
1068 let cvl = List.map
(fill_cvar kl
h) cvl in
1070 | ClassVars
_ -> acc
1073 and class_var
env x acc
=
1075 | Attributes
_ -> acc
1077 | ClassTraitRequire
_ -> acc
1079 | ClassVars
(kl
, h, cvl) when not
(List.mem Static kl
) ->
1080 (* there are no covariance issues with private members *)
1081 let allow_this = (List.mem Private kl
) in
1082 let h = opt_map
(hint ~
allow_this:allow_this env) h in
1083 let cvl = List.map
(class_var_
env) cvl in
1084 let cvl = List.map
(fill_cvar kl
h) cvl in
1086 | ClassVars
_ -> acc
1089 and class_static_method
env x acc
=
1091 | Attributes
_ -> acc
1093 | ClassTraitRequire
_ -> acc
1095 | ClassVars
_ -> acc
1096 | Method m
when snd m
.m_name
= SN.Members.__construct
-> acc
1097 | Method m
when List.mem Static m
.m_kind
-> method_
env m
:: acc
1100 and class_method
env sids cv_ids
x acc
=
1102 | Attributes
_ -> acc
1104 | ClassTraitRequire
_ -> acc
1106 | ClassVars
_ -> acc
1107 | Method m
when snd m
.m_name
= SN.Members.__construct
-> acc
1108 | Method m
when not
(List.mem Static m
.m_kind
) ->
1109 let genv, lenv = env in
1110 let env = ({ genv with in_member_fun
= true}, lenv) in
1111 method_
env m
:: acc
1114 and check_constant_expr
(pos, e
) =
1116 | Unsafeexpr
_ | Id
_ | Null
| True
| False
| Int
_
1117 | Float
_ | String
_
1118 | String2
([], _) -> ()
1119 | Class_const
((_, cls
), _) when cls
<> "static" -> ()
1121 | Unop
((Uplus
| Uminus
| Utild
| Unot
), e
) -> check_constant_expr e
1122 | Binop
(op
, e1
, e2
) ->
1123 (* Only assignment is invalid *)
1125 | Eq
_ -> Errors.illegal_constant
pos
1127 check_constant_expr e1
;
1128 check_constant_expr e2
)
1129 | Eif
(e1
, e2
, e3
) ->
1130 check_constant_expr e1
;
1131 ignore
(opt_map check_constant_expr e2
);
1132 check_constant_expr e3
1134 | String2
((var_pos
, _) :: _, _) ->
1135 Errors.local_const var_pos
1136 | _ -> Errors.illegal_constant
pos
1138 and const_defl
h env l = List.map
(const_def
h env) l
1139 and const_def
h env (x, e
) =
1140 check_constant_expr e
;
1141 let new_const = Env.new_const env x in
1142 match (fst
env).in_mode
with
1145 let h = opt_map
(hint env) h in
1146 h, new_const, expr
env e
1148 let h = opt_map
(hint env) h in
1149 h, new_const, (fst e
, N.Any
)
1151 and class_var_
env (x, e
) =
1152 let id = Env.new_const env x in
1154 match (fst
env).in_mode
with
1155 | Ast.Mstrict
| Ast.Mpartial
-> opt_map
(expr
env) e
1156 (* Consider every member variable defined in a class in decl mode to be
1157 * initalized by giving it a magic value of type Tany (you can't actually
1158 * write this cast in PHP). Classes might inherit from our decl mode class
1159 * that are themselves not in decl, and there's no way to figure out what
1160 * variables are initalized in a decl class without typechecking its
1161 * initalizers and constructor, which we don't want to do, so just assume
1164 let p = match e with
1166 | Some
(p, _) -> p in
1167 Some
(p, N.Cast
((p, N.Hany
), (p, N.Null
)))
1169 N.({ cv_final
= false;
1170 cv_visibility
= Public
;
1176 and fill_cvar kl ty
x =
1177 let x = { x with N.cv_type
= ty
} in
1180 (* There is no field Static, they are dissociated earlier.
1181 An abstract class variable doesn't make sense.
1184 | Final
-> { x with N.cv_final
= true }
1187 | Private
-> { x with N.cv_visibility
= N.Private
}
1188 | Public
-> { x with N.cv_visibility
= N.Public
}
1189 | Protected
-> { x with N.cv_visibility
= N.Protected
}
1192 and fun_kind
env ft
=
1193 match !((snd
env).has_yield
), ft
with
1194 | false, Ast.FSync
-> N.FSync
1195 | false, Ast.FAsync
-> N.FAsync
1196 | true, Ast.FSync
-> N.FGenerator
1197 | true, Ast.FAsync
-> N.FAsyncGenerator
1200 let genv, lenv = env in
1201 let lenv = Env.empty_local() in
1202 let genv = extend_params
genv m
.m_tparams
in
1203 let env = genv, lenv in
1204 let variadicity, paraml
= fun_paraml
env m
.m_params
in
1205 let name = Env.new_const env m
.m_name
in
1206 let acc = false, false, N.Public
in
1207 let final, abs
, vis
= List.fold_left kind
acc m
.m_kind
in
1208 let unsafe = is_unsafe_body m
.m_body
in
1209 List.iter
check_constraint m
.m_tparams
;
1210 let tparam_l = type_paraml
env m
.m_tparams
in
1212 match genv.in_mode
with
1213 | Ast.Mpartial
| Ast.Mstrict
->
1215 | Ast.Mdecl
-> [] in
1216 let attrs = m
.m_user_attributes
in
1217 let method_type = fun_kind
env m
.m_fun_kind
in
1218 let ret = opt_map
(hint ~
allow_this:true env) m
.m_ret
in
1219 N.({ m_unsafe
= unsafe ;
1221 m_visibility
= vis
;
1224 m_tparams
= tparam_l;
1227 m_user_attributes
= attrs;
1229 m_variadic
= variadicity;
1230 m_fun_kind
= method_type;
1233 and kind
(final, abs
, vis
) = function
1234 | Final
-> true, abs
, vis
1235 | Static
-> final, abs
, vis
1236 | Abstract
-> final, true, vis
1237 | Private
-> final, abs
, N.Private
1238 | Public
-> final, abs
, N.Public
1239 | Protected
-> final, abs
, N.Protected
1241 and fun_paraml
env l =
1242 let _names = List.fold_left
check_repetition SSet.empty l in
1243 let variadicity, l = determine_variadicity
env l in
1244 variadicity, List.map
(fun_param
env) l
1246 and determine_variadicity
env l =
1248 | [] -> N.FVnonVariadic
, []
1250 match x.param_is_variadic
, x.param_id
with
1251 | false, _ -> N.FVnonVariadic
, [x]
1252 (* NOTE: variadic params are removed from the list *)
1253 | true, (_, "...") -> N.FVellipsis
, []
1254 | true, _ -> N.FVvariadicArg
(fun_param
env x), []
1257 let variadicity, rl
= determine_variadicity
env rl
in
1258 variadicity, x :: rl
1260 and fun_param
env param
=
1261 let x = Env.new_lvar env param
.param_id
in
1262 let eopt = opt_map
(expr
env) param
.param_expr
in
1263 let ty = opt_map
(hint env) param
.param_hint
in
1264 { N.param_hint
= ty;
1265 param_is_reference
= param
.param_is_reference
;
1266 param_is_variadic
= param
.param_is_variadic
;
1268 param_name
= snd param
.param_id
;
1272 and make_constraints paraml
=
1273 List.fold_right
begin fun (_, (_, x), hl
) acc ->
1275 end paraml
SMap.empty
1277 and extend_params
genv paraml
=
1278 let params = List.fold_right
begin fun (_, (_, x), hopt
) acc ->
1280 end paraml
genv.type_params
in
1281 { genv with type_params
= params }
1283 and uselist_lambda f
=
1284 (* semantic duplication: This is copied from the implementation of the
1285 `Lfun` variant of `expr_` defined earlier in this file. *)
1286 let to_capture = ref [] in
1287 let handle_unbound (p, x) =
1288 to_capture := x :: !to_capture;
1291 let genv = Env.make_fun_genv empty SMap.empty f
in
1292 let lenv = Env.empty_local () in
1293 let lenv = { lenv with unbound_mode
= UBMFunc
handle_unbound } in
1294 let env = genv, lenv in
1295 ignore
(expr_lambda
env f
);
1299 let tparams = make_constraints f
.f_tparams
in
1300 let genv = Env.make_fun_genv genv tparams f
in
1301 let lenv = Env.empty_local () in
1302 let env = genv, lenv in
1303 let h = opt_map
(hint ~
allow_this:true env) f
.f_ret
in
1304 let variadicity, paraml
= fun_paraml
env f
.f_params
in
1305 let x = Env.fun_id env f
.f_name
in
1306 let unsafe = is_unsafe_body f
.f_body
in
1307 List.iter
check_constraint f
.f_tparams
;
1308 let f_tparams = type_paraml
env f
.f_tparams in
1310 match genv.in_mode
with
1311 | Ast.Mstrict
| Ast.Mpartial
-> block
env f
.f_body
1314 let kind = fun_kind
env f
.f_fun_kind
in
1316 { N.f_unsafe
= unsafe;
1320 f_tparams = f_tparams;
1323 f_variadic
= variadicity;
1328 and cut_and_flatten ?
(replacement
=Noop
) = function
1330 | Unsafe
:: _ -> [replacement
]
1331 | Block b
:: rest
->
1332 (cut_and_flatten ~replacement b
) @ (cut_and_flatten ~replacement rest
)
1333 | x :: rest
-> x :: (cut_and_flatten ~replacement rest
)
1337 | Block
_ -> assert false
1338 | Unsafe
-> assert false
1339 | Fallthrough
-> N.Fallthrough
1341 | Expr
e -> N.Expr
(expr
env e)
1342 | Break
p -> N.Break
p
1343 | Continue
p -> N.Continue
p
1344 | Throw
e -> let terminal = not
(fst
env).in_try
in
1345 N.Throw
(terminal, expr
env e)
1346 | Return
(p, e) -> N.Return
(p, oexpr
env e)
1347 | Static_var el
-> N.Static_var
(static_varl
env el
)
1348 | If
(e, b1
, b2
) -> if_stmt
env st
e b1 b2
1349 | Do
(b
, e) -> do_stmt
env b
e
1350 | While
(e, b
) -> while_stmt
env e b
1351 | For
(st1
, e, st2
, b
) -> for_stmt
env st1
e st2 b
1352 | Switch
(e, cl
) -> switch_stmt
env st
e cl
1353 | Foreach
(e, aw
, ae
, b
)-> foreach_stmt
env e aw ae b
1354 | Try
(b
, cl
, fb
) -> try_stmt
env st b cl fb
1356 and if_stmt
env st
e b1 b2
=
1357 let e = expr
env e in
1358 let vars = Naming_ast_helpers.GetLocals.stmt
SMap.empty st
in
1359 SMap.iter
(fun x p -> Env.new_pending_lvar env (p, x)) vars;
1360 let result = Env.scope env (
1362 let _, lenv = env in
1363 let all_locals_copy = !(lenv.all_locals
) in
1364 let all1, b1
= branch
env b1
in
1365 let all2, b2
= branch
env b2
in
1366 let all_locals = SMap.union
all1 all2 in
1367 lenv.all_locals := SMap.union
all_locals all_locals_copy;
1370 Env.promote_pending env;
1373 and do_stmt
env b
e =
1374 let new_scope = false in
1375 let b = block ~
new_scope env b in
1376 N.Do
(b, expr
env e)
1378 and while_stmt
env e b =
1379 let e = expr
env e in
1380 N.While
(e, block
env b)
1382 and for_stmt
env e1 e2 e3
b =
1383 let e1 = expr
env e1 in
1384 let e2 = expr
env e2 in
1385 let e3 = expr
env e3 in
1388 N.For
(e1, e2, e3, block
env b)
1391 and switch_stmt
env st
e cl
=
1392 let e = expr
env e in
1393 let vars = Naming_ast_helpers.GetLocals.stmt
SMap.empty st
in
1394 SMap.iter
(fun x p -> Env.new_pending_lvar env (p, x)) vars;
1395 let result = Env.scope env (
1397 let _, lenv = env in
1398 let all_locals_copy = !(lenv.all_locals) in
1399 let all_locals, cl
= casel
env cl
in
1400 lenv.all_locals := SMap.union
all_locals all_locals_copy;
1403 Env.promote_pending env;
1406 and foreach_stmt
env e aw ae
b =
1407 let e = expr
env e in
1410 let _, lenv = env in
1411 let all_locals_copy = !(lenv.all_locals) in
1412 let ae = as_expr
env aw
ae in
1413 let all_locals, b = branch
env b in
1414 lenv.all_locals := SMap.union
all_locals all_locals_copy;
1415 N.Foreach
(e, ae, b)
1418 and as_expr
env aw
= function
1420 let vars = Naming_ast_helpers.GetLocals.lvalue_foreach
SMap.empty ev
in
1421 SMap.iter
(fun x p -> ignore
(Env.new_lvar env (p, x))) vars;
1422 let ev = expr
env ev in
1425 | Some
p -> N.Await_as_v
(p, ev))
1426 | As_kv
((p1
, Lvar k
), ev) ->
1427 let k = p1
, N.Lvar
(Env.new_lvar env k) in
1428 let vars = Naming_ast_helpers.GetLocals.lvalue_foreach
SMap.empty ev in
1429 SMap.iter
(fun x p -> ignore
(Env.new_lvar env (p, x))) vars;
1430 let ev = expr
env ev in
1432 | None
-> N.As_kv
(k, ev)
1433 | Some
p -> N.Await_as_kv
(p, k, ev))
1434 | As_kv
((p, _), _) ->
1435 Errors.expected_variable
p;
1436 let x1 = p, N.Lvar
(Env.new_lvar env (p, "__internal_placeholder")) in
1437 let x2 = p, N.Lvar
(Env.new_lvar env (p, "__internal_placeholder")) in
1439 | None
-> N.As_kv
(x1, x2)
1440 | Some
p -> N.Await_as_kv
(p, x1, x2))
1442 and try_stmt
env st
b cl fb
=
1443 let vars = Naming_ast_helpers.GetLocals.stmt
SMap.empty st
in
1444 SMap.iter
(fun x p -> Env.new_pending_lvar env (p, x)) vars;
1445 let result = Env.scope env (
1447 let genv, lenv = env in
1448 let all_locals_copy = !(lenv.all_locals) in
1449 (* isolate finally from the rest of the try-catch: if the first
1450 * statement of the try is an uncaught exception, finally will
1451 * still be executed *)
1452 let all_finally, fb
= branch
(genv, lenv) fb
in
1453 lenv.all_locals := all_locals_copy;
1454 let all_locals_copy = !(lenv.all_locals) in
1455 let all1, b = branch
({ genv with in_try
= true}, lenv) b in
1456 let all_locals, cl
= catchl
env cl
in
1457 let all_locals = SMap.union
all1 all_locals in
1458 lenv.all_locals := SMap.union
all_locals all_locals_copy;
1461 Env.promote_pending env;
1464 and block ?
(new_scope=true) env stl
=
1465 let stl = cut_and_flatten
stl in
1469 fun env -> List.map
(stmt
env) stl
1471 else List.map
(stmt
env) stl
1473 and branch
env stmt_l
=
1474 let stmt_l = cut_and_flatten
stmt_l in
1475 let genv, lenv = env in
1476 let lenv_copy = !(lenv.locals
) in
1477 let lenv_all_locals_copy = !(lenv.all_locals) in
1478 let lenv_pending_copy = !(lenv.pending_locals
) in
1479 let res = List.map
(stmt
env) stmt_l in
1480 lenv.locals
:= lenv_copy;
1481 let lenv_all_locals = !(lenv.all_locals) in
1482 lenv.all_locals := lenv_all_locals_copy;
1483 lenv.pending_locals
:= lenv_pending_copy;
1484 lenv_all_locals, res
1486 and static_varl
env l = List.map
(static_var
env) l
1487 and static_var
env = function
1488 | p, Lvar
_ as lv
-> expr
env (p, Binop
(Eq None
, lv
, (p, Null
)))
1491 and expr_obj_get_name
env = function
1492 | p, Id
x -> p, N.Id
x
1494 (match (fst
env).in_mode
with
1496 Errors.dynamic_method_call
p
1497 | Ast.Mpartial
| Ast.Mdecl
->
1502 and exprl
env l = List.map
(expr
env) l
1503 and oexpr
env e = opt_map
(expr
env) e
1504 and expr
env (p, e) = p, expr_
env e
1505 and expr_
env = function
1506 | Array
l -> N.Array
(rev_rev_map
(afield
env) l)
1507 | Collection
(id, l) -> begin
1508 let p, cn
= Namespaces.elaborate_id
((fst
env).namespace
) id in
1511 x = SN.Collections.cVector
1512 || x = SN.Collections.cImmVector
1513 || x = SN.Collections.cSet
1514 || x = SN.Collections.cImmSet
->
1515 N.ValCollection
(cn
, (List.map
(afield_value
env cn
) l))
1517 x = SN.Collections.cMap
1518 || x = SN.Collections.cImmMap
1519 || x = SN.Collections.cStableMap
->
1520 N.KeyValCollection
(cn
, (List.map
(afield_kvalue
env cn
) l))
1521 | x when x = SN.Collections.cPair
->
1524 Errors.naming_too_few_arguments
p;
1527 let pn = SN.Collections.cPair
in
1528 N.Pair
(afield_value
env pn e1, afield_value
env pn e2)
1530 Errors.naming_too_many_arguments
p;
1534 Errors.expected_collection
p cn
;
1537 | Clone
e -> N.Clone
(expr
env e)
1542 | Float s
-> N.Float s
1543 | String s
-> N.String s
1544 | String2
(idl
, (_, s
)) -> N.String2
(string2
env (List.rev idl
), s
)
1547 | const when const = SN.PseudoConsts.g__LINE__
-> N.Int
x
1548 | const when const = SN.PseudoConsts.g__CLASS__
->
1549 (match (fst
env).cclass
with
1550 | None
-> Errors.illegal_CLASS
(fst
x); N.Any
1552 (* this isn't quite correct when inside a trait, as
1553 * __CLASS__ is replaced by the using class, but it's
1554 * sufficient for typechecking purposes (we require
1555 * subclass to be compatible with the trait member/method
1558 | const when const = SN.PseudoConsts.g__TRAIT__
->
1559 (match (fst
env).cclass
with
1560 | Some c
when c
.c_kind
= Ctrait
-> N.String c
.c_name
1561 | _ -> Errors.illegal_TRAIT
(fst
x); N.Any
)
1563 const = SN.PseudoConsts.g__FILE__
1564 || const = SN.PseudoConsts.g__DIR__
1565 (* could actually check that we are in a function, method, etc *)
1566 || const = SN.PseudoConsts.g__FUNCTION__
1567 || const = SN.PseudoConsts.g__METHOD__
1568 || const = SN.PseudoConsts.g__NAMESPACE__
->
1570 | _ -> N.Id
(Env.global_const env x)
1572 | Lvar
(_, "$this") -> N.This
1574 Naming_hooks.dispatch_lvar_hook
x !((snd
env).locals
);
1575 N.Lvar
(Env.lvar env x)
1576 | Obj_get
(e1, (p, _ as e2), nullsafe
) ->
1577 (* If we encounter Obj_get(_,_,true) by itself, then it means "?->"
1578 is being used for instance property access; see the case below for
1579 handling nullsafe instance method calls to see how this works *)
1580 let nullsafe = match nullsafe with
1581 | OG_nullsafe
-> Errors.nullsafe_property_access
p; N.OG_nullsafe
1582 | OG_nullthrows
-> N.OG_nullthrows
1584 N.Obj_get
(expr
env e1, expr_obj_get_name
env e2, nullsafe)
1585 | Array_get
((p, Lvar
x), None
) ->
1586 let id = p, N.Lvar
(Env.lvar env x) in
1587 N.Array_get
(id, None
)
1588 | Array_get
(e1, e2) -> N.Array_get
(expr
env e1, oexpr
env e2)
1589 | Class_get
(x1, x2) ->
1590 N.Class_get
(make_class_id
env x1, x2)
1591 | Class_const
(x1, x2) ->
1592 N.Class_const
(make_class_id
env x1, x2)
1593 | Call
((_, Id
(p, pseudo_func
)), el
, uel
)
1594 when pseudo_func
= SN.SpecialFunctions.echo
->
1595 splat_unexpected uel
;
1596 N.Call
(N.Cnormal
, (p, N.Id
(p, pseudo_func
)), exprl
env el
, [])
1597 | Call
((p, Id
(_, cn
)), el
, uel
) when cn
= SN.SpecialFunctions.call_user_func
->
1598 splat_unexpected uel
;
1600 | [] -> Errors.naming_too_few_arguments
p; N.Any
1601 | f
:: el
-> N.Call
(N.Cuser_func
, expr
env f
, exprl
env el
, [])
1603 | Call
((p, Id
(_, cn
)), el
, uel
) when cn
= SN.SpecialFunctions.fun_ ->
1604 splat_unexpected uel
;
1606 | [] -> Errors.naming_too_few_arguments
p; N.Any
1607 | [_, String
(p2
, s
)] when String.contains s '
:'
->
1608 Errors.illegal_meth_fun
p; N.Any
1609 | [_, String
x] -> N.Fun_id
(Env.fun_id env x)
1611 Errors.illegal_fun
p;
1613 | _ -> Errors.naming_too_many_arguments
p; N.Any
1615 | Call
((p, Id
(_, cn
)), el
, uel
) when cn
= SN.SpecialFunctions.inst_meth
->
1616 splat_unexpected uel
;
1618 | [] -> Errors.naming_too_few_arguments
p; N.Any
1619 | [_] -> Errors.naming_too_few_arguments
p; N.Any
1620 | instance
::(_, String meth
)::[] ->
1621 N.Method_id
(expr
env instance
, meth
)
1622 | (p, _)::(_)::[] ->
1623 Errors.illegal_inst_meth
p;
1625 | _ -> Errors.naming_too_many_arguments
p; N.Any
1627 | Call
((p, Id
(_, cn
)), el
, uel
) when cn
= SN.SpecialFunctions.meth_caller
->
1628 splat_unexpected uel
;
1630 | [] -> Errors.naming_too_few_arguments
p; N.Any
1631 | [_] -> Errors.naming_too_few_arguments
p; N.Any
1633 (match (expr
env e1), (expr
env e2) with
1634 | (_, N.String cl
), (_, N.String meth
) ->
1635 N.Method_caller
(Env.class_name env cl
, meth
)
1636 | (_, N.Class_const
(N.CI cl
, (_, mem))), (_, N.String meth
)
1637 when mem = SN.Members.mClass
->
1638 N.Method_caller
(Env.class_name env cl
, meth
)
1640 Errors.illegal_meth_caller
p;
1643 | _ -> Errors.naming_too_many_arguments
p; N.Any
1645 | Call
((p, Id
(_, cn
)), el
, uel
) when cn
= SN.SpecialFunctions.class_meth
->
1646 splat_unexpected uel
;
1648 | [] -> Errors.naming_too_few_arguments
p; N.Any
1649 | [_] -> Errors.naming_too_few_arguments
p; N.Any
1651 (match (expr
env e1), (expr
env e2) with
1652 | (_, N.String cl
), (_, N.String meth
) ->
1653 N.Smethod_id
(Env.class_name env cl
, meth
)
1654 | (_, N.Class_const
(N.CI cl
, (_, mem))), (_, N.String meth
)
1655 when mem = SN.Members.mClass
->
1656 N.Smethod_id
(Env.class_name env cl
, meth
)
1657 | (p, N.Class_const
((N.CIself
|N.CIstatic
), (_, mem))),
1658 (_, N.String meth
) when mem = SN.Members.mClass
->
1659 (match (fst
env).cclass
with
1660 | Some cl
-> N.Smethod_id
(cl
.c_name
, meth
)
1661 | None
-> Errors.illegal_class_meth
p; N.Any
)
1662 | (p, _), (_) -> Errors.illegal_class_meth
p; N.Any
1664 | _ -> Errors.naming_too_many_arguments
p; N.Any
1666 | Call
((p, Id
(_, cn
)), el
, uel
) when cn
= SN.SpecialFunctions.assert_
->
1667 splat_unexpected uel
;
1668 if List.length el
<> 1
1669 then Errors.assert_arity
p;
1670 N.Assert
(N.AE_assert
(expr
env (List.hd el
)))
1671 | Call
((p, Id
(_, cn
)), el
, uel
) when cn
= SN.SpecialFunctions.invariant
->
1672 splat_unexpected uel
;
1674 | st
:: format
:: el
->
1675 let el = exprl
env el in
1676 N.Assert
(N.AE_invariant
(expr
env st
, expr
env format
, el))
1678 Errors.naming_too_few_arguments
p;
1681 | Call
((p, Id
(_, cn
)), el, uel
)
1682 when cn
= SN.SpecialFunctions.invariant_violation
->
1683 splat_unexpected uel
;
1686 let el = exprl
env el in
1687 N.Assert
(N.AE_invariant_violation
(expr
env format
, el))
1689 Errors.naming_too_few_arguments
p;
1692 | Call
((p, Id
(_, cn
)), el, uel
) when cn
= SN.SpecialFunctions.tuple
->
1693 splat_unexpected uel
;
1695 | [] -> Errors.naming_too_few_arguments
p; N.Any
1696 | el -> N.List
(exprl
env el)
1698 | Call
((p, Id
(_, cn
)), el, uel
) when cn
= SN.FB.fgena
->
1699 splat_unexpected uel
;
1701 | [e] -> N.Special_func
(N.Gena
(expr
env e))
1702 | _ -> Errors.gena_arity
p; N.Any
1704 | Call
((p, Id
(_, cn
)), el, uel
) when cn
= SN.FB.fgenva
->
1705 splat_unexpected uel
;
1706 if List.length
el < 1
1707 then (Errors.genva_arity
p; N.Any
)
1708 else N.Special_func
(N.Genva
(exprl
env el))
1709 | Call
((p, Id
(_, cn
)), el, uel
) when cn
= SN.FB.fgen_array_rec
->
1710 splat_unexpected uel
;
1712 | [e] -> N.Special_func
(N.Gen_array_rec
(expr
env e))
1713 | _ -> Errors.gen_array_rec_arity
p; N.Any
1715 | Call
((p, Id
(_, cn
)), el, uel
) when cn
= SN.FB.fgen_array_va_rec_DEPRECATED
->
1716 splat_unexpected uel
;
1717 if List.length
el < 1
1719 Errors.gen_array_va_rec_arity
p;
1722 else N.Special_func
(N.Gen_array_va_rec
(exprl
env el))
1723 | Call
((p, Id f
), el, uel
) ->
1724 N.Call
(N.Cnormal
, (p, N.Id
(Env.fun_id env f
)),
1725 exprl
env el, exprl
env uel
)
1726 (* Handle nullsafe instance method calls here. Because Obj_get is used
1727 for both instance property access and instance method calls, we need
1728 to match the entire "Call(Obj_get(..), ..)" pattern here so that we
1729 only match instance method calls *)
1730 | Call
((p, Obj_get
(e1, e2, OG_nullsafe
)), el, uel
) ->
1733 (p, N.Obj_get
(expr
env e1, expr_obj_get_name
env e2, N.OG_nullsafe
)),
1734 exprl
env el, exprl
env uel
)
1735 (* Handle all kinds of calls that weren't handled by any of
1737 | Call
(e, el, uel
) ->
1738 N.Call
(N.Cnormal
, expr
env e, exprl
env el, exprl
env uel
)
1739 | Yield_break
-> (snd
env).has_yield
:= true; N.Yield_break
1740 | Yield
e -> (snd
env).has_yield
:= true; N.Yield
(afield
env e)
1741 | Await
e -> N.Await
(expr
env e)
1742 | List
el -> N.List
(exprl
env el)
1743 | Expr_list
el -> N.Expr_list
(exprl
env el)
1745 hint_no_typedef env ty;
1746 let (p, x), hl
= match ty with
1747 | _, Happly
(id, hl
) -> (id, hl
)
1748 | _ -> assert false in
1749 let ty = match try_castable_hint
env p x hl
with
1753 | x when x = SN.Typehints.object_cast
->
1754 (* (object) is a valid cast but not a valid type annotation *)
1755 (* FIXME we are not modeling the correct runtime behavior here -- the
1756 * runtime result type is an stdClass if the original type is
1757 * primitive. But we should probably just disallow object casts
1760 | x when x = SN.Typehints.void
->
1763 | x when x = SN.Typehints.unset_cast
->
1764 Errors.unset_cast
p;
1767 (* Let's just assume that any other invalid cases are attempts to
1768 * cast to specific objects *)
1769 Errors.object_cast
p x;
1772 N.Cast
(ty, expr
env e2)
1773 | Unop
(uop
, e) -> N.Unop
(uop
, expr
env e)
1774 | Binop
(Eq None
as op
, lv
, e2) ->
1775 let e2 = expr
env e2 in
1776 let vars = Naming_ast_helpers.GetLocals.lvalue
SMap.empty lv
in
1777 SMap.iter
(fun x p -> ignore
(Env.new_lvar env (p, x))) vars;
1778 N.Binop
(op
, expr
env lv
, e2)
1779 | Binop
(bop
, e1, e2) ->
1780 let e1 = expr
env e1 in
1781 N.Binop
(bop
, e1, expr
env e2)
1782 | Eif
(e1, e2opt
, e3) ->
1783 (* The order matters here, of course -- e1 can define vars that need to
1784 * be available in e2 and e3. *)
1785 let e1 = expr
env e1 in
1786 let e2opt = oexpr
env e2opt in
1787 let e3 = expr
env e3 in
1788 N.Eif
(e1, e2opt, e3)
1789 | InstanceOf
(e, (p, Id
x)) ->
1790 let id = match x with
1791 | px
, n
when n
= SN.Classes.cParent
->
1792 if (fst
env).cclass
= None
then
1793 let () = Errors.parent_outside_class
p in
1796 | px
, n
when n
= SN.Classes.cSelf
->
1797 if (fst
env).cclass
= None
then
1798 let () = Errors.self_outside_class
p in
1801 | px
, n
when n
= SN.Classes.cStatic
->
1802 if (fst
env).cclass
= None
then
1803 let () = Errors.static_outside_class
p in
1808 (Env.class_name env x) in
1809 N.InstanceOf
(expr
env e, (p, N.Id
id))
1810 | InstanceOf
(e1, e2) ->
1811 N.InstanceOf
(expr
env e1, expr
env e2)
1812 | New
(x, el, uel
) ->
1813 N.New
(make_class_id
env x, exprl
env el, exprl
env uel
)
1815 let idl = List.map fst
idl in
1816 let idl = List.filter
(function (_, "$this") -> false | _ -> true) idl in
1817 let idl'
= List.map
(Env.lvar env) idl in
1818 let env = (fst
env, Env.empty_local ()) in
1819 List.iter2
(Env.add_lvar env) idl idl'
;
1820 let f = expr_lambda
env f in
1823 (* We have to build the capture list while we're finding names in
1824 the closure body---accumulate it in to_capture. *)
1825 (* semantic duplication: The logic here is also used in `uselist_lambda`.
1826 The differences are enough that it does not make sense to refactor
1827 this out for now. *)
1828 let to_capture = ref [] in
1829 let handle_unbound (p, x) =
1830 let cap = Env.lvar env (p, x) in
1831 to_capture := cap :: !to_capture;
1834 let lenv = Env.empty_local () in
1835 let lenv = { lenv with unbound_mode
= UBMFunc
handle_unbound } in
1836 let env = (fst
env, lenv) in
1837 let f = expr_lambda
env f in
1838 N.Efun
(f, !to_capture)
1839 | Xml
(x, al
, el) -> N.Xml
(Env.class_name env x, attrl
env al
, exprl
env el)
1841 N.Shape
begin List.fold_left
begin fun fdm
(pname
, value) ->
1842 let pos, name = convert_shape_name env pname
in
1843 if ShapeMap.mem name fdm
1844 then Errors.fd_name_already_bound
pos;
1845 ShapeMap.add
name (expr
env value) fdm
1846 end ShapeMap.empty fdl
1852 | Ref
(p, e_
) -> expr_
env e_
1854 and expr_lambda
env f =
1855 let h = opt_map
(hint ~
allow_this:true env) f.f_ret
in
1856 let unsafe = List.mem Unsafe
f.f_body
in
1857 let variadicity, paraml
= fun_paraml
env f.f_params
in
1858 let body = block
env f.f_body
in
1859 let f_kind = fun_kind
env f.f_fun_kind
in
1861 N.f_unsafe
= unsafe;
1862 f_mode
= (fst
env).in_mode
;
1868 f_variadic
= variadicity;
1869 f_fun_kind
= f_kind;
1872 and make_class_id
env (p, x as cid
) =
1875 | x when x = SN.Classes.cParent
->
1876 if (fst
env).cclass
= None
then
1877 let () = Errors.parent_outside_class
p in
1878 N.CI
(p, "*Unknown*")
1880 | x when x = SN.Classes.cSelf
->
1881 if (fst
env).cclass
= None
then
1882 let () = Errors.self_outside_class
p in
1883 N.CI
(p, "*Unknown*")
1885 | x when x = SN.Classes.cStatic
-> if (fst
env).cclass
= None
then
1886 let () = Errors.static_outside_class
p in
1887 N.CI
(p, "*Unknown*")
1889 | x when x = "$this" -> N.CIvar
(p, N.This
)
1890 | x when x.[0] = '$'
-> N.CIvar
(p, N.Lvar
(Env.new_lvar env cid
))
1891 | _ -> N.CI
(Env.class_name env cid
)
1894 lfold
(case
env) SMap.empty l
1896 and case
env acc = function
1898 let b = cut_and_flatten ~replacement
:Fallthrough
b in
1899 let all_locals, b = branch
env b in
1900 let acc = SMap.union
all_locals acc in
1903 let e = expr
env e in
1904 let b = cut_and_flatten ~replacement
:Fallthrough
b in
1905 let all_locals, b = branch
env b in
1906 let acc = SMap.union
all_locals acc in
1909 and catchl
env l = lfold
(catch
env) SMap.empty l
1910 and catch
env acc (x1, x2, b) =
1911 let x2 = Env.new_lvar env x2 in
1912 let all_locals, b = branch
env b in
1913 let acc = SMap.union
all_locals acc in
1914 acc, (Env.class_name env x1, x2, b)
1916 and fieldl
env l = List.map
(field
env) l
1917 and field
env (e1, e2) = (expr
env e1, expr
env e2)
1919 and afield
env = function
1920 | AFvalue
e -> N.AFvalue
(expr
env e)
1921 | AFkvalue
(e1, e2) -> N.AFkvalue
(expr
env e1, expr
env e2)
1923 and afield_value
env cname = function
1924 | AFvalue
e -> expr
env e
1925 | AFkvalue
(e1, e2) ->
1926 Errors.unexpected_arrow
(fst
e1) cname;
1929 and afield_kvalue
env cname = function
1931 Errors.missing_arrow
(fst
e) cname;
1932 expr
env e, expr
env (fst
e, Lvar
(fst
e, "__internal_placeholder"))
1933 | AFkvalue
(e1, e2) -> expr
env e1, expr
env e2
1935 and attrl
env l = List.map
(attr
env) l
1936 and attr
env (x, e) = x, expr
env e
1938 and string2
env idl =
1939 rev_rev_map
(expr
env) idl
1941 (*****************************************************************************)
1943 (*****************************************************************************)
1945 let typedef genv tdef
=
1946 let ty = match tdef
.t_kind
with Alias t
| NewType t
-> t
in
1947 let cstrs = class_constraints genv tdef
.t_tparams
in
1948 let env = Env.make_typedef_env genv cstrs tdef
in
1949 let tconstraint = opt_map
(hint env) tdef
.t_constraint
in
1950 List.iter
check_constraint tdef
.t_tparams
;
1951 let tparaml = type_paraml
env tdef
.t_tparams
in
1952 List.iter
begin function
1953 | (_, _, Some
(pos, _)) ->
1954 Errors.typedef_constraint
pos;
1957 let ty = hint env ty in
1958 tparaml, tconstraint, ty
1960 (*****************************************************************************)
1961 (* Global constants *)
1962 (*****************************************************************************)
1964 let check_constant cst
=
1965 (match cst
.cst_type
with
1966 | None
when cst
.cst_mode
= Ast.Mstrict
->
1967 Errors.add_a_typehint
(fst cst
.cst_name
)
1970 check_constant_expr cst
.cst_value
1972 let global_const genv cst
=
1973 let env = Env.make_const_env genv cst
in
1974 let hint = opt_map
(hint env) cst
.cst_type
in
1975 let e = match cst
.cst_kind
with
1976 | Ast.Cst_const
-> check_constant cst
; Some
(expr
env cst
.cst_value
)
1977 (* Define allows any expression, so don't call check_constant. Furthermore it
1978 * often appears at toplevel, which we don't track at all, so don't type or
1979 * even name that expression, it may refer to "undefined" variables that
1980 * actually exist, just untracked since they're toplevel. *)
1981 | Ast.Cst_define
-> None
in
1982 { N.cst_mode
= cst
.cst_mode
;
1983 cst_name
= cst
.cst_name
;
1988 (*****************************************************************************)
1989 (* Declaring the names in a list of files *)
1990 (*****************************************************************************)
1992 let add_files_to_rename nenv failed defl defs_in_env
=
1993 List.fold_left
begin fun failed
(_, def
) ->
1994 match SMap.get def defs_in_env
with
1996 | Some
(previous_definition_position
, _) ->
1997 let filename = Pos.filename previous_definition_position
in
1998 Relative_path.Set.add
filename failed
2003 classes
; types
; consts; consider_names_just_for_autoload
; comments
}
2004 (errorl
, failed
, nenv
) =
2005 let errors, nenv
= Errors.do_
begin fun () ->
2006 dn
("Naming decl: "^
Relative_path.to_absolute fn
);
2007 if consider_names_just_for_autoload
2009 else make_env nenv ~
funs ~classes ~typedefs
:types ~
consts
2013 | [] -> errorl
, failed
, nenv
2016 * If a file has name collisions, we MUST add the list of files that
2017 * were previously defining the type to the set of "failed" files.
2018 * If we fail to do so, we will be in a phony state, where a name could
2022 * A.php defines class A
2023 * B.php defines class B
2024 * Save the state, now let's introduce a new file (foo.php):
2025 * foo.php defines class A and class B.
2027 * 2 things happen (cf serverTypeCheck.ml):
2028 * We remove the names A and B from the global environment.
2029 * We report the error.
2031 * But this is clearly not enough. If the user removes the file foo.php,
2032 * both class A and class B are now missing from the naming environment.
2033 * If the user has a file using class A (in strict), he now gets the
2034 * error "Unbound name class A".
2036 * The solution consist in adding all the files that were previously
2037 * defining the same things as foo.php to the set of files to recheck.
2039 * This way, when the user removes foo.php, A.php and B.php are recomputed
2040 * and the naming environment is in a sane state.
2042 let failed = add_files_to_rename nenv
failed funs nenv
.ifuns in
2043 let failed = add_files_to_rename nenv
failed classes
(fst nenv
.iclasses
) in
2044 let failed = add_files_to_rename nenv
failed types nenv
.itypedefs in
2045 let failed = add_files_to_rename nenv
failed consts nenv
.iconsts in
2046 List.rev_append
l errorl
, Relative_path.Set.add fn
failed, nenv