hphp/hack/src/typing/typing_log.ml

   1 (**
   2  * Copyright (c) 2016, Facebook, Inc.
   3  * All rights reserved.
   4  *
   5  * This source code is licensed under the BSD-style license found in the
   6  * LICENSE file in the "hack" directory of this source tree. An additional grant
   7  * of patent rights can be found in the PATENTS file in the same directory.
   8  *
   9  *)
  10
  11 module Env = Typing_env
  12
  13 open Tty
  14
  15 (*****************************************************************************)
  16 (* Logging type inference environment                                        *)
  17 (*****************************************************************************)
  18
  19 (* Eventual input to Tty.cprint *)
  20 let logBuffer = ref []
  21 let indentLevel = ref 0
  22 let accumulatedLength = ref 0
  23 let lnewline () =
  24   match !logBuffer with
  25   | [] -> ()
  26   | _ ->
  27     begin
  28       cprint ~color_mode:Color_Auto
  29         ((Normal White, String.make (2 * !indentLevel) ' ') ::
  30            List.rev ((Normal White, "\n") :: !logBuffer));
  31        accumulatedLength := 0;
  32       logBuffer := []
  33     end
  34
  35 let lprintf c =
  36   Printf.ksprintf (fun s ->
  37     let len = String.length s in
  38     logBuffer := (c,s) :: !logBuffer;
  39     if !accumulatedLength + len > 80
  40     then lnewline ()
  41     else accumulatedLength := !accumulatedLength + len)
  42
  43 let indentEnv message f =
  44   lnewline ();
  45   lprintf (Normal Yellow) "%s" message;
  46   lnewline ();
  47   indentLevel := !indentLevel + 1;
  48   f ();
  49   lnewline ();
  50   indentLevel := !indentLevel - 1
  51
  52 (* Most recent environment. We only display diffs *)
  53 let lastenv =ref (Env.empty TypecheckerOptions.default
  54   Relative_path.default None)
  55 let iterations: int Pos.Map.t ref = ref Pos.Map.empty
  56
  57 (* Log all changes to subst *)
  58 let log_subst_diff oldSubst newSubst =
  59   indentEnv "subst(changes)" (fun () ->
  60   begin
  61     IMap.iter (fun n n' ->
  62       match IMap.get n oldSubst with
  63       | None ->
  64         begin
  65           lprintf (Bold Green) "#%d: " n;
  66           lprintf (Normal Green) "#%d; " n'
  67         end
  68       | Some n'' ->
  69         if n'=n''
  70         then ()
  71         else
  72           begin
  73             lprintf (Bold Green) "#%d: " n';
  74             lprintf (Normal Green) "#%d; " n'
  75           end
  76     ) newSubst;
  77     IMap.iter (fun n _n' ->
  78       if IMap.mem n newSubst then ()
  79       else lprintf (Normal Red) "#%d deleted; " n) oldSubst
  80   end)
  81
  82 (* Log all changes to tenv *)
  83 let log_tenv_diff oldEnv newEnv =
  84   indentEnv "tenv(changes)" (fun () ->
  85   begin
  86     IMap.iter (fun n t ->
  87       match IMap.get n oldEnv.Env.tenv with
  88       | None ->
  89         begin
  90           lprintf (Bold Green) "#%d: " n;
  91           lprintf (Normal Green) "%s; " (Typing_print.full newEnv t)
  92         end
  93       | Some t' ->
  94         if t=t'
  95         then ()
  96         else
  97           begin
  98             lprintf (Bold Green) "#%d: " n;
  99             lprintf (Normal Green) "%s; " (Typing_print.full newEnv t')
 100           end
 101     ) newEnv.Env.tenv;
 102     IMap.iter (fun n _ ->
 103       if IMap.mem n newEnv.Env.tenv then ()
 104       else lprintf (Normal Red) "#%d deleted; " n) oldEnv.Env.tenv
 105   end)
 106
 107 (* Dump the diff between oldEnv and newEnv. TODO: lenv component *)
 108 let log_env_diff oldEnv newEnv =
 109   begin
 110     log_subst_diff oldEnv.Env.subst newEnv.Env.subst;
 111     log_tenv_diff oldEnv newEnv;
 112     lnewline ()
 113   end
 114
 115 let rec log_type_list env tyl =
 116   match tyl with
 117     | [] -> ()
 118     | [ty] ->
 119       lprintf (Normal Green) "%s" (Typing_print.debug_with_tvars env ty)
 120     | ty::tyl ->
 121       lprintf (Normal Green) "%s, " (Typing_print.debug_with_tvars env ty);
 122       log_type_list env tyl
 123
 124 let log_local_types env =
 125   let lenv = env.Env.lenv in
 126   let local_types = lenv.Env.local_types in
 127   indentEnv "local_types" (fun () ->
 128     Local_id.Map.iter begin fun id (all_types, new_type, expr_id) ->
 129       lnewline();
 130       lprintf (Bold Green) "%s: " (Local_id.get_name id);
 131       lprintf (Normal Green) "%s" (Typing_print.debug_with_tvars env new_type);
 132       lprintf (Normal Green) " [history: ";
 133       log_type_list env all_types;
 134       lprintf (Normal Green) "] [eid: %s]" (Ident.debug expr_id) end
 135     local_types)
 136
 137 let log_tpenv env =
 138   let tparams = Env.get_generic_parameters env in
 139   if tparams != [] then
 140   indentEnv "tpenv" (fun () ->
 141     List.iter begin fun tparam ->
 142       let lower = Env.get_lower_bounds env tparam in
 143       let upper = Env.get_upper_bounds env tparam in
 144       lnewline ();
 145       (if lower != []
 146       then (log_type_list env lower; lprintf (Normal Green) " <: "));
 147       lprintf (Bold Green) "%s" tparam;
 148       (if upper != []
 149       then (lprintf (Normal Green) " <: "; log_type_list env upper))
 150         end tparams)
 151
 152 let log_fake_members env =
 153   let lenv = env.Env.lenv in
 154   let fakes = lenv.Env.fake_members in
 155   indentEnv "fake_members" (fun () ->
 156     (match fakes.Env.last_call with
 157     | None -> ()
 158     | Some p ->
 159       begin
 160         lprintf (Normal Green) "last_call: %s" (Pos.string (Pos.to_absolute p));
 161         lnewline ()
 162       end);
 163     lprintf (Normal Green) "invalid:";
 164     SSet.iter (lprintf (Normal Green) " %s") fakes.Env.invalid ;
 165     lnewline ();
 166     lprintf (Normal Green) "valid:";
 167     SSet.iter (lprintf (Normal Green) " %s") fakes.Env.valid;
 168     lnewline ())
 169
 170 let log_position p =
 171   let n =
 172     match Pos.Map.get p !iterations with
 173     | None -> iterations := Pos.Map.add p 1 !iterations; 1
 174     | Some n -> iterations := Pos.Map.add p (n+1) !iterations; n+1 in
 175   indentEnv (Pos.string (Pos.to_absolute p)
 176     ^ (if n = 1 then "" else "[" ^ string_of_int n ^ "]"))
 177
 178 (* Log the environment: local_types, subst, tenv and tpenv *)
 179 let hh_show_env p env =
 180   log_position p
 181     (fun () ->
 182        log_local_types env;
 183        log_fake_members env;
 184        log_env_diff (!lastenv) env;
 185        log_tpenv env);
 186   lastenv := env
 187
 188 (* Log the type of an expression *)
 189 let hh_show p env ty =
 190   let s = Typing_print.debug env ty in
 191   log_position p
 192     (fun () ->
 193        lprintf (Normal Green) "%s" s; lnewline ())