hphp/hack/src/typing/tast_check/shape_analysis_logger.ml

   1 (*
   2  * Copyright (c) Meta Platforms, Inc. and affiliates.
   3  *
   4  * This source code is licensed under the MIT license found in the
   5  * LICENSE file in the "hack" directory of this source tree.
   6  *
   7  *)
   8
   9 open Hh_prelude
  10 open Shape_analysis_types
  11 module A = Aast
  12 module SA = Shape_analysis
  13 module Env = Tast_env
  14
  15 let log_events_locally typing_env : log_event list -> unit =
  16   let log_shape = function
  17     | Result { id; shape_result } ->
  18       Format.sprintf
  19         "[RESULT] %s: %s\n"
  20         id
  21         (SA.show_shape_result typing_env shape_result)
  22       |> Out_channel.output_string !Typing_log.out_channel;
  23       Out_channel.flush !Typing_log.out_channel
  24     | Failure { id; error_message } ->
  25       Format.sprintf "[FAILURE] %s: %s\n" id error_message
  26       |> Out_channel.output_string !Typing_log.out_channel;
  27       Out_channel.flush !Typing_log.out_channel
  28   in
  29   List.iter ~f:log_shape
  30
  31 let log_events typing_env : log_event list -> unit =
  32   let shape_analysis_log_level =
  33     Typing_env.get_tcopt typing_env
  34     |> TypecheckerOptions.log_levels
  35     |> SMap.find_opt "shape_analysis"
  36   in
  37   match shape_analysis_log_level with
  38   | Some 1 -> log_events_locally typing_env
  39   | Some 2 -> Shape_analysis_scuba.log_events_remotely typing_env
  40   | _ -> Fn.const ()
  41
  42 let compute_results tast_env id params return body =
  43   let strip_decorations { constraint_; _ } = constraint_ in
  44   let typing_env = Tast_env.tast_env_as_typing_env tast_env in
  45   try
  46     SA.callable tast_env params ~return body
  47     |> List.map ~f:strip_decorations
  48     |> SA.simplify typing_env
  49     |> List.filter ~f:SA.is_shape_like_dict
  50     |> List.map ~f:(fun shape_result -> Result { id; shape_result })
  51   with
  52   | SA.Shape_analysis_exn error_message ->
  53     (* Logging failures is expensive because there are so many of them right
  54        now, to see all the shape results in a timely manner, simply don't log
  55        failure events. *)
  56     [Failure { id; error_message }]
  57
  58 let should_not_skip tast_env =
  59   let typing_env = Tast_env.tast_env_as_typing_env tast_env in
  60   not @@ Typing_env.is_hhi typing_env
  61
  62 let handler =
  63   object
  64     inherit Tast_visitor.handler_base
  65
  66     method! at_class_ tast_env A.{ c_methods; c_name = (_, class_name); _ } =
  67       let typing_env = Tast_env.tast_env_as_typing_env tast_env in
  68       let collect_method_events
  69           A.{ m_body; m_name = (_, method_name); m_params; m_ret; _ } =
  70         let id = class_name ^ "::" ^ method_name in
  71         compute_results tast_env id m_params m_ret m_body
  72       in
  73       if should_not_skip tast_env then
  74         List.concat_map ~f:collect_method_events c_methods
  75         |> log_events typing_env
  76
  77     method! at_fun_def tast_env fd =
  78       let A.{ f_body; f_name = (_, id); f_params; f_ret; _ } = fd.A.fd_fun in
  79       if should_not_skip tast_env then
  80         let typing_env = Tast_env.tast_env_as_typing_env tast_env in
  81         compute_results tast_env id f_params f_ret f_body
  82         |> log_events typing_env
  83   end