hphp/hack/src/typing/typing_get_locals.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 open Ast
  12 open Core
  13 open Utils
  14
  15 module FuncTerm = Typing_func_terminality
  16
  17 (* Module calculating the locals for a statement
  18  * This is useful when someone uses $x on both sides
  19  * of an If statement, for example:
  20  * if(true) {
  21  *   $x = 0;
  22  * } else {
  23  *   $x = 1;
  24  * }
  25  *)
  26
  27 (* TODO It really sucks that this and Nast_terminality.Terminal are very
  28  * slightly different (notably, this version is somewhat buggier). Fixing that
  29  * exposes a lot of errors in www unfortunately -- we should bite the bullet on
  30  * fixing switch all the way when we do that, most likely though -- see tasks
  31  * #3140431 and #2813555. *)
  32 let rec terminal tcopt nsenv ~in_try stl =
  33   List.iter stl (terminal_ tcopt nsenv ~in_try)
  34
  35 and terminal_ tcopt nsenv ~in_try = function
  36   | Throw _ when not in_try -> raise Exit
  37   | Throw _ -> ()
  38   | Continue _
  39   | Expr (_, (Call ((_, Id (_, "assert")), [_, False], [])
  40                  | Call ((_, Id (_, "invariant")), (_, False) :: _ :: _, [])))
  41   | Return _ -> raise Exit
  42   | Expr (_, Call ((_, Id fun_id), _, _)) ->
  43     let _, fun_name = Namespaces.elaborate_id nsenv NSFun fun_id in
  44     FuncTerm.(raise_exit_if_terminal (get_fun tcopt fun_name))
  45   | Expr (_, Call ((_, Class_const (cls_id, (_, meth_name))), _, _))
  46     when (snd cls_id).[0] <> '$' ->
  47     let _, cls_name = Namespaces.elaborate_id nsenv NSClass cls_id in
  48     FuncTerm.(raise_exit_if_terminal
  49       (get_static_meth tcopt cls_name meth_name))
  50   | If (_, b1, b2) ->
  51     (try terminal tcopt nsenv ~in_try b1; () with Exit ->
  52       terminal tcopt nsenv ~in_try b2)
  53   | Switch (_, cl) ->
  54     terminal_cl tcopt nsenv ~in_try cl
  55   | Block b -> terminal tcopt nsenv ~in_try b
  56   | Try (b, catch_l, _fb) ->
  57     (* return is not allowed in finally, so we can ignore fb *)
  58     (terminal tcopt nsenv ~in_try:true b;
  59      List.iter catch_l (terminal_catch tcopt nsenv ~in_try))
  60   | Do _
  61   | While _
  62   | For _
  63   | Foreach _
  64   | Noop
  65   | Expr _
  66   | Unsafe
  67   | Fallthrough
  68   | Break _ (* TODO this is terminal sometimes too, except switch, see above. *)
  69   | GotoLabel _
  70   | Static_var _ -> ()
  71
  72 and terminal_catch tcopt nsenv ~in_try (_, _, b) =
  73   terminal tcopt nsenv ~in_try b
  74
  75 and terminal_cl tcopt nsenv ~in_try = function
  76   | [] -> raise Exit
  77   | Case (_, b) :: rl ->
  78     (try
  79       terminal tcopt nsenv ~in_try b;
  80       if blockHasBreak b
  81       then ()
  82       else raise Exit
  83     with Exit -> terminal_cl tcopt nsenv ~in_try rl)
  84   | Default b :: rl ->
  85     begin try terminal tcopt nsenv ~in_try b with
  86       | Exit ->
  87         terminal_cl tcopt nsenv ~in_try rl
  88     end
  89
  90 and blockHasBreak = function
  91   | [] -> false
  92   | Break _ :: _ -> true
  93   | x :: xs ->
  94     let x' =
  95       match x with
  96       | If (_, [], []) -> false
  97       | If (_, b, []) | If (_, [], b) -> blockHasBreak b
  98       | If (_, b1, b2) -> blockHasBreak b1 && blockHasBreak b2
  99       | _ -> false
 100     in
 101     x' || blockHasBreak xs
 102
 103 let is_terminal tcopt nsenv stl =
 104   try terminal tcopt nsenv ~in_try:false stl; false
 105   with Exit -> true
 106
 107 let smap_union ((nsenv:Namespace_env.env), (m1:Pos.t SMap.t))
 108     (m2:Pos.t SMap.t) =
 109   let m_combined = SMap.fold SMap.add m1 m2 in
 110   nsenv, m_combined
 111
 112 let rec lvalue tcopt (acc:(Namespace_env.env * Pos.t SMap.t)) = function
 113   | (p, Lvar (_, x)) ->
 114     let nsenv, m = acc in
 115     nsenv, SMap.add x p m
 116   | _, List lv -> List.fold_left lv ~init:acc ~f:(lvalue tcopt)
 117   (* Ref forms a local inside a foreach *)
 118   | (_, Unop (Uref, (p, Lvar (_, x)))) ->
 119     let nsenv, m = acc in
 120     nsenv, SMap.add x p m
 121   | _ -> acc
 122
 123 let rec stmt tcopt (acc:(Namespace_env.env * Pos.t SMap.t)) st =
 124   let nsenv = fst acc in
 125   match st with
 126   | Expr (_, Binop (Eq None, lv, rv))
 127   | Expr (_, Eif ((_, Binop (Eq None, lv, rv)), _, _)) ->
 128     let acc = stmt tcopt acc (Expr rv) in
 129     lvalue tcopt acc lv
 130   | Unsafe
 131   | Fallthrough
 132   | Expr _ | Break _ | Continue _ | Throw _
 133   | Do _ | While _ | For _ | Foreach _
 134   | Return _ | GotoLabel _ | Static_var _ | Noop -> acc
 135   | Block b -> block tcopt acc b
 136   | If (_, b1, b2) ->
 137     let term1 = is_terminal tcopt nsenv b1 in
 138     let term2 = is_terminal tcopt nsenv b2 in
 139     if term1 && term2
 140     then acc
 141     else if term1
 142     then
 143       let _, m2 = block tcopt (nsenv, SMap.empty) b2 in
 144       smap_union acc m2
 145     else if term2
 146     then
 147       let _, m1 = block tcopt (nsenv, SMap.empty) b1 in
 148       smap_union acc m1
 149     else begin
 150       let _, m1 = block tcopt (nsenv, SMap.empty) b1 in
 151       let _, m2 = block tcopt (nsenv, SMap.empty) b2 in
 152       let (m:Pos.t SMap.t) = (smap_inter m1 m2) in
 153       smap_union acc m
 154     end
 155   | Switch (_e, cl) ->
 156     let cl = List.filter cl begin function
 157       | Case (_, b)
 158       | Default b -> not (is_terminal tcopt nsenv b)
 159     end in
 160     let cl = casel tcopt nsenv cl in
 161     let c = smap_inter_list cl in
 162     smap_union acc c
 163   | Try (b, cl, _fb) ->
 164     let _, c = block tcopt (nsenv, SMap.empty) b in
 165     let cl = List.filter cl begin fun (_, _, b) ->
 166       not (is_terminal tcopt nsenv b)
 167     end in
 168     let lcl = List.map cl (catch tcopt nsenv) in
 169     let c = smap_inter_list (c :: lcl) in
 170     smap_union acc c
 171
 172 and block tcopt acc l = List.fold_left l ~init:acc ~f:(stmt tcopt)
 173
 174 and casel tcopt nsenv = function
 175   | [] -> []
 176   | Case (_, []) :: rl -> casel tcopt nsenv rl
 177   | Default b :: rl
 178   | Case (_, b) :: rl ->
 179       let _, b = block tcopt (nsenv, SMap.empty) b in
 180       b :: casel tcopt nsenv rl
 181
 182 and catch tcopt nsenv (_, _, b) =
 183   snd (block tcopt (nsenv, SMap.empty) b)