hphp/hack/src/hhbc/emit_statement.ml

   1 (*
   2  * Copyright (c) 2017, Facebook, Inc.
   3  * All rights reserved.
   4  *
   5  * This source code is licensed under the MIT license found in the
   6  * LICENSE file in the "hack" directory of this source tree.
   7  *
   8  *)
   9
  10 open Core_kernel
  11 open Hhbc_ast
  12 open Instruction_sequence
  13 open Emit_expression
  14 open Emit_pos
  15 module A = Aast
  16 module TC = Hhas_type_constraint
  17 module SN = Naming_special_names
  18 module TFR = Try_finally_rewriter
  19 module JT = Jump_targets
  20 module Opts = Hhbc_options
  21
  22 (* Context for code generation. It would be more elegant to pass this
  23  * around in an environment parameter. *)
  24 let verify_return : Aast.hint option ref = ref None
  25
  26 let default_return_value = ref instr_null
  27
  28 let default_dropthrough = ref None
  29
  30 let verify_out = ref empty
  31
  32 let num_out = ref 0
  33
  34 let function_pos = ref Pos.none
  35
  36 let set_num_out c = num_out := c
  37
  38 let set_verify_return b = verify_return := b
  39
  40 let set_default_return_value i = default_return_value := i
  41
  42 let set_default_dropthrough i = default_dropthrough := i
  43
  44 let set_verify_out i = verify_out := i
  45
  46 let set_function_pos p = function_pos := p
  47
  48 let emit_return (env : Emit_env.t) =
  49   TFR.emit_return
  50     ~verify_return:!verify_return
  51     ~verify_out:!verify_out
  52     ~num_out:!num_out
  53     ~in_finally_epilogue:false
  54     env
  55
  56 let emit_def_inline def =
  57   match def with
  58   | A.Class cd ->
  59     let defcls_fn =
  60       if Emit_env.is_systemlib () then
  61         instr_defclsnop
  62       else
  63         instr_defcls
  64     in
  65     Emit_pos.emit_pos_then (fst cd.A.c_name)
  66     @@ defcls_fn (int_of_string (snd cd.A.c_name))
  67   | A.Typedef td ->
  68     Emit_pos.emit_pos_then (fst td.A.t_name)
  69     @@ instr_deftypealias (int_of_string (snd td.A.t_name))
  70   | A.RecordDef rd ->
  71     Emit_pos.emit_pos_then (fst rd.A.rd_name)
  72     @@ instr_defrecord (int_of_string (snd rd.A.rd_name))
  73   | _ -> failwith "Define inline: Invalid inline definition"
  74
  75 let emit_markup env s echo_expr_opt ~check_for_hashbang =
  76   let emit_ignored_call_expr f e =
  77     let p = Pos.none in
  78     let call_expr =
  79       Tast_annotate.make
  80         (A.Call (Aast.Cnormal, Tast_annotate.make (A.Id (p, f)), [], [e], None))
  81     in
  82     emit_ignored_expr env call_expr
  83   in
  84   let emit_ignored_call_for_non_empty_string f s =
  85     if String.length s = 0 then
  86       empty
  87     else
  88       emit_ignored_call_expr f (Tast_annotate.make (A.String s))
  89   in
  90   let markup =
  91     if String.length s = 0 then
  92       empty
  93     else
  94       let tail =
  95         if check_for_hashbang then
  96           (* if markup text starts with #!
  97           - extract a line with hashbang - it will be emitted as a call
  98           to print_hashbang function
  99           - emit remaining part of text as regular markup *)
 100           let r = Str.regexp "^#!.*\n" in
 101           if Str.string_match r s 0 then
 102             let cmd = Str.matched_string s in
 103             String_utils.lstrip s cmd
 104           else
 105             s
 106         else
 107           s
 108       in
 109       emit_ignored_call_for_non_empty_string SN.SpecialFunctions.echo tail
 110   in
 111   let echo =
 112     match echo_expr_opt with
 113     | Some e -> emit_ignored_call_expr SN.SpecialFunctions.echo e
 114     | None -> empty
 115   in
 116   gather [markup; echo]
 117
 118 let get_level p op e =
 119   match A.get_break_continue_level e with
 120   | A.Level_ok (Some i) -> i
 121   | A.Level_ok None -> 1
 122   | A.Level_non_positive ->
 123     Emit_fatal.raise_fatal_parse
 124       p
 125       ("'" ^ op ^ "' operator accepts only positive numbers")
 126   | A.Level_non_literal ->
 127     Emit_fatal.raise_fatal_parse
 128       p
 129       ("'" ^ op ^ "' with non-constant operand is not supported")
 130
 131 let rec set_bytes_kind name =
 132   let re =
 133     Str.regexp_case_fold
 134       "^hh\\\\set_bytes\\(_rev\\|\\)_\\([a-z0-9]+\\)\\(_vec\\|\\)$"
 135   in
 136   if Str.string_match re name 0 then
 137     let op =
 138       if Str.matched_group 1 name = "_rev" then
 139         Reverse
 140       else
 141         Forward
 142     in
 143     let size = Str.matched_group 2 name in
 144     let is_vec = Str.matched_group 3 name = "_vec" in
 145     match (size, is_vec) with
 146     | ("string", false) -> Some (op, 1, true)
 147     | ("bool", _)
 148     | ("int8", _) ->
 149       Some (op, 1, is_vec)
 150     | ("int16", _) -> Some (op, 2, is_vec)
 151     | ("int32", _)
 152     | ("float32", _) ->
 153       Some (op, 4, is_vec)
 154     | ("int64", _)
 155     | ("float64", _) ->
 156       Some (op, 8, is_vec)
 157     | _ -> None
 158   else
 159     None
 160
 161 and emit_stmt env (pos, stmt) =
 162   match stmt with
 163   | A.Expr (_, A.Yield_break) -> gather [instr_null; emit_return env]
 164   | A.Expr (((pos, _), A.Call (_, (_, A.Id (_, s)), _, exprl, None)) as expr) ->
 165     let s = Hhbc_id.Function.(from_ast_name s |> to_raw_string) in
 166     if String.lowercase s = "unset" then
 167       gather (List.map exprl (emit_unset_expr env))
 168     else (
 169       match set_bytes_kind s with
 170       | Some kind ->
 171         let exprl =
 172           match exprl with
 173           | (_, A.Callconv (Ast_defs.Pinout, e)) :: t -> e :: t
 174           | _ -> exprl
 175         in
 176         emit_set_range_expr env pos s kind exprl
 177       | None -> emit_ignored_expr ~pop_pos:pos env expr
 178     )
 179   | A.Return (Some ((inner_pos, _), A.Await e)) ->
 180     gather [emit_await env inner_pos e; Emit_pos.emit_pos pos; emit_return env]
 181   | A.Return (Some (_, A.Yield_from e)) ->
 182     gather
 183       [
 184         emit_yield_from_delegates env pos e;
 185         Emit_pos.emit_pos pos;
 186         emit_return env;
 187       ]
 188   | A.Expr (ann, A.Await e) -> gather [emit_await env (fst ann) e; instr_popc]
 189   | A.Expr
 190       ( _,
 191         A.Binop
 192           ( Ast_defs.Eq None,
 193             ((_, A.List l) as e1),
 194             ((await_pos, _), A.Await e_await) ) ) ->
 195     let awaited_instrs = emit_await env await_pos e_await in
 196     let has_elements =
 197       List.exists l ~f:(function
 198           | (_, A.Omitted) -> false
 199           | _ -> true)
 200     in
 201     if has_elements then
 202       Scope.with_unnamed_local @@ fun temp ->
 203       (* before *)
 204       ( gather [awaited_instrs; instr_popl temp],
 205         (* inner *)
 206         of_pair @@ emit_lval_op_list env pos (Some temp) [] e1,
 207         (* after *)
 208         instr_unsetl temp )
 209     else
 210       gather [awaited_instrs; instr_popc]
 211   | A.Expr
 212       (_, A.Binop (Ast_defs.Eq None, e_lhs, ((await_pos, _), A.Await e_await)))
 213     ->
 214     emit_await_assignment env await_pos e_lhs e_await
 215   | A.Expr (_, A.Yield_from e) ->
 216     gather [emit_yield_from_delegates env pos e; emit_pos pos; instr_popc]
 217   | A.Expr ((pos, _), A.Binop (Ast_defs.Eq None, e_lhs, (_, A.Yield_from e))) ->
 218     Local.scope @@ fun () ->
 219     let temp = Local.get_unnamed_local () in
 220     let rhs_instrs = instr_pushl temp in
 221     gather
 222       [
 223         emit_yield_from_delegates env pos e;
 224         instr_setl temp;
 225         instr_popc;
 226         emit_lval_op_nonlist env pos LValOp.Set e_lhs rhs_instrs 1;
 227         instr_popc;
 228       ]
 229   | A.Expr expr -> emit_ignored_expr ~pop_pos:pos env expr
 230   | A.Return None -> gather [instr_null; Emit_pos.emit_pos pos; emit_return env]
 231   | A.Return (Some expr) ->
 232     gather [emit_expr env expr; Emit_pos.emit_pos pos; emit_return env]
 233   | A.GotoLabel (_, label) -> instr_label (Label.named label)
 234   | A.Goto (_, label) -> TFR.emit_goto ~in_finally_epilogue:false env label
 235   | A.Block b -> emit_stmts env b
 236   | A.If (condition, consequence, alternative) ->
 237     emit_if env pos condition consequence alternative
 238   | A.While (e, b) -> emit_while env e (pos, A.Block b)
 239   | A.Using
 240       A.
 241         {
 242           us_has_await = has_await;
 243           us_expr = e;
 244           us_block = b;
 245           us_is_block_scoped = is_block_scoped;
 246         } ->
 247     emit_using env pos is_block_scoped has_await e (block_pos b, A.Block b)
 248   | A.Break -> emit_break env pos
 249   | A.Continue -> emit_continue env pos
 250   | A.Do (b, e) -> emit_do env (pos, A.Block b) e
 251   | A.For (e1, e2, e3, b) -> emit_for env pos e1 e2 e3 (pos, A.Block b)
 252   | A.Throw ((_, _) as expr) ->
 253     gather [emit_expr env expr; Emit_pos.emit_pos pos; instr (IContFlow Throw)]
 254   | A.Try (try_block, catch_list, finally_block) ->
 255     if JT.get_function_has_goto () then
 256       TFR.fail_if_goto_from_try_to_finally try_block finally_block;
 257
 258     (* TFR.fail_if_goto_from_try_to_finally try_block finally_block;*)
 259     if catch_list <> [] && finally_block <> [] then
 260       emit_stmt
 261         env
 262         ( pos,
 263           A.Try ([(pos, A.Try (try_block, catch_list, []))], [], finally_block)
 264         )
 265     else if catch_list <> [] then
 266       emit_try_catch env (pos, A.Block try_block) catch_list
 267     else
 268       emit_try_finally
 269         env
 270         pos
 271         (pos, A.Block try_block)
 272         (pos, A.Block finally_block)
 273   | A.Switch (e, cl) -> emit_switch env pos e cl
 274   | A.Foreach (collection, iterator, block) ->
 275     emit_foreach env pos collection iterator (pos, A.Block block)
 276   | A.Def_inline def -> emit_def_inline def
 277   | A.Awaitall (el, b) -> emit_awaitall env pos el b
 278   | A.Markup ((_, s), echo_expr_opt) ->
 279     emit_markup env s echo_expr_opt ~check_for_hashbang:false
 280   | A.Fallthrough
 281   | A.Noop ->
 282     empty
 283
 284 and emit_break env pos =
 285   TFR.emit_break_or_continue ~is_break:true ~in_finally_epilogue:false env pos 1
 286
 287 and emit_continue env pos =
 288   TFR.emit_break_or_continue
 289     ~is_break:false
 290     ~in_finally_epilogue:false
 291     env
 292     pos
 293     1
 294
 295 and emit_temp_break env pos level =
 296   TFR.emit_break_or_continue
 297     ~is_break:true
 298     ~in_finally_epilogue:false
 299     env
 300     pos
 301     level
 302
 303 and emit_temp_continue env pos level =
 304   TFR.emit_break_or_continue
 305     ~is_break:false
 306     ~in_finally_epilogue:false
 307     env
 308     pos
 309     level
 310
 311 and get_instrs r = r.Emit_expression.instrs
 312
 313 and emit_if env pos condition consequence alternative =
 314   match alternative with
 315   | []
 316   | [(_, A.Noop)] ->
 317     let done_label = Label.next_regular () in
 318     gather
 319       [
 320         get_instrs @@ emit_jmpz env condition done_label;
 321         emit_stmts env consequence;
 322         instr_label done_label;
 323       ]
 324   | _ ->
 325     let alternative_label = Label.next_regular () in
 326     let done_label = Label.next_regular () in
 327     let consequence_instr = emit_stmts env consequence in
 328     let alternative_instr = emit_stmts env alternative in
 329     gather
 330       [
 331         get_instrs @@ emit_jmpz env condition alternative_label;
 332         consequence_instr;
 333         emit_pos pos;
 334         instr_jmp done_label;
 335         instr_label alternative_label;
 336         alternative_instr;
 337         instr_label done_label;
 338       ]
 339
 340 and emit_await_assignment env pos lval e =
 341   match snd lval with
 342   | A.Lvar id when not (is_local_this env (snd id)) ->
 343     gather
 344       [
 345         emit_await env pos e;
 346         emit_pos pos;
 347         instr_popl (get_local env (pos, Local_id.get_name (snd id)));
 348       ]
 349   | _ ->
 350     let awaited_instrs = emit_await env pos e in
 351     Scope.with_unnamed_local @@ fun temp ->
 352     let rhs_instrs = instr_pushl temp in
 353     let (lhs, rhs, setop) =
 354       emit_lval_op_nonlist_steps env pos LValOp.Set lval rhs_instrs 1
 355     in
 356     (* before *)
 357     ( gather [awaited_instrs; instr_popl temp],
 358       (* inner *)
 359       lhs,
 360       (* after *)
 361       gather [rhs; setop; instr_popc] )
 362
 363 and emit_awaitall env pos el b =
 364   match el with
 365   | [] -> empty
 366   | [(lvar, e)] -> emit_awaitall_single env pos lvar e b
 367   | _ -> emit_awaitall_multi env el b
 368
 369 and emit_awaitall_single env pos lval e b =
 370   Scope.with_unnamed_locals @@ fun () ->
 371   let load_arg = emit_await env pos e in
 372   let (load, unset) =
 373     match lval with
 374     | Some (_, str) ->
 375       let l = Local.init_unnamed_local_for_tempname (Local_id.get_name str) in
 376       (instr_popl l, instr_unsetl l)
 377     | None -> (instr_popc, empty)
 378   in
 379   (* before *)
 380   (gather [load_arg; load], (* inner *)
 381                             emit_stmts env b, (* after *)
 382                                               unset)
 383
 384 and emit_awaitall_multi env el b =
 385   Scope.with_unnamed_locals @@ fun () ->
 386   let load_args =
 387     gather @@ List.map el ~f:(fun (_, arg) -> emit_expr env arg)
 388   in
 389   let locals =
 390     List.map el ~f:(fun (lvar, _) ->
 391         match lvar with
 392         | None -> Local.get_unnamed_local ()
 393         | Some (_, str) ->
 394           Local.init_unnamed_local_for_tempname (Local_id.get_name str))
 395   in
 396   let init_locals = gather @@ List.rev_map locals ~f:instr_popl in
 397   let await_all = gather [instr_awaitall_list locals; instr_popc] in
 398   let unpack =
 399     gather
 400     @@ List.map locals ~f:(fun l ->
 401            let label_done = Label.next_regular () in
 402            gather
 403              [
 404                instr_pushl l;
 405                instr_dup;
 406                instr_istypec OpNull;
 407                instr_jmpnz label_done;
 408                instr_whresult;
 409                instr_label label_done;
 410                instr_popl l;
 411              ])
 412   in
 413   let block = emit_stmts env b in
 414   let unset_locals = gather @@ List.map locals ~f:instr_unsetl in
 415   (* before *)
 416   ( gather [load_args; init_locals],
 417     (* inner *)
 418     gather [await_all; unpack; block],
 419     (* after *)
 420     unset_locals )
 421
 422 and emit_while env e b =
 423   let break_label = Label.next_regular () in
 424   let cont_label = Label.next_regular () in
 425   let start_label = Label.next_regular () in
 426   (* TODO: This is *bizarre* codegen for a while loop.
 427   It would be better to generate this as
 428   instr_label continue_label;
 429   emit_expr e;
 430   instr_jmpz break_label;
 431   body;
 432   instr_jmp continue_label;
 433   instr_label break_label;
 434   *)
 435   gather
 436     [
 437       get_instrs @@ emit_jmpz env e break_label;
 438       instr_label start_label;
 439       Emit_env.do_in_loop_body break_label cont_label env b emit_stmt;
 440       instr_label cont_label;
 441       get_instrs @@ emit_jmpnz env (fst e) (snd e) start_label;
 442       instr_label break_label;
 443     ]
 444
 445 and emit_using
 446     (env : Emit_env.t) pos is_block_scoped has_await (e : Tast.expr) b =
 447   match snd e with
 448   | A.Expr_list es ->
 449     emit_stmt env
 450     @@ List.fold_right
 451          es
 452          ~f:(fun e acc ->
 453            let ((p, _), _) = e in
 454            ( p,
 455              A.Using
 456                {
 457                  A.us_has_await = has_await;
 458                  A.us_is_block_scoped = is_block_scoped;
 459                  A.us_expr = e;
 460                  A.us_block = [acc];
 461                } ))
 462          ~init:b
 463   | _ ->
 464     Local.scope @@ fun () ->
 465     let (local, preamble) =
 466       match snd e with
 467       | A.Binop (Ast_defs.Eq None, (_, A.Lvar (_, id)), _)
 468       | A.Lvar (_, id) ->
 469         ( Local.Named (Local_id.get_name id),
 470           gather [emit_expr env e; Emit_pos.emit_pos (fst b); instr_popc] )
 471       | _ ->
 472         let l = Local.get_unnamed_local () in
 473         (l, gather [emit_expr env e; instr_setl l; instr_popc])
 474     in
 475     let finally_start = Label.next_regular () in
 476     let finally_end = Label.next_regular () in
 477     let body = Emit_env.do_in_using_body finally_start env b emit_stmt in
 478     let jump_instructions = TFR.collect_jump_instructions body env in
 479     let body =
 480       if IMap.is_empty jump_instructions then
 481         body
 482       else
 483         TFR.cleanup_try_body body
 484     in
 485     let fn_name =
 486       Hhbc_id.Method.from_raw_string
 487       @@
 488       if has_await then
 489         "__disposeAsync"
 490       else
 491         "__dispose"
 492     in
 493     let emit_finally () =
 494       let (epilogue, async_eager_label) =
 495         if has_await then
 496           let after_await = Label.next_regular () in
 497           ( gather [instr_await; instr_label after_await; instr_popc],
 498             Some after_await )
 499         else
 500           (instr_popc, None)
 501       in
 502       gather
 503         [
 504           instr_cgetl local;
 505           instr_nulluninit;
 506           instr_nulluninit;
 507           instr_fcallobjmethodd
 508             (make_fcall_args ?async_eager_label 0)
 509             fn_name
 510             Obj_null_throws;
 511           epilogue;
 512           ( if is_block_scoped then
 513             instr_unsetl local
 514           else
 515             empty );
 516         ]
 517     in
 518     let finally_epilogue =
 519       TFR.emit_finally_epilogue
 520         env
 521         pos
 522         ~verify_return:!verify_return
 523         ~verify_out:!verify_out
 524         ~num_out:!num_out
 525         jump_instructions
 526         finally_end
 527     in
 528     let exn_local = Local.get_unnamed_local () in
 529     let middle =
 530       if is_empty_block b then
 531         empty
 532       else
 533         create_try_catch
 534           ~skip_throw:true
 535           body
 536           (gather
 537              [
 538                emit_pos (fst b);
 539                make_finally_catch exn_local (emit_finally ());
 540                emit_pos pos;
 541              ])
 542     in
 543     gather
 544       [
 545         preamble;
 546         middle;
 547         instr_label finally_start;
 548         emit_finally ();
 549         finally_epilogue;
 550         instr_label finally_end;
 551       ]
 552
 553 and emit_do env b e =
 554   let cont_label = Label.next_regular () in
 555   let break_label = Label.next_regular () in
 556   let start_label = Label.next_regular () in
 557   gather
 558     [
 559       instr_label start_label;
 560       Emit_env.do_in_loop_body break_label cont_label env b emit_stmt;
 561       instr_label cont_label;
 562       get_instrs @@ emit_jmpnz env (fst e) (snd e) start_label;
 563       instr_label break_label;
 564     ]
 565
 566 and emit_for (env : Emit_env.t) p (e1 : Tast.expr) e2 e3 b =
 567   let break_label = Label.next_regular () in
 568   let cont_label = Label.next_regular () in
 569   let start_label = Label.next_regular () in
 570   (* TODO: this is bizarre codegen for a "for" loop.
 571      This should be codegen'd as
 572      emit_ignored_expr initializer;
 573      instr_label start_label;
 574      from_expr condition;
 575      instr_jmpz break_label;
 576      body;
 577      instr_label continue_label;
 578      emit_ignored_expr increment;
 579      instr_jmp start_label;
 580      instr_label break_label;
 581   *)
 582   let emit_cond ~jmpz label =
 583     let final cond =
 584       get_instrs
 585         ( if jmpz then
 586           emit_jmpz env cond label
 587         else
 588           emit_jmpnz env (fst cond) (snd cond) label )
 589     in
 590     let rec expr_list h tl =
 591       match tl with
 592       | [] ->
 593         [
 594           final
 595           @@ ( ( Pos.none,
 596                  Typing_defs.mk (Typing_reason.none, Typing_defs.make_tany ())
 597                ),
 598                A.Expr_list [h] );
 599         ]
 600       | h1 :: t1 -> emit_ignored_expr env ~pop_pos:p h :: expr_list h1 t1
 601     in
 602     match e2 with
 603     | (_, A.Expr_list []) ->
 604       if jmpz then
 605         empty
 606       else
 607         instr_jmp label
 608     | (_, A.Expr_list (h :: t)) -> gather @@ expr_list h t
 609     | cond -> final cond
 610   in
 611   gather
 612     [
 613       emit_ignored_expr env e1;
 614       emit_cond ~jmpz:true break_label;
 615       instr_label start_label;
 616       Emit_env.do_in_loop_body break_label cont_label env b emit_stmt;
 617       instr_label cont_label;
 618       emit_ignored_expr env e3;
 619       emit_cond ~jmpz:false start_label;
 620       instr_label break_label;
 621     ]
 622
 623 and emit_switch (env : Emit_env.t) pos scrutinee_expr cl =
 624   let (instr_init, instr_free, emit_check_case) =
 625     match snd scrutinee_expr with
 626     | A.Lvar _ ->
 627       (* Special case for simple scrutinee *)
 628       ( empty,
 629         empty,
 630         fun case_expr case_handler_label ->
 631           let ((pos, _), _) = case_expr in
 632           gather
 633             [
 634               emit_two_exprs env pos scrutinee_expr case_expr;
 635               instr_eq;
 636               instr_jmpnz case_handler_label;
 637             ] )
 638     | _ ->
 639       ( emit_expr env scrutinee_expr,
 640         instr_popc,
 641         fun case_expr case_handler_label ->
 642           let next_case_label = Label.next_regular () in
 643           let ((pos, _), _) = case_expr in
 644           gather
 645             [
 646               instr_dup;
 647               emit_expr env case_expr;
 648               emit_pos pos;
 649               instr_eq;
 650               instr_jmpz next_case_label;
 651               instr_popc;
 652               instr_jmp case_handler_label;
 653               instr_label next_case_label;
 654             ] )
 655   in
 656   (* "continue" in a switch in PHP has the same semantics as break! *)
 657   let break_label = Label.next_regular () in
 658   let has_default =
 659     List.exists
 660       ~f:(function
 661         | A.Default _ -> true
 662         | _ -> false)
 663       cl
 664   in
 665   let cl =
 666     if has_default then
 667       cl
 668     else
 669       let rec aux cl =
 670         match cl with
 671         | [] ->
 672           failwith "impossible - switch statements must have at least one case"
 673         | [A.Default _] -> failwith "impossible - there shouldn't be a default"
 674         | [A.Case (e, b)] -> [A.Case (e, b @ [(Pos.none, A.Break)])]
 675         | c :: cl -> c :: aux cl
 676       in
 677       aux cl
 678   in
 679   let cl =
 680     Emit_env.do_in_switch_body break_label env cl @@ fun env _ ->
 681     List.map cl ~f:(emit_case env)
 682   in
 683   let instr_bodies = gather @@ List.map cl ~f:snd in
 684   let default_label =
 685     let default_labels =
 686       List.filter_map cl ~f:(fun ((e, l), _) ->
 687           if Option.is_none e then
 688             Some l
 689           else
 690             None)
 691     in
 692     match default_labels with
 693     | [] -> break_label
 694     | [l] -> l
 695     | _ ->
 696       Emit_fatal.raise_fatal_runtime
 697         pos
 698         "Switch statements may only contain one 'default' clause."
 699   in
 700   let instr_check_cases =
 701     gather
 702     @@ List.map cl ~f:(function
 703            (* jmp to default case should be emitted as the very last 'else' case *)
 704            | ((None, _), _) -> empty
 705            | ((Some e, l), _) -> emit_check_case e l)
 706   in
 707   gather
 708     [
 709       instr_init;
 710       instr_check_cases;
 711       instr_free;
 712       instr_jmp default_label;
 713       instr_bodies;
 714       instr_label break_label;
 715     ]
 716
 717 and block_pos b =
 718   let bpos = List.map b fst in
 719   let valid_pos = List.filter bpos (fun e -> e <> Pos.none) in
 720   if valid_pos = [] then
 721     Pos.none
 722   else
 723     Pos.btw (List.hd_exn valid_pos) (List.last_exn valid_pos)
 724
 725 and emit_catch
 726     (env : Emit_env.t) pos end_label ((_, catch_type), (_, catch_local), b) =
 727   (* Note that this is a "regular" label; we're not going to branch to
 728     it directly in the event of an exception. *)
 729   let next_catch = Label.next_regular () in
 730   let id = Hhbc_id.Class.from_ast_name catch_type in
 731   gather
 732     [
 733       instr_dup;
 734       instr_instanceofd id;
 735       instr_jmpz next_catch;
 736       instr_setl (Local.Named (Local_id.get_name catch_local));
 737       instr_popc;
 738       emit_stmt env (Pos.none, A.Block b);
 739       Emit_pos.emit_pos pos;
 740       instr_jmp end_label;
 741       instr_label next_catch;
 742     ]
 743
 744 and emit_catches (env : Emit_env.t) pos catch_list end_label =
 745   gather (List.map catch_list ~f:(emit_catch env pos end_label))
 746
 747 and is_empty_block (_, b) =
 748   match b with
 749   | A.Block l -> List.for_all ~f:is_empty_block l
 750   | A.Noop -> true
 751   | _ -> false
 752
 753 and emit_try_catch (env : Emit_env.t) try_block catch_list =
 754   Local.scope @@ fun () -> emit_try_catch_ env try_block catch_list
 755
 756 and emit_try_catch_ (env : Emit_env.t) try_block catch_list =
 757   if is_empty_block try_block then
 758     empty
 759   else
 760     let end_label = Label.next_regular () in
 761     let (pos, _) = try_block in
 762     let try_env = Emit_env.with_try env in
 763     create_try_catch
 764       ~opt_done_label:end_label
 765       (gather [emit_stmt try_env try_block; Emit_pos.emit_pos pos])
 766       (emit_catches env pos catch_list end_label)
 767
 768 and emit_try_finally env pos try_block finally_block =
 769   Local.scope @@ fun () -> emit_try_finally_ env pos try_block finally_block
 770
 771 and emit_try_finally_ env pos try_block finally_block =
 772   let make_finally_body () =
 773     Emit_env.do_in_finally_body env finally_block emit_stmt
 774   in
 775   if is_empty_block try_block then
 776     make_finally_body ()
 777   else
 778     (*
 779   We need to generate four things:
 780   (1) the try-body, which will be followed by
 781   (2) the normal-continuation finally body, and
 782   (3) an epilogue to the finally body that deals with finally-blocked
 783       break and continue
 784   (4) the exceptional-continuation catch body.
 785   *)
 786
 787     (* (1) Try body
 788
 789   The try body might have un-rewritten continues and breaks which
 790   branch to a label outside of the try. This means that we must
 791   first run the normal-continuation finally, and then branch to the
 792   appropriate label.
 793
 794   We do this by running a rewriter which turns continues and breaks
 795   inside the try body into setting temp_local to an integer which indicates
 796   what action the finally must perform when it is finished, followed by a
 797   jump directly to the finally.
 798   *)
 799     let finally_start = Label.next_regular () in
 800     let finally_end = Label.next_regular () in
 801     let enclosing_span = Ast_scope.Scope.get_span env.Emit_env.env_scope in
 802     let try_env = Emit_env.with_try env in
 803     let try_body =
 804       Emit_env.do_in_try_body finally_start try_env try_block emit_stmt
 805     in
 806     let jump_instructions = TFR.collect_jump_instructions try_body env in
 807     let try_body =
 808       if IMap.is_empty jump_instructions then
 809         try_body
 810       else
 811         TFR.cleanup_try_body try_body
 812     in
 813
 814     (* (2) Finally body
 815
 816   Note that this is used both in the normal-continuation and
 817   exceptional-continuation cases; we generate the same code twice.
 818
 819   TODO: We might consider changing the codegen so that the finally block
 820   is only generated once. We could do this by making the catch block set a
 821   temp local to -1, and then branch to the finally block. In the finally block
 822   epilogue it can check to see if the local is -1, and if so, issue an unwind
 823   instruction.
 824
 825   It is illegal to have a continue or break which branches out of a finally.
 826   Unfortunately we at present do not detect this at parse time; rather, we
 827   generate an exception at run-time by rewriting continue and break
 828   instructions found inside finally blocks.
 829
 830   TODO: If we make this illegal at parse time then we can remove this pass.
 831   *)
 832     let exn_local = Local.get_unnamed_local () in
 833     let finally_body = make_finally_body () in
 834     let finally_body_for_catch =
 835       finally_body |> Label_rewriter.clone_with_fresh_regular_labels
 836     in
 837     (* (3) Finally epilogue *)
 838     let finally_epilogue =
 839       TFR.emit_finally_epilogue
 840         env
 841         pos
 842         ~verify_return:!verify_return
 843         ~verify_out:!verify_out
 844         ~num_out:!num_out
 845         jump_instructions
 846         finally_end
 847     in
 848
 849     (* (4) Catch body
 850
 851   We now emit the catch body; it is just cleanup code for the temp_local,
 852   a copy of the finally body (without the branching epilogue, since we are
 853   going to unwind rather than branch), and an unwind instruction.
 854
 855   TODO: The HHVM emitter sometimes emits seemingly spurious
 856   unset-unnamed-local instructions into the catch block.  These look
 857   like bugs in the emitter. Investigate; if they are bugs in the HHVM
 858   emitter, get them fixed there. If not, get a clear explanation of
 859   what they are for and why they are required.
 860   *)
 861     let middle =
 862       create_try_catch
 863         ~skip_throw:true
 864         try_body
 865         (gather
 866            [
 867              emit_pos enclosing_span;
 868              make_finally_catch exn_local finally_body_for_catch;
 869            ])
 870     in
 871     (* Put it all together. *)
 872     gather
 873       [
 874         middle;
 875         instr_label finally_start;
 876         Emit_pos.emit_pos (fst finally_block);
 877         finally_body;
 878         finally_epilogue;
 879         instr_label finally_end;
 880       ]
 881
 882 and make_finally_catch exn_local finally_body =
 883   gather
 884     [
 885       instr_popl exn_local;
 886       instr_unsetl (Local.get_label_id_local ());
 887       instr_unsetl (Local.get_retval_local ());
 888       create_try_catch
 889         finally_body
 890         (gather [instr_pushl exn_local; instr_chain_faults]);
 891       instr_pushl exn_local;
 892       instr_throw;
 893     ]
 894
 895 and get_id_of_simple_lvar_opt v =
 896   match v with
 897   | A.Lvar (pos, id) when Local_id.get_name id = SN.SpecialIdents.this ->
 898     Emit_fatal.raise_fatal_parse pos "Cannot re-assign $this"
 899   | A.Lvar (_, id)
 900     when not
 901            ( SN.Superglobals.is_superglobal (Local_id.get_name id)
 902            || Local_id.get_name id = SN.Superglobals.globals ) ->
 903     Some (Local_id.get_name id)
 904   | _ -> None
 905
 906 and emit_load_list_elements env path vs =
 907   let (preamble, load_value) =
 908     List.mapi ~f:(emit_load_list_element env path) vs |> List.unzip
 909   in
 910   (List.concat preamble, List.concat load_value)
 911
 912 and emit_load_list_element env path i v =
 913   let query_value =
 914     gather
 915       [
 916         gather @@ List.rev path;
 917         instr_querym 0 QueryOp.CGet (MemberKey.EI (Int64.of_int i));
 918       ]
 919   in
 920   match v with
 921   | (_, A.Lvar (_, id)) ->
 922     let load_value =
 923       gather
 924         [
 925           query_value;
 926           instr_setl (Local.Named (Local_id.get_name id));
 927           instr_popc;
 928         ]
 929     in
 930     ([], [load_value])
 931   | (_, A.List exprs) ->
 932     let dim_instr =
 933       instr_dim MemberOpMode.Warn (MemberKey.EI (Int64.of_int i))
 934     in
 935     emit_load_list_elements env (dim_instr :: path) exprs
 936   | ((pos, _), _) ->
 937     let set_instrs = emit_lval_op_nonlist env pos LValOp.Set v query_value 1 in
 938     let load_value = [set_instrs; instr_popc] in
 939     ([], [gather load_value])
 940
 941 (* Assigns a location to store values for foreach-key and foreach-value and
 942    creates a code to populate them.
 943    NOT suitable for foreach (... await ...) which uses different code-gen
 944    Returns: key_local_opt * value_local * key_preamble * value_preamble
 945    where:
 946    - key_local_opt - local variable to store a foreach-key value if it is
 947      declared
 948    - value_local - local variable to store a foreach-value
 949    - key_preamble - list of instructions to populate foreach-key
 950    - value_preamble - list of instructions to populate foreach-value
 951    *)
 952 and emit_iterator_key_value_storage env iterator :
 953     Hhbc_ast.local_id option * Hhbc_ast.local_id * Instruction_sequence.t =
 954   match iterator with
 955   | A.As_kv (((_, k) as expr_k), ((_, v) as expr_v)) ->
 956     begin
 957       match (get_id_of_simple_lvar_opt k, get_id_of_simple_lvar_opt v) with
 958       | (Some key_id, Some value_id) ->
 959         let key_local = Local.Named key_id in
 960         let value_local = Local.Named value_id in
 961         (Some key_local, value_local, empty)
 962       | _ ->
 963         let key_local = Local.get_unnamed_local () in
 964         let value_local = Local.get_unnamed_local () in
 965         let (key_preamble, key_load) =
 966           emit_iterator_lvalue_storage env expr_k key_local
 967         in
 968         let (value_preamble, value_load) =
 969           emit_iterator_lvalue_storage env expr_v value_local
 970         in
 971         (* HHVM prepends code to initialize non-plain, non-list foreach-key
 972          to the value preamble - do the same to minimize diffs *)
 973         let (key_preamble, value_preamble) =
 974           match k with
 975           | A.List _ -> (key_preamble, value_preamble)
 976           | _ -> ([], gather key_preamble :: value_preamble)
 977         in
 978         ( Some key_local,
 979           value_local,
 980           gather
 981             [
 982               gather value_preamble;
 983               gather value_load;
 984               gather key_preamble;
 985               gather key_load;
 986             ] )
 987     end
 988   | A.As_v ((_, v) as expr_v) ->
 989     begin
 990       match get_id_of_simple_lvar_opt v with
 991       | Some value_id ->
 992         let value_local = Local.Named value_id in
 993         (None, value_local, empty)
 994       | None ->
 995         let value_local = Local.get_unnamed_local () in
 996         let (value_preamble, value_load) =
 997           emit_iterator_lvalue_storage env expr_v value_local
 998         in
 999         (None, value_local, gather [gather value_preamble; gather value_load])
1000     end
1001   | _ -> failwith "emit_iterator_key_value_storage with iterator using await"
1002
1003 (* Emit code for either the key or value l-value operation in foreach await.
1004  * `indices` is the initial prefix of the array indices ([0] for key or [1] for
1005  * value) that is prepended onto the indices needed for list destructuring
1006  *
1007  * TODO: we don't need unnamed local if the target is a local
1008  *)
1009 and emit_foreach_await_lvalue_storage
1010     (env : Emit_env.t) (expr1 : Tast.expr) indices keep_on_stack =
1011   let ((pos, _), _) = expr1 in
1012   Scope.with_unnamed_local @@ fun local ->
1013   (* before *)
1014   ( instr_popl local,
1015     (* inner *)
1016     of_pair @@ emit_lval_op_list env pos (Some local) indices expr1,
1017     (* after *)
1018     if keep_on_stack then
1019       instr_pushl local
1020     else
1021       instr_unsetl local )
1022
1023 (* Emit code for the value and possibly key l-value operation in a foreach
1024  * await statement. The result of invocation of the `next` method has been
1025  * stored on top of the stack. For example:
1026  *   foreach (foo() await as $a->f => list($b[0], $c->g)) { ... }
1027  * Here, we need to construct l-value operations that access the [0] (for $a->f)
1028  * and [1;0] (for $b[0]) and [1;1] (for $c->g) indices of the array returned
1029  * from the `next` method.
1030  *)
1031 and emit_foreach_await_key_value_storage (env : Emit_env.t) iterator =
1032   match iterator with
1033   | A.Await_as_kv (_, expr_k, expr_v)
1034   | A.As_kv (expr_k, expr_v) ->
1035     let key_instrs = emit_foreach_await_lvalue_storage env expr_k [0] true in
1036     let value_instrs = emit_foreach_await_lvalue_storage env expr_v [1] false in
1037     gather [key_instrs; value_instrs]
1038   | A.Await_as_v (_, expr_v)
1039   | A.As_v expr_v ->
1040     emit_foreach_await_lvalue_storage env expr_v [1] false
1041
1042 (*Generates a code to initialize a given foreach-* value.
1043   Returns: preamble * load_code
1044   where:
1045   - preamble - preparation part that should be executed before the loading
1046   - load_code - instructions to actually populate the value.
1047   This split is necessary to reflect the way how HHVM loads values.
1048   as an example for the code
1049     list($$$a, $$b, $$$c)
1050   preamble part will include code that pushes cells for $$a and $$c on the stack
1051   load_code will be executed assuming that stack is prepopulated:
1052     [$aa, $$c] <- top
1053   *)
1054 and emit_iterator_lvalue_storage env v local =
1055   match v with
1056   | ((pos, _), A.Call _) ->
1057     Emit_fatal.raise_fatal_parse pos "Can't use return value in write context"
1058   | (_, A.List exprs) ->
1059     let (preamble, load_values) =
1060       emit_load_list_elements env [instr_basel local MemberOpMode.Warn] exprs
1061     in
1062     let load_values = [gather @@ List.rev load_values; instr_unsetl local] in
1063     (preamble, load_values)
1064   | ((pos, _), _) ->
1065     let (lhs, rhs, set_op) =
1066       emit_lval_op_nonlist_steps env pos LValOp.Set v (instr_cgetl local) 1
1067     in
1068     ([lhs], [rhs; set_op; instr_popc; instr_unsetl local])
1069
1070 and emit_foreach env pos collection iterator block =
1071   Local.scope @@ fun () ->
1072   match iterator with
1073   | A.As_kv _
1074   | A.As_v _ ->
1075     emit_foreach_ env pos collection iterator block
1076   | A.Await_as_kv (pos, _, _)
1077   | A.Await_as_v (pos, _) ->
1078     emit_foreach_await env pos collection iterator block
1079
1080 and emit_foreach_await env pos collection iterator block =
1081   let instr_collection = emit_expr env collection in
1082   Scope.with_unnamed_local @@ fun iter_temp_local ->
1083   let input_is_async_iterator_label = Label.next_regular () in
1084   let next_label = Label.next_regular () in
1085   let exit_label = Label.next_regular () in
1086   let pop_and_exit_label = Label.next_regular () in
1087   let async_eager_label = Label.next_regular () in
1088   let next_meth = Hhbc_id.Method.from_raw_string "next" in
1089   (* before *)
1090   ( gather
1091       [
1092         instr_collection;
1093         instr_dup;
1094         instr_instanceofd (Hhbc_id.Class.from_raw_string "HH\\AsyncIterator");
1095         instr_jmpnz input_is_async_iterator_label;
1096         Emit_fatal.emit_fatal_runtime
1097           pos
1098           "Unable to iterate non-AsyncIterator asynchronously";
1099         instr_label input_is_async_iterator_label;
1100         instr_popl iter_temp_local;
1101       ],
1102     (* inner *)
1103     gather
1104       [
1105         instr_label next_label;
1106         instr_cgetl iter_temp_local;
1107         instr_nulluninit;
1108         instr_nulluninit;
1109         instr_fcallobjmethodd
1110           (make_fcall_args ~async_eager_label 0)
1111           next_meth
1112           Obj_null_throws;
1113         instr_await;
1114         instr_label async_eager_label;
1115         instr_dup;
1116         instr_istypec OpNull;
1117         instr_jmpnz pop_and_exit_label;
1118         emit_foreach_await_key_value_storage env iterator;
1119         Emit_env.do_in_loop_body exit_label next_label env block emit_stmt;
1120         emit_pos pos;
1121         instr_jmp next_label;
1122         instr_label pop_and_exit_label;
1123         instr_popc;
1124         instr_label exit_label;
1125       ],
1126     (* after *)
1127     instr_unsetl iter_temp_local )
1128
1129 and emit_foreach_ env pos collection iterator block =
1130   let instr_collection = emit_expr env collection in
1131   Scope.with_unnamed_locals_and_iterators @@ fun () ->
1132   let iter_id = Iterator.get_iterator () in
1133   let loop_break_label = Label.next_regular () in
1134   let loop_continue_label = Label.next_regular () in
1135   let loop_head_label = Label.next_regular () in
1136   let (key_id, val_id, preamble) =
1137     emit_iterator_key_value_storage env iterator
1138   in
1139   let iter_args = { iter_id; key_id; val_id } in
1140   let init = instr_iterinit iter_args loop_break_label in
1141   let next = instr_iternext iter_args loop_head_label in
1142   let body =
1143     Emit_env.do_in_loop_body
1144       loop_break_label
1145       loop_continue_label
1146       env
1147       ~iter:iter_id
1148       block
1149       emit_stmt
1150   in
1151   ( gather [instr_collection; emit_pos (Tast_annotate.get_pos collection); init],
1152     gather
1153       [
1154         instr_label loop_head_label;
1155         preamble;
1156         body;
1157         instr_label loop_continue_label;
1158         emit_pos pos;
1159         next;
1160       ],
1161     gather [instr_label loop_break_label] )
1162
1163 and emit_yield_from_delegates env pos e =
1164   let iterator_number = Iterator.get_iterator () in
1165   let loop_label = Label.next_regular () in
1166   gather
1167     [
1168       emit_expr env e;
1169       emit_pos pos;
1170       instr_contAssignDelegate iterator_number;
1171       create_try_catch
1172         (gather
1173            [
1174              instr_null;
1175              instr_label loop_label;
1176              instr_contEnterDelegate;
1177              instr_yieldFromDelegate iterator_number loop_label;
1178            ])
1179         (instr_contUnsetDelegate_free iterator_number);
1180       instr_contUnsetDelegate_ignore iterator_number;
1181     ]
1182
1183 and emit_stmts env stl =
1184   let results = List.map stl (emit_stmt env) in
1185   gather results
1186
1187 and emit_case (env : Emit_env.t) c =
1188   let l = Label.next_regular () in
1189   let (b, e) =
1190     match c with
1191     | A.Default (_, b) -> (b, None)
1192     | A.Case (e, b) -> (b, Some e)
1193   in
1194   let b = emit_stmt env (Pos.none, A.Block b) in
1195   ((e, l), gather [instr_label l; b])
1196
1197 let emit_dropthrough_return env =
1198   match !default_dropthrough with
1199   | Some instrs -> instrs
1200   | _ ->
1201     Emit_pos.emit_pos_then (Pos.last_char !function_pos)
1202     @@ gather [!default_return_value; emit_return env]
1203
1204 let rec emit_final_statement env s =
1205   match snd s with
1206   | A.Throw _
1207   | A.Return _
1208   | A.Goto _
1209   | A.Expr (_, A.Yield_break) ->
1210     emit_stmt env s
1211   | A.Block b -> emit_final_statements env b
1212   | _ -> gather [emit_stmt env s; emit_dropthrough_return env]
1213
1214 and emit_final_statements env b =
1215   match b with
1216   | [] -> emit_dropthrough_return env
1217   | [s] -> emit_final_statement env s
1218   | s :: b ->
1219     let i1 = emit_stmt env s in
1220     let i2 = emit_final_statements env b in
1221     gather [i1; i2]