hphp/hack/src/typing/typing_alias.ml

   1 (**
   2  * Copyright (c) 2015, 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 (*****************************************************************************)
  12 (* Module determining how long the longest "aliasing chain" of a given
  13  * block is.
  14  *
  15  * The problem:
  16  *   The type-inference algorithm needs to find a fix point when dealing with
  17  *   loops.
  18  *
  19  * Normally, a fix-point should be reached after 2 iterations. However,
  20  * there are pathological cases where this is not true.
  21  * It happens when the code is aliasing locals, because the type of locals
  22  * can change, a 'chain' of aliases can delay the moment where we reach a
  23  * fix point.
  24  *
  25  * Example:
  26 *    // $x is an int
  27  *   $x = $y;
  28  *   $y = $z;
  29  *   $z = 'hello';
  30  *   // $x will only become an int after 3 iterations.
  31  *
  32  *)
  33 (*****************************************************************************)
  34
  35 open Hh_core
  36 open Nast
  37
  38 module Env = Typing_env
  39
  40 (*****************************************************************************)
  41 (* Module computing all the aliased locals.
  42  *
  43  * if one writes '$y = $z', then the binding $y => $z is added to the map.
  44  * Note that object/class members are counted are counted as locals
  45  * (conservatively), because in some cases, they can behave like locals (cf
  46  * Typing_env.FakeMembers).
  47  *)
  48 (*****************************************************************************)
  49
  50 module Dep = struct
  51
  52   let add x1 x2 acc =
  53     let prev = try SMap.find_unsafe x1 acc with Not_found -> [] in
  54     SMap.add x1 (x2 :: prev) acc
  55
  56   let get key acc =
  57     match SMap.get key acc with
  58     | None -> []
  59     | Some kl -> kl
  60
  61   let visitor local =
  62     object
  63       inherit [string list SMap.t] Nast.Visitor.visitor as parent
  64
  65       method! on_expr acc (_, e_ as e) =
  66         match e_ with
  67         | Lvar (_, x) ->
  68             add local (Local_id.to_string x) acc
  69         | Obj_get ((_, (This | Lvar _) as x), (_, Id (_, y)), _) ->
  70             add local (Env.FakeMembers.make_id x y) acc
  71         | Class_get (((), x), (_, y)) ->
  72             add local (Env.FakeMembers.make_static_id x y) acc
  73         | _ -> parent#on_expr acc e
  74     end
  75
  76   let expr local acc e = (visitor local)#on_expr acc e
  77
  78 end
  79
  80 module AliasMap: sig
  81
  82   type t = string list SMap.t
  83
  84   val get: string -> t -> string list
  85   val make: Nast.stmt -> t
  86
  87 end = struct
  88
  89   type t = string list SMap.t
  90
  91   let get = Dep.get
  92
  93   let local_to_string = function
  94     | Lvar (_, x) ->
  95         Some (Local_id.to_string x)
  96     | Obj_get ((_, (This | Lvar _) as x), (_, Id (_, y)), _) ->
  97         Some (Env.FakeMembers.make_id x y)
  98     | Class_get (((), x), (_, y)) ->
  99         Some (Env.FakeMembers.make_static_id x y)
 100     | _ -> None
 101
 102   let visitor =
 103     object(this)
 104       inherit [string list SMap.t] Nast.Visitor.visitor as parent
 105
 106       method! on_expr acc (_, e_ as e) =
 107         match e_ with
 108         | Binop (Ast.Eq _, (p, List el), x2) ->
 109             List.fold_left ~f:begin fun acc e ->
 110               this#on_expr acc (p, Binop (Ast.Eq None, e, x2))
 111             end ~init:acc el
 112         | Binop (Ast.Eq _, x1, x2) ->
 113             this#on_assign acc x1 x2
 114         | _ -> parent#on_expr acc e
 115
 116       method on_assign acc (_, e1) e2 =
 117         Option.value_map (local_to_string e1) ~f:begin fun s ->
 118           Dep.expr s acc e2
 119         end ~default:acc
 120
 121       method! on_efun acc _ _ = acc
 122     end
 123
 124   let make st = visitor#on_stmt SMap.empty st
 125
 126 end
 127
 128 (*****************************************************************************)
 129 (* Given an alias map, returns the length of the longest possible
 130  * 'aliasing chain'.
 131  *
 132  * Example:
 133  *   $x = $y;
 134  *   $y = $z;
 135  *   $z = 'hello';
 136  *
 137  * RESULT=3 because of the chain $x => $y => $z
 138  *)
 139 (*****************************************************************************)
 140
 141 module Depth: sig
 142   val get: AliasMap.t -> int
 143 end = struct
 144
 145   let rec fold aliases =
 146     SMap.fold begin fun k _ (visited, current_max) ->
 147       let visited, n = key aliases visited k in
 148       visited, max n current_max
 149     end aliases (SMap.empty, 0)
 150
 151   and key aliases visited k =
 152     if SMap.mem k visited
 153     then visited, SMap.find_unsafe k visited
 154     else
 155       let visited = SMap.add k 0 visited in
 156       let kl = AliasMap.get k aliases in
 157       let visited, depth_l = List.map_env visited kl (key aliases) in
 158       let my_depth = 1 + List.fold_left ~f:max ~init:0 depth_l in
 159       SMap.add k my_depth visited, my_depth
 160
 161   let get aliases = snd (fold aliases)
 162
 163 end
 164
 165 (*****************************************************************************)
 166 (* Entry point. *)
 167 (*****************************************************************************)
 168
 169 let get_depth st =
 170   let aliases = AliasMap.make st in
 171   let result  = Depth.get aliases in
 172   (* Needs to be at least 2 because of back edges. *)
 173   max 2 result