hphp/hack/src/hhbc/emit_inout_helpers.ml

   1 (**
   2  * Copyright (c) 2017, 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 open Instruction_sequence
  11 open Hh_core
  12
  13 module H = Hhbc_ast
  14
  15 type wrapper_type = InoutWrapper | RefWrapper
  16
  17 let extract_inout_or_ref_param_locations ~is_closure_or_func params =
  18   let inout_param_locations = List.filter_mapi params
  19     ~f:(fun i p -> if p.Ast.param_callconv <> Some Ast.Pinout
  20                    then None else Some i) in
  21   if List.length inout_param_locations <> 0 then
  22     Some InoutWrapper, inout_param_locations
  23   else
  24     let module O = Hhbc_options in
  25     let need_wrapper =
  26       O.create_inout_wrapper_functions !O.compiler_options
  27       && (Emit_env.is_hh_syntax_enabled ())
  28       && (O.reffiness_invariance !O.compiler_options || is_closure_or_func) in
  29     let l =
  30       if need_wrapper
  31       then List.filter_mapi params ~f:(fun i p -> Option.some_if p.Ast.param_is_reference i)
  32       else [] in
  33     if List.is_empty l then None, []
  34     else Some RefWrapper, l
  35
  36 let inout_suffix param_location =
  37   let param_location = List.map ~f:string_of_int param_location in
  38   "$"
  39   ^ (String.concat ";" param_location)
  40   ^ "$inout"
  41
  42 let emit_set_instrs ?(is_last=false) opt_base (index, set_instrs) =
  43   let index = if is_last then 0 else index in
  44   gather [
  45     set_instrs;
  46     instr_popc;
  47     match opt_base with
  48     | Some base ->
  49       gather [
  50         instr_basel base H.MemberOpMode.Warn;
  51         instr_querym 0 H.QueryOp.CGet (H.MemberKey.EI (Int64.of_int index))
  52       ]
  53     | None -> empty
  54   ]
  55
  56 let emit_list_set_for_inout_call local inout_params = Local.scope @@ fun () ->
  57   if List.length inout_params = 0 then empty else
  58   let inout_params = List.mapi ~f:(fun i p -> (i + 2, p)) inout_params in
  59   (* We know that this is safe since there must be at least 1 inout param *)
  60   let all_but_last, last =
  61     List.split_n inout_params (List.length inout_params - 1) in
  62   let last = List.hd_exn last in
  63   let msrv =
  64     Hhbc_options.use_msrv_for_inout !Hhbc_options.compiler_options in
  65   match msrv with
  66   | false ->
  67     let try_body =
  68       gather [
  69         emit_set_instrs (Some local) (1, instr_setl local);
  70         gather @@ List.map all_but_last ~f:(emit_set_instrs (Some local));
  71         emit_set_instrs ~is_last:true (Some local) last
  72       ]
  73     in
  74     let unset_instr = instr_unsetl local in
  75     let f_label = Label.next_fault () in
  76     let fault_body = gather [ unset_instr; instr_unwind ] in
  77     gather [
  78       instr_try_fault f_label try_body fault_body;
  79       unset_instr
  80     ]
  81   | true ->
  82     gather [
  83       instr_setl local;
  84       instr_popc;
  85       gather @@ List.map all_but_last ~f:(emit_set_instrs None);
  86       emit_set_instrs ~is_last:true None last;
  87       instr_pushl local
  88     ]