hphp/hack/src/ast/ast_utils.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 open Core_kernel
  11 open Ast
  12
  13 (* Given a Ast.program, give me the list of entities it defines *)
  14 let get_defs ast =
  15   (* fold_right traverses the file from top to bottom, and as such gives nicer
  16    * error messages than fold_left. E.g. in the case where a function is
  17    * declared twice in the same file, the error will say that the declaration
  18    * with the larger line number is a duplicate. *)
  19   let rec get_defs ast acc =
  20     List.fold_right ast ~init:acc
  21       ~f:(fun def ((acc1, acc2, acc3, acc4) as acc) ->
  22         match def with
  23         | Ast.Fun f ->
  24             (FileInfo.pos_full f.Ast.f_name :: acc1, acc2, acc3, acc4)
  25         | Ast.Class c ->
  26             (acc1, FileInfo.pos_full c.Ast.c_name :: acc2, acc3, acc4)
  27         | Ast.Typedef t ->
  28             (acc1, acc2, FileInfo.pos_full t.Ast.t_id :: acc3, acc4)
  29         | Ast.Constant cst ->
  30             (acc1, acc2, acc3, FileInfo.pos_full cst.Ast.cst_name :: acc4)
  31         | Ast.Namespace (_, defs) -> get_defs defs acc
  32         | Ast.NamespaceUse _ | Ast.SetNamespaceEnv _ -> acc
  33         (* toplevel statements are ignored *)
  34         | Ast.FileAttributes _ | Ast.Stmt _ -> acc)
  35   in
  36   get_defs ast ([], [], [], [])
  37
  38 (* Utility functions for getting all nodes of a particular type *)
  39 class ast_get_defs_visitor =
  40   object
  41     inherit [Ast.def list] Ast_visitor.ast_visitor
  42
  43     method! on_def acc def = def :: acc
  44   end
  45
  46 let ast_no_pos_or_docblock_mapper =
  47   object (self)
  48     inherit [_] Ast.endo as super
  49
  50     method! private on_pos () _pos = Pos.none
  51
  52     method! on_fun_ env f = super#on_fun_ env { f with f_doc_comment = None }
  53
  54     method! on_class_ env c =
  55       super#on_class_ env { c with c_doc_comment = None }
  56
  57     method! on_class_vars_ env cv =
  58       super#on_class_vars_ env { cv with cv_doc_comment = None }
  59
  60     method! on_method_ env m =
  61       super#on_method_ env { m with m_doc_comment = None }
  62
  63     (* Skip all blocks because we don't care about method bodies *)
  64     method! on_block env _ =
  65       self#on_list self#on_stmt env [(Pos.none, Ast.Noop)]
  66   end
  67
  68 (* Given an AST, return an AST with no position or docblock info *)
  69 let remove_pos_and_docblock ast =
  70   ast_no_pos_or_docblock_mapper#on_program () ast
  71
  72 type ignore_attribute_env = { ignored_attributes: string list }
  73
  74 let ast_deregister_attributes_mapper =
  75   object (self)
  76     inherit [_] Ast.endo as super
  77
  78     method ignored_attr env l =
  79       List.exists l (fun attr ->
  80           List.mem env.ignored_attributes (snd attr.ua_name) ~equal:( = ))
  81
  82     (* Filter all functions and classes with the user attributes banned *)
  83     method! on_program env toplevels =
  84       let toplevels =
  85         List.filter toplevels (fun toplevel ->
  86             match toplevel with
  87             | Fun f when self#ignored_attr env f.f_user_attributes -> false
  88             | Class c when self#ignored_attr env c.c_user_attributes -> false
  89             | _ -> true)
  90       in
  91       super#on_program env toplevels
  92
  93     method! on_class_ env this =
  94       (* Filter out class elements which are methods with wrong attributes *)
  95       let body = this.c_body in
  96       let body =
  97         List.filter body (fun elt ->
  98             match elt with
  99             | Method m when self#ignored_attr env m.m_user_attributes -> false
 100             | ClassVars cv when self#ignored_attr env cv.cv_user_attributes ->
 101                 false
 102             | _ -> true)
 103       in
 104       let this = { this with c_body = body } in
 105       super#on_class_ env this
 106   end
 107
 108 let deregister_ignored_attributes ast =
 109   let env =
 110     {
 111       (* For now, only ignore the __PHPStdLib *)
 112       ignored_attributes = [Naming_special_names.UserAttributes.uaPHPStdLib];
 113     }
 114   in
 115   ast_deregister_attributes_mapper#on_program env ast
 116
 117 (* Given an AST, generate a unique hash for its decl tree. *)
 118 let generate_ast_decl_hash ast =
 119   (* Why we marshal it into a string first: regular Hashtbl.hash will
 120     collide improperly because it doesn't compare ADTs with strings correctly.
 121     Using Marshal, we guarantee that the two ASTs are represented by a single
 122     primitive type, which we hash.
 123   *)
 124   let str = Marshal.to_string (remove_pos_and_docblock ast) [] in
 125   OpaqueDigest.string str
 126
 127 let get_def_nodes ast = List.rev ((new ast_get_defs_visitor)#on_program [] ast)
 128
 129 class ast_get_class_elts_visitor =
 130   object
 131     inherit [Ast.class_elt list] Ast_visitor.ast_visitor
 132
 133     method! on_class_elt acc elt = elt :: acc
 134   end
 135
 136 let get_class_elts ast =
 137   List.rev ((new ast_get_class_elts_visitor)#on_program [] ast)
 138
 139 (* Helpers for XHP attributes *)
 140 let map_xhp_attr (f : id -> id) (g : expr -> expr) = function
 141   | Xhp_simple (id, e) -> Xhp_simple (f id, g e)
 142   | Xhp_spread e -> Xhp_spread (g e)