hphp/hack/src/hhbc/emit_body.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 Core
  11 open Hhbc_ast
  12 open Instruction_sequence
  13 open Emit_type_hint
  14
  15 let has_type_constraint ti =
  16   match ti with
  17   | Some ti when (Hhas_type_info.has_type_constraint ti) -> true
  18   | _ -> false
  19
  20 let emit_method_prolog params =
  21   gather (List.filter_map params (fun p ->
  22     let param_type_info = Hhas_param.type_info p in
  23     let param_name = Hhas_param.name p in
  24     if has_type_constraint param_type_info
  25     then Some (instr (IMisc (VerifyParamType (Param_named param_name))))
  26     else None))
  27
  28 let tparams_to_strings tparams =
  29   List.map tparams (fun (_, (_, s), _) -> s)
  30
  31 let verify_returns body =
  32   let rewriter i =
  33     match i with
  34     | IContFlow RetC ->
  35       [ (IMisc VerifyRetTypeC); (IContFlow RetC) ]
  36     | _ -> [ i ] in
  37   InstrSeq.flat_map body ~f:rewriter
  38
  39 let from_ast ~self tparams params ret b =
  40   let tparams = tparams_to_strings tparams in
  41   Label.reset_label ();
  42   Local.reset_local ();
  43   Iterator.reset_iterator ();
  44   Emit_expression.set_self self;
  45   let params = Emit_param.from_asts tparams params in
  46   let return_type_info =
  47     match ret with
  48     | None ->
  49       Some (Hhas_type_info.make (Some "") (Hhas_type_constraint.make None []))
  50     | Some h -> Some (hint_to_type_info ~always_extended:true tparams h) in
  51   let stmt_instrs = Emit_statement.from_stmts b in
  52   let stmt_instrs =
  53     if has_type_constraint return_type_info then
  54       verify_returns stmt_instrs
  55     else
  56       stmt_instrs in
  57   let ret_instrs =
  58     match List.last b with Some (A.Return _) -> empty | _ ->
  59     gather [instr_null; instr_retc]
  60   in
  61   let fault_instrs = extract_fault_instructions stmt_instrs in
  62   let begin_label, default_value_setters =
  63     Emit_param.emit_param_default_value_setter params
  64   in
  65   let (is_generator, is_pair_generator) = is_function_generator stmt_instrs in
  66   let generator_instr =
  67     if is_generator then gather [instr_createcont; instr_popc] else empty
  68   in
  69   let body_instrs = gather [
  70     begin_label;
  71     emit_method_prolog params;
  72     generator_instr;
  73     stmt_instrs;
  74     ret_instrs;
  75     default_value_setters;
  76     fault_instrs;
  77   ] in
  78   let params, body_instrs =
  79     Label_rewriter.relabel_function params body_instrs in
  80   let function_decl_vars = extract_decl_vars params body_instrs in
  81   let body_instrs = Local_id_rewriter.unname_instrseq
  82     (List.map params Hhas_param.name @ function_decl_vars)
  83     body_instrs
  84   in
  85   body_instrs,
  86   function_decl_vars,
  87   params,
  88   return_type_info,
  89   is_generator,
  90   is_pair_generator