hphp/hack/src/annotated_ast/aast_defs_visitors_ancestors.ml

   1 (**
   2  * Copyright (c) 2017, 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 SM = Ast_defs.ShapeMap
  11
  12 class ['self] iter_defs_base =
  13   object (self : 'self)
  14     inherit [_] Ast_defs.iter_defs
  15
  16     method private on_shape_map
  17         : 'a. ('env -> 'a -> unit) -> 'env -> 'a SM.t -> unit =
  18       fun f env x -> SM.iter (self#on_shape_map_entry f env) x
  19
  20     method private on_shape_map_entry
  21         : 'a. ('env -> 'a -> unit) -> 'env -> SM.key -> 'a -> unit =
  22       fun f env key data ->
  23         self#on_shape_field_name env key;
  24         f env data
  25   end
  26
  27 class virtual ['self] reduce_defs_base =
  28   object (self : 'self)
  29     inherit [_] Ast_defs.reduce_defs
  30
  31     method private on_shape_map
  32         : 'a. ('env -> 'a -> 'acc) -> 'env -> 'a SM.t -> 'acc =
  33       fun f env x ->
  34         SM.fold
  35           (fun k d acc -> self#plus acc (self#on_shape_map_entry f env k d))
  36           x self#zero
  37
  38     method private on_shape_map_entry
  39         : 'a. ('env -> 'a -> 'acc) -> 'env -> SM.key -> 'a -> 'acc =
  40       fun f env key data ->
  41         self#plus (self#on_shape_field_name env key) (f env data)
  42   end
  43
  44 class ['self] map_defs_base =
  45   object (self : 'self)
  46     inherit [_] Ast_defs.map_defs
  47
  48     method private on_shape_map
  49         : 'a 'b. ('env -> 'a -> 'b) -> 'env -> 'a SM.t -> 'b SM.t =
  50       fun f env x ->
  51         let map_entry key data acc =
  52           let key = self#on_shape_field_name env key in
  53           let data = f env data in
  54           SM.add key data acc
  55         in
  56         SM.fold map_entry x SM.empty
  57   end
  58
  59 class ['self] endo_defs_base =
  60   object (self : 'self)
  61     inherit [_] Ast_defs.endo_defs
  62
  63     method private on_shape_map
  64         : 'a 'b. ('env -> 'a -> 'b) -> 'env -> 'a SM.t -> 'b SM.t =
  65       fun f env x ->
  66         (* FIXME: Should be possible to write a true (more efficient) endo
  67          implementation rather than copying map *)
  68         let map_entry key data acc =
  69           let key = self#on_shape_field_name env key in
  70           let data = f env data in
  71           SM.add key data acc
  72         in
  73         SM.fold map_entry x SM.empty
  74   end