hphp/hack/src/naming/namingGlobal.ml

   1 (**
   2  * Copyright (c) 2015, Facebook, Inc.
   3  * All rights reserved.
   4  *
   5  * This source code is licensed under the MIT license found in the
   6  * LICENSE file in the "hack" directory of this source tree.
   7  *
   8  *)
   9
  10 (** Module "naming" a program.
  11  *
  12  * The naming phase consists in several things
  13  * 1- get all the global names
  14  * 2- transform all the local names into a unique identifier
  15  *)
  16 open Core_kernel
  17 open Utils
  18 module SN = Naming_special_names
  19
  20 (*****************************************************************************)
  21 (* The types *)
  22 (*****************************************************************************)
  23
  24 let canon_key = String.lowercase
  25
  26 module GEnv = struct
  27   let get_full_pos (pos, name) =
  28     try
  29     match pos with
  30       | FileInfo.Full p -> p, name
  31       | FileInfo.File (FileInfo.Class, fn) ->
  32         let res = unsafe_opt (Ast_provider.find_class_in_file fn name) in
  33         let (p', _) = res.Ast.c_name in
  34         p', name
  35       | FileInfo.File (FileInfo.Typedef, fn) ->
  36         let res = unsafe_opt (Ast_provider.find_typedef_in_file fn name) in
  37         let (p', _) = res.Ast.t_id in
  38         p', name
  39       | FileInfo.File (FileInfo.Const, fn) ->
  40         let res = unsafe_opt (Ast_provider.find_gconst_in_file fn name) in
  41         let (p', _) = res.Ast.cst_name in
  42         p', name
  43       | FileInfo.File (FileInfo.Fun, fn) ->
  44         let res = unsafe_opt (Ast_provider.find_fun_in_file fn name) in
  45         let (p', _) = res.Ast.f_name in
  46         p', name
  47     with Invalid_argument _ ->
  48       (* We looked for a file in the file heap, but it was deleted
  49         before we could get it. This occurs with highest probability when we
  50         have multiple large rebases in quick succession, and the typechecker
  51          doesn't get updates from watchman while checking. For now, we restart
  52         gracefully, but in future versions we'll be restarting the server on
  53         large rebases anyhow, so this is sufficient behavior.
  54
  55         TODO(jjwu): optimize this. Instead of forcing a server restart,
  56         catch the exception in the recheck look and start another recheck cycle
  57         by adding more files to the unprocessed/partially-processed set in
  58         the previous loop.
  59       *)
  60       let fn = FileInfo.get_pos_filename pos in
  61       Hh_logger.log "File missing: %s" (Relative_path.to_absolute fn);
  62       Hh_logger.log "Name missing: %s" (name);
  63       raise File_provider.File_provider_stale
  64
  65   let type_canon_name name = Naming_table.Types.get_canon_name (canon_key name)
  66   let type_pos name =
  67     let name = Option.value (type_canon_name name) ~default:name in
  68     match Naming_table.Types.get_pos name with
  69       | Some (pos, Naming_table.TClass) ->
  70           let p, _ = get_full_pos (pos, name) in
  71           Some p
  72       | Some (pos, Naming_table.TTypedef) ->
  73           let p, _ = get_full_pos (pos, name) in
  74           Some p
  75       | None -> None
  76
  77   let type_canon_pos name =
  78     let name = Option.value (type_canon_name name) ~default:name in
  79     type_pos name
  80
  81   let type_info name = match Naming_table.Types.get_pos name with
  82     | Some (pos, Naming_table.TClass) ->
  83         let p, _ = get_full_pos (pos, name) in
  84         Some (p, Naming_table.TClass)
  85     | Some (pos, Naming_table.TTypedef) ->
  86         let p, _ = get_full_pos (pos, name) in
  87         Some (p, Naming_table.TTypedef)
  88     | None -> None
  89
  90   let fun_canon_name name = Naming_table.Funs.get_canon_name (canon_key name)
  91
  92   let fun_pos name =
  93     match Naming_table.Funs.get_pos name with
  94     | Some pos ->
  95         let p, _ = get_full_pos (pos, name) in
  96         Some p
  97     | None -> None
  98
  99   let fun_canon_pos name =
 100     let name = Option.value (fun_canon_name name) ~default:name in
 101     fun_pos name
 102
 103   let typedef_pos name = match Naming_table.Types.get_pos name with
 104     | Some (pos, Naming_table.TTypedef) ->
 105         let p, _ = get_full_pos (pos, name) in
 106         Some p
 107     | Some (_, Naming_table.TClass)
 108     | None -> None
 109
 110   let gconst_pos name =
 111     match Naming_table.Consts.get_pos name with
 112     | Some pos ->
 113       let p, _ = get_full_pos (pos, name) in
 114       Some p
 115     | None -> None
 116
 117
 118   let compare_pos p q =
 119     let open FileInfo in
 120     match p, q with
 121     | Full p', Full q' -> Pos.compare p' q' = 0
 122     | Full q', File(_, fn)
 123     | File (_, fn), Full q' ->
 124       let qf = Pos.filename q' in
 125       if fn = qf then
 126         assert_false_log_backtrace(
 127           Some "Compared file with full pos in same file"
 128         )
 129       else false
 130     | File (x, fn1), File (y, fn2) ->
 131       fn1 = fn2 && x = y
 132
 133
 134 end
 135
 136 (* The primitives to manipulate the naming environment *)
 137 module Env = struct
 138   let check_not_typehint (p, name) =
 139     let x = canon_key (Utils.strip_all_ns name) in
 140     if SN.Typehints.is_reserved_hh_name x ||
 141        SN.Typehints.is_reserved_global_name x
 142     then
 143       let p, name = GEnv.get_full_pos (p, name) in
 144       Errors.name_is_reserved name p; false
 145     else true
 146
 147   (* Dont check for errors, just add to canonical heap *)
 148   let new_fun_fast fn name =
 149     let name_key = canon_key name in
 150     match Naming_table.Funs.get_canon_name name_key with
 151       | Some _ -> ()
 152       | None ->
 153         Naming_table.Funs.add name (FileInfo.File (FileInfo.Fun, fn))
 154
 155   let new_cid_fast fn name cid_kind =
 156     let name_key = canon_key name in
 157     let mode = match cid_kind with
 158     | Naming_table.TClass -> FileInfo.Class
 159     | Naming_table.TTypedef -> FileInfo.Typedef in
 160     match Naming_table.Types.get_canon_name name_key with
 161       | Some _ -> ()
 162       | None ->
 163         (* We store redundant info in this case, but if the position is a *)
 164         (* Full position, we don't store the kind, so this is necessary *)
 165         Naming_table.Types.add name ((FileInfo.File (mode, fn)), cid_kind)
 166
 167   let new_class_fast fn name = new_cid_fast fn name Naming_table.TClass
 168   let new_typedef_fast fn name = new_cid_fast fn name Naming_table.TTypedef
 169
 170   let new_global_const_fast fn name =
 171     Naming_table.Consts.add name (FileInfo.File (FileInfo.Const, fn))
 172
 173   let new_fun (p, name) =
 174     let name_key = canon_key name in
 175     match Naming_table.Funs.get_canon_name name_key with
 176     | Some canonical ->
 177       let p' = Option.value_exn (Naming_table.Funs.get_pos canonical) in
 178       if not @@ GEnv.compare_pos p' p
 179       then
 180         let p, name = GEnv.get_full_pos (p, name) in
 181         let p', canonical = GEnv.get_full_pos (p', canonical) in
 182         Errors.error_name_already_bound name canonical p p'
 183     | None ->
 184       Naming_table.Funs.add name p
 185
 186   let attr_prefix, attr_prefix_len =
 187     let a = "\\__attribute__" in (* lowercase because canon_key call *)
 188     a, String.length a
 189
 190   let new_cid cid_kind (p, name) =
 191     let validate canonical error =
 192       let (p', _) = match Naming_table.Types.get_pos canonical with
 193         | Some x -> x
 194         | None -> failwith ("Failed to get canonical pos for name " ^ name ^ " vs canonical " ^ canonical)
 195       in
 196       if not @@ GEnv.compare_pos p' p
 197       then
 198       let p, name = GEnv.get_full_pos (p, name) in
 199       let p', canonical = GEnv.get_full_pos (p', canonical) in
 200       error name canonical p p'
 201     in
 202     if not (check_not_typehint (p, name)) then () else
 203     let name_key = canon_key name in
 204     match Naming_table.Types.get_canon_name name_key with
 205     | Some canonical ->
 206       validate canonical Errors.error_name_already_bound
 207     | None ->
 208       (* Check to prevent collision with attribute classes
 209        * If we are checking \A, check \__Attribute__A and vice versa *)
 210       let name_len = String.length name_key in
 211       let alt_name_key =
 212         if name_len > attr_prefix_len &&
 213           String.equal attr_prefix (String.sub name_key 0 attr_prefix_len)
 214         then
 215           "\\" ^ String.sub name_key attr_prefix_len (name_len - attr_prefix_len)
 216         else
 217           attr_prefix ^ String.sub name_key 1 (name_len - 1) in
 218       begin match Naming_table.Types.get_canon_name alt_name_key with
 219       | Some alt_canonical ->
 220         validate alt_canonical Errors.error_class_attribute_already_bound
 221       | None ->
 222         ()
 223       end;
 224       Naming_table.Types.add name (p, cid_kind)
 225
 226   let new_class = new_cid Naming_table.TClass
 227
 228   let new_typedef = new_cid Naming_table.TTypedef
 229
 230   let new_global_const (p, x) =
 231     match Naming_table.Consts.get_pos x with
 232     | Some p' ->
 233       if not @@ GEnv.compare_pos p' p
 234       then
 235       let p, x = GEnv.get_full_pos (p, x) in
 236       let p', x = GEnv.get_full_pos (p', x) in
 237       Errors.error_name_already_bound x x p p'
 238     | None ->
 239       Naming_table.Consts.add x p
 240 end
 241
 242 (*****************************************************************************)
 243 (* Updating the environment *)
 244 (*****************************************************************************)
 245 let remove_decls ~funs ~classes ~typedefs ~consts =
 246   let types = SSet.union classes typedefs in
 247   Naming_table.Types.remove_batch types;
 248   Naming_table.Funs.remove_batch funs;
 249   Naming_table.Consts.remove_batch consts
 250
 251 (*****************************************************************************)
 252 (* The entry point to build the naming environment *)
 253 (*****************************************************************************)
 254
 255 let make_env ~funs ~classes ~typedefs ~consts =
 256   List.iter funs Env.new_fun;
 257   List.iter classes Env.new_class;
 258   List.iter typedefs Env.new_typedef;
 259   List.iter consts Env.new_global_const
 260
 261
 262 let make_env_from_fast fn ~funs ~classes ~typedefs ~consts =
 263   SSet.iter (Env.new_fun_fast fn) funs;
 264   SSet.iter (Env.new_class_fast fn) classes;
 265   SSet.iter (Env.new_typedef_fast fn) typedefs;
 266   SSet.iter (Env.new_global_const_fast fn) consts
 267
 268
 269 (*****************************************************************************)
 270 (* Declaring the names in a list of files *)
 271 (*****************************************************************************)
 272
 273 let add_files_to_rename failed defl defs_in_env =
 274   List.fold_left ~f:begin fun failed (_, def) ->
 275     match defs_in_env def with
 276     | None -> failed
 277     | Some previous_definition_position ->
 278       let filename = Pos.filename previous_definition_position in
 279       Relative_path.Set.add failed filename
 280   end ~init:failed defl
 281
 282 let ndecl_file_fast fn ~funs ~classes ~typedefs ~consts =
 283   make_env_from_fast fn ~funs ~classes ~typedefs ~consts
 284
 285 let ndecl_file fn
 286               { FileInfo.file_mode = _; funs; classes; typedefs; consts;
 287                 comments = _; hash = _} =
 288   let errors, _ = Errors.do_with_context fn Errors.Naming begin fun () ->
 289     dn ("Naming decl: "^Relative_path.to_absolute fn);
 290     make_env ~funs ~classes ~typedefs ~consts
 291   end in
 292   if Errors.is_empty errors
 293   then errors, Relative_path.Set.empty
 294   else
 295   (* IMPORTANT:
 296    * If a file has name collisions, we MUST add the list of files that
 297    * were previously defining the type to the set of "failed" files.
 298    * If we fail to do so, we will be in a phony state, where a name could
 299    * be missing.
 300    *
 301    * Example:
 302    * A.php defines class A
 303    * B.php defines class B
 304    * Save the state, now let's introduce a new file (foo.php):
 305    * foo.php defines class A and class B.
 306    *
 307    * 2 things happen (cf serverTypeCheck.ml):
 308    * We remove the names A and B from the global environment.
 309    * We report the error.
 310    *
 311    * But this is clearly not enough. If the user removes the file foo.php,
 312    * both class A and class B are now missing from the naming environment.
 313    * If the user has a file using class A (in strict), he now gets the
 314    * error "Unbound name class A".
 315    *
 316    * The solution consist in adding all the files that were previously
 317    * defining the same things as foo.php to the set of files to recheck.
 318    *
 319    * This way, when the user removes foo.php, A.php and B.php are recomputed
 320    * and the naming environment is in a sane state.
 321    *
 322    * XXX (jezng): we can probably be less conservative about this -- instead
 323    * of adding all the declarations in the file, why not just add those that
 324    * were actually duplicates?
 325    *)
 326   let failed = Relative_path.Set.singleton fn in
 327   let failed = add_files_to_rename failed funs GEnv.fun_canon_pos in
 328   let failed = add_files_to_rename failed classes GEnv.type_canon_pos in
 329   let failed = add_files_to_rename failed typedefs GEnv.type_canon_pos in
 330   let failed = add_files_to_rename failed consts GEnv.gconst_pos in
 331   errors, failed