hphp/hack/src/typing/typing_try.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 [@@@warning "-33"] (* in OCaml 4.06.0, this can be inlined *)
  11 open Core_kernel
  12 open Common
  13 [@@@warning "+33"]
  14
  15 module C = Typing_continuations
  16 module CMap = C.Map
  17 module LEnv = Typing_lenv
  18 module LEnvC = Typing_lenv_cont
  19
  20 (* See the type system specs for try for what's going on here *)
  21
  22 let get_cont_cont cont_cont_map cont1 cont2 =
  23   match CMap.get cont1 cont_cont_map with
  24   | None -> None
  25   | Some cont_map -> CMap.get cont2 cont_map
  26
  27 let make_new_cont locals_map env cont =
  28   match cont with
  29   | C.Next -> env, get_cont_cont locals_map C.Finally C.Next
  30   | _ ->
  31     let ctx_cont_cont = get_cont_cont locals_map cont cont in
  32     let ctxs_x_cont = CMap.map (CMap.get cont) locals_map in
  33     let union env _key = LEnv.union_contextopts env in
  34     CMap.fold_env env union ctxs_x_cont ctx_cont_cont
  35
  36 let finally_merge env locals_map =
  37   let make_and_add_new_cont env locals cont =
  38     let env, ctxopt = make_new_cont locals_map env cont in
  39     env, LEnvC.replace_cont cont ctxopt locals in
  40   List.fold_left_env env ~f:make_and_add_new_cont C.all ~init:CMap.empty