hphp/hack/src/parser/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:begin 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) ->
  32         get_defs defs acc
  33       | Ast.NamespaceUse _ | Ast.SetNamespaceEnv _ ->
  34         acc
  35        (* toplevel statements are ignored *)
  36       | Ast.Stmt _ -> acc
  37     end
  38 in
  39   get_defs ast ([],[],[],[])
  40
  41 (* Utility functions for getting all nodes of a particular type *)
  42 class ast_get_defs_visitor = object
  43   inherit [Ast.def list] Ast_visitor.ast_visitor
  44
  45   method! on_def acc def =
  46     def :: acc
  47 end
  48
  49 let ast_no_pos_or_docblock_mapper = object (self)
  50   inherit [_] Ast.endo as super
  51   method! private on_pos () _pos = Pos.none
  52
  53   method! on_fun_ env f = super#on_fun_ env { f with f_doc_comment = None}
  54   method! on_class_ env c = super#on_class_ env { c with c_doc_comment = None}
  55   method! on_class_vars_ env cv = super#on_class_vars_ env { cv with cv_doc_comment = None}
  56   method! on_method_ env m = super#on_method_ env { m with m_doc_comment = None}
  57
  58   (* Skip all blocks because we don't care about method bodies *)
  59   method! on_block env _ = self#on_list self#on_stmt env [(Pos.none,Ast.Noop)]
  60 end
  61
  62 (* Given an AST, return an AST with no position or docblock info *)
  63 let remove_pos_and_docblock ast =
  64   ast_no_pos_or_docblock_mapper#on_program () ast
  65
  66
  67 type ignore_attribute_env = {
  68   ignored_attributes: string list
  69 }
  70
  71 let ast_deregister_attributes_mapper = object (self)
  72   inherit [_] Ast.endo as super
  73
  74   method ignored_attr env l =
  75     List.exists l
  76       (fun attr -> List.mem (env.ignored_attributes) (snd attr.ua_name) ~equal:(=))
  77
  78   (* Filter all functions and classes with the user attributes banned *)
  79   method! on_program env toplevels =
  80     let toplevels = List.filter toplevels (fun toplevel ->
  81       match toplevel with
  82       | Fun f when self#ignored_attr env f.f_user_attributes ->
  83         false
  84       | Class c when self#ignored_attr env c.c_user_attributes ->
  85         false
  86       | _ -> true
  87     ) in
  88     super#on_program env toplevels
  89
  90   method! on_class_ env this =
  91     (* Filter out class elements which are methods with wrong attributes *)
  92     let body = this.c_body in
  93     let body = List.filter body (fun elt ->
  94       match elt with
  95       | Method m when self#ignored_attr env m.m_user_attributes -> false
  96       | ClassVars cv when self#ignored_attr env cv.cv_user_attributes -> false
  97       | _ -> true
  98     ) in
  99     let this = { this with c_body = body } in
 100     super#on_class_ env this
 101 end
 102
 103 let deregister_ignored_attributes ast =
 104   let env = {
 105     (* For now, only ignore the __PHPStdLib *)
 106     ignored_attributes = [Naming_special_names.UserAttributes.uaPHPStdLib]
 107   } in
 108   (ast_deregister_attributes_mapper)#on_program env ast
 109
 110
 111 (* Given an AST, generate a unique hash for its decl tree. *)
 112 let generate_ast_decl_hash ast =
 113   (* Why we marshal it into a string first: regular Hashtbl.hash will
 114     collide improperly because it doesn't compare ADTs with strings correctly.
 115     Using Marshal, we guarantee that the two ASTs are represented by a single
 116     primitive type, which we hash.
 117   *)
 118   let str = Marshal.to_string (remove_pos_and_docblock ast) [] in
 119   OpaqueDigest.string str
 120
 121
 122 let get_def_nodes ast =
 123   List.rev ((new ast_get_defs_visitor)#on_program [] ast)
 124
 125 class ast_get_class_elts_visitor = object
 126   inherit [Ast.class_elt list] Ast_visitor.ast_visitor
 127
 128   method! on_class_elt acc elt =
 129     elt :: acc
 130 end
 131
 132 let get_class_elts ast =
 133   List.rev ((new ast_get_class_elts_visitor)#on_program [] ast)
 134
 135 type break_continue_level =
 136   | Level_ok of int option
 137   | Level_non_literal
 138   | Level_non_positive
 139
 140 let get_break_continue_level level_opt =
 141   match level_opt with
 142   | None -> Level_ok None
 143   | Some (_, Ast.Int s) ->
 144     let i = int_of_string s in
 145     if i <= 0 then Level_non_positive
 146     else Level_ok (Some i)
 147   | _ -> Level_non_literal
 148   | exception _ -> Level_non_literal
 149
 150 (* Helpers for XHP attributes *)
 151 let map_xhp_attr (f: id -> id) (g: expr -> expr) = function
 152   | Xhp_simple (id, e) -> Xhp_simple (f id, g e)
 153   | Xhp_spread e -> Xhp_spread (g e)