hphp/hack/src/typing/tast_type_collector.ml

   1 (**
   2  * Copyright (c) 2018, 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 Hh_core
  11
  12 type collected_type = Tast_env.env * Typing_defs.phase_ty [@@deriving show]
  13
  14 let type_collector = object
  15   inherit [_] Tast_visitor.reduce
  16   method zero = Pos.AbsolutePosMap.empty
  17   method plus = Pos.AbsolutePosMap.union ~combine:(fun _ a b -> Some (a @ b))
  18   method! on_expr_annotation env (p,ty) =
  19     Pos.AbsolutePosMap.singleton
  20       (Pos.to_absolute p)
  21       [(env, Typing_defs.LoclTy ty)]
  22
  23   method! on_class_id env (ty,cid) =
  24     match cid with
  25     | Tast.CI ((p,_),_) ->
  26       Pos.AbsolutePosMap.singleton
  27         (Pos.to_absolute p)
  28         [(env, Typing_defs.LoclTy ty)]
  29     | _ -> Pos.AbsolutePosMap.empty
  30
  31   method! on_hint (env: Tast_env.t) hint =
  32     let (pos, _) = hint in
  33     let ty = Tast_env.hint_to_ty env hint in
  34     Pos.AbsolutePosMap.singleton
  35       (Pos.to_absolute pos)
  36       [(env, Typing_defs.DeclTy ty)]
  37 end
  38
  39 let collect_types tast =
  40   Errors.ignore_ (fun () -> type_collector#go tast)
  41
  42 let collected_types_to_json
  43   (collected_types: collected_type list)
  44   : Hh_json.json list =
  45   List.map collected_types ~f:(fun (env, ty) ->
  46     match ty with
  47     | Typing_defs.DeclTy ty -> Tast_env.ty_to_json env ty
  48     | Typing_defs.LoclTy ty -> Tast_env.ty_to_json env ty
  49   )
  50
  51 (*
  52   Ideally this would be just Pos.AbsolutePosMap.get, however the positions
  53   in the Tast are off by 1 from positions in the full fidelity parse trees.
  54
  55   TODO: Fix this when the full fidelity parse tree becomes the parser for type checking.
  56 *)
  57 let get_from_pos_map
  58     (position: Pos.absolute)
  59     (map: collected_type list Pos.AbsolutePosMap.t) =
  60   let rec aux es =
  61     match es with
  62     | [] -> []
  63     | (pos, tys) :: tl ->
  64         if ((Pos.start_cnum pos) = (Pos.start_cnum position)
  65             && (Pos.end_cnum pos) = (1 + (Pos.end_cnum position))) then
  66           tys
  67         else
  68           aux tl
  69   in
  70   let elements = Pos.AbsolutePosMap.elements map in
  71   aux elements