hphp/hack/src/naming/nast_pos_mapper.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 Nast
  12
  13 let rec expr f (p, e) =
  14   f p, expr_ f e
  15
  16 and expr_ f = function
  17   | Any -> Any
  18   | Array afl -> Array (List.map afl (afield f))
  19   | Darray fl -> Darray (List.map fl (fun (e1, e2) -> expr f e1, expr f e2))
  20   | Varray el -> Varray (List.map el (expr f))
  21   | Shape sh -> Shape (shape f sh)
  22   | True -> True
  23   | False -> False
  24   | Int n -> Int n
  25   | Float n -> Float n
  26   | Null -> Null
  27   | String s -> String s
  28   | This -> This
  29   | Id sid -> Id (pstring f sid)
  30   | Lplaceholder pos -> Lplaceholder (f pos)
  31   | Dollardollar (p, id) -> Dollardollar (f p, id)
  32   | Lvar (p, id) -> Lvar (f p, id)
  33   | ImmutableVar (p, id) -> ImmutableVar (f p, id)
  34   | Fun_id sid -> Fun_id (pstring f sid)
  35   | Method_id (e, pstr) -> Method_id (expr f e, pstring f pstr)
  36   | Method_caller (sid, pstr) -> Method_caller (pstring f sid, pstring f pstr)
  37   | Smethod_id (sid, pstr) -> Smethod_id (pstring f sid, pstring f pstr)
  38   | Yield_break -> Yield_break
  39   | Dollar e -> Dollar (expr f e)
  40   | Yield e -> Yield (afield f e)
  41   | Yield_from e -> Yield_from (expr f e)
  42   | Await e -> Await (expr f e)
  43   | Suspend e -> Suspend (expr f e)
  44   | List el -> List (List.map el (expr f))
  45   | Assert (AE_assert ae) -> Assert (AE_assert (expr f ae))
  46   | Clone e -> Clone (expr f e)
  47   | Expr_list el -> Expr_list (List.map el (expr f))
  48   | Special_func sf -> Special_func (special_func f sf)
  49   | Obj_get (e1, e2, x) -> Obj_get (expr f e1, expr f e2, x)
  50   | Array_get (e1, e2) -> Array_get (expr f e1, Option.map e2 (expr f))
  51   | Class_get (cid, id) -> Class_get (class_id f cid, pstring f id)
  52   | Class_const (cid, id) -> Class_const (class_id f cid, pstring f id)
  53   | Call (ct, e, hl, el, uel) ->
  54     Call (ct, expr f e, hl, List.map el (expr f), List.map uel (expr f))
  55   | String2 el -> String2 (List.map el (expr f))
  56   | PrefixedString (n, e) -> PrefixedString (n, (expr f e))
  57   | Pair (e1, e2) -> Pair (expr f e1, expr f e2)
  58   | Cast (h, e) -> Cast (hint f h, expr f e)
  59   | Unop (uop, e) -> Unop (uop, expr f e)
  60   | Binop (bop, e1, e2) -> Binop (bop, expr f e1, expr f e2)
  61   | Pipe ((p, id), e1, e2) -> Pipe ((f p, id), expr f e1, expr f e2)
  62   | Eif (e1, e2, e3) -> Eif (expr f e1, Option.map e2 (expr f), expr f e3)
  63   | InstanceOf (e1, e2) -> InstanceOf (expr f e1, class_id f e2)
  64   | Is (e, h) -> Is (expr f e, hint f h)
  65   | As (e, h, b) -> As (expr f e, hint f h, b)
  66   | Typename n -> Typename (pstring f n)
  67   | New (cid, el, uel, ctor_annot) ->
  68     New (class_id f cid, List.map el (expr f), List.map uel (expr f), ctor_annot)
  69   | Efun (fun_, idl) ->
  70     (* properly handling this would involve writing the mapper for all
  71      * statements *)
  72     Errors.internal_error (fst fun_.f_name)
  73       "Nast_pos_mapper cannot handle lambdas";
  74     Efun (fun_, idl)
  75   | Xml (sid, attrl, el) ->
  76     Xml (pstring f sid, attr_list f attrl, List.map el (expr f))
  77   | Unsafe_expr e -> Unsafe_expr (expr f e)
  78   | Callconv (kind, e) -> Callconv (kind, expr f e)
  79   | Execution_operator (e) -> Execution_operator (List.map e (expr f))
  80   | ValCollection (s, el) -> ValCollection (s, List.map el (expr f))
  81   | KeyValCollection (s, fl) ->
  82     KeyValCollection (s, List.map fl (fun (e1, e2) -> expr f e1, expr f e2))
  83   | Omitted -> Omitted
  84   | NewAnonClass (el1, el2, c) -> NewAnonClass (el1, el2, c)
  85
  86 and afield f = function
  87   | AFvalue e -> AFvalue (expr f e)
  88   | AFkvalue (e1, e2) ->
  89     let e1 : Nast.expr = expr f e1 in
  90     let e2 = expr f e2 in
  91     AFkvalue (e1, e2)
  92
  93 and shape f sm =
  94   List.fold_left
  95     ~f:begin fun acc (sf, e) ->
  96       let sf = shape_field f sf in
  97       let e = expr f e in
  98       (sf, e) :: acc
  99     end
 100     ~init:[]
 101     sm
 102   |> List.rev
 103
 104 and shape_field f = function
 105   | Ast.SFlit_int pstr -> Ast.SFlit_int (pstring f pstr)
 106   | Ast.SFlit_str pstr -> Ast.SFlit_str (pstring f pstr)
 107   | Ast.SFclass_const (sid, pstr) ->
 108     Ast.SFclass_const (pstring f sid, pstring f pstr)
 109
 110 and pstring f (p, s) =
 111   f p, s
 112
 113 and instantiated_sid f (sid, hl) =
 114   (pstring f sid, List.map hl (hint f))
 115
 116 and special_func f = function
 117   | Gena e -> Gena (expr f e)
 118   | Genva el -> Genva (List.map el (expr f))
 119   | Gen_array_rec e -> Gen_array_rec (expr f e)
 120
 121 and class_id f (pos, ci) = f pos, class_id_ f ci
 122
 123 and class_id_ f = function
 124   | CIparent -> CIparent
 125   | CIself -> CIself
 126   | CIstatic -> CIstatic
 127   | CIexpr e -> CIexpr (expr f e)
 128   | CI isid -> CI (instantiated_sid f isid)
 129
 130 and hint f (p, h) = f p, hint_ f h
 131
 132 and hint_ f = function
 133   | Hdynamic -> Hdynamic
 134   | Hany -> Hany
 135   | Hmixed -> Hmixed
 136   | Hnonnull -> Hnonnull
 137   | Hthis -> Hthis
 138   | Htuple hl -> Htuple (List.map hl (hint f))
 139   | Habstr s ->
 140     Habstr s
 141   | Harray (h1, h2) ->
 142     Harray (Option.map h1 (hint f), Option.map h2 (hint f))
 143   | Hdarray (h1, h2) ->
 144     Hdarray (hint f h1, hint f h2)
 145   | Hvarray h -> Hvarray (hint f h)
 146   | Hvarray_or_darray h -> Hvarray_or_darray (hint f h)
 147   | Hprim tprim -> Hprim tprim
 148   | Hoption h -> Hoption (hint f h)
 149   | Hfun (is_reactive, is_coroutine, hl, kl, m, b, h, rm) ->
 150     Hfun (is_reactive, is_coroutine, List.map hl (hint f), kl, m, b, hint f h, rm)
 151   | Happly (sid, hl) -> Happly (pstring f sid, List.map hl (hint f))
 152   | Hshape nast_shape_info ->
 153     let add_shape_field_info_to_shape_map sf shape_field_info acc =
 154       let map_over_shape_field_info ~f shape_field_info =
 155         { shape_field_info with sfi_hint=f shape_field_info.sfi_hint } in
 156       let sf = shape_field f sf in
 157       let h = hint f in
 158       let shape_field_info = map_over_shape_field_info ~f:h shape_field_info in
 159       ShapeMap.add sf shape_field_info acc in
 160
 161     let nsi_field_map =
 162       ShapeMap.fold
 163         add_shape_field_info_to_shape_map
 164         nast_shape_info.nsi_field_map
 165         ShapeMap.empty in
 166     Hshape { nast_shape_info with nsi_field_map }
 167   | Haccess (h, sids) -> Haccess (hint f h, List.map sids (pstring f))
 168
 169 and attr_list f attrl =
 170   List.map attrl begin fun attr -> match attr with
 171    | Xhp_simple (pstr, e) -> Xhp_simple (pstring f pstr, expr f e)
 172    | Xhp_spread e -> Xhp_spread (expr f e)
 173   end