|
|
@@ -0,0 +1,698 @@
|
|
|
+(*
|
|
|
+ The Haxe Compiler
|
|
|
+ Copyright (C) 2005-2016 Haxe Foundation
|
|
|
+
|
|
|
+ This program is free software; you can redistribute it and/or
|
|
|
+ modify it under the terms of the GNU General Public License
|
|
|
+ as published by the Free Software Foundation; either version 2
|
|
|
+ of the License, or (at your option) any later version.
|
|
|
+
|
|
|
+ This program is distributed in the hope that it will be useful,
|
|
|
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
+ GNU General Public License for more details.
|
|
|
+
|
|
|
+ You should have received a copy of the GNU General Public License
|
|
|
+ along with this program; if not, write to the Free Software
|
|
|
+ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
|
|
+ *)
|
|
|
+
|
|
|
+open Ast
|
|
|
+open Type
|
|
|
+open Common
|
|
|
+open AnalyzerConfig
|
|
|
+open AnalyzerTypes
|
|
|
+open AnalyzerTypes.BasicBlock
|
|
|
+open AnalyzerTypes.Graph
|
|
|
+open AnalyzerTexpr
|
|
|
+
|
|
|
+(*
|
|
|
+ Transforms an expression to a graph, and a graph back to an expression. This module relies on TexprFilter being
|
|
|
+ run first.
|
|
|
+
|
|
|
+ The created graph is intact and can immediately be transformed back to an expression, or used for analysis first.
|
|
|
+*)
|
|
|
+
|
|
|
+let rec func ctx bb tf t p =
|
|
|
+ let g = ctx.graph in
|
|
|
+ let create_node kind t p =
|
|
|
+ let bb = Graph.create_node g kind t p in
|
|
|
+ bb.bb_loop_groups <- ctx.loop_stack;
|
|
|
+ bb
|
|
|
+ in
|
|
|
+ let bb_root = create_node (BKFunctionBegin tf) tf.tf_expr.etype tf.tf_expr.epos in
|
|
|
+ let bb_exit = create_node BKFunctionEnd tf.tf_expr.etype tf.tf_expr.epos in
|
|
|
+ add_function g tf t p bb_root;
|
|
|
+ add_cfg_edge bb bb_root CFGFunction;
|
|
|
+ let make_block_meta b =
|
|
|
+ let e = mk (TConst (TInt (Int32.of_int b.bb_id))) ctx.com.basic.tint b.bb_pos in
|
|
|
+ wrap_meta ":block" e
|
|
|
+ in
|
|
|
+ let bb_breaks = ref [] in
|
|
|
+ let bb_continue = ref None in
|
|
|
+ let b_try_stack = ref [] in
|
|
|
+ let begin_loop bb_loop_pre bb_continue' =
|
|
|
+ let old = !bb_breaks,!bb_continue in
|
|
|
+ bb_breaks := [];
|
|
|
+ bb_continue := Some bb_continue';
|
|
|
+ let id = ctx.loop_counter in
|
|
|
+ g.g_loops <- IntMap.add id bb_loop_pre g.g_loops;
|
|
|
+ ctx.loop_stack <- id :: ctx.loop_stack;
|
|
|
+ bb_continue'.bb_loop_groups <- id :: bb_continue'.bb_loop_groups;
|
|
|
+ ctx.loop_counter <- id + 1;
|
|
|
+ (fun () ->
|
|
|
+ let breaks = !bb_breaks in
|
|
|
+ bb_breaks := fst old;
|
|
|
+ bb_continue := snd old;
|
|
|
+ ctx.loop_stack <- List.tl ctx.loop_stack;
|
|
|
+ breaks;
|
|
|
+ )
|
|
|
+ in
|
|
|
+ let begin_try b =
|
|
|
+ b_try_stack := b :: !b_try_stack;
|
|
|
+ (fun () ->
|
|
|
+ b_try_stack := List.tl !b_try_stack
|
|
|
+ )
|
|
|
+ in
|
|
|
+ let add_terminator bb e =
|
|
|
+ add_texpr bb e;
|
|
|
+ close_node g bb;
|
|
|
+ g.g_unreachable
|
|
|
+ in
|
|
|
+ let check_unbound_call v el =
|
|
|
+ if is_unbound_call_that_might_have_side_effects v el then ctx.has_unbound <- true
|
|
|
+ in
|
|
|
+ let rec value bb e = match e.eexpr with
|
|
|
+ | TLocal v ->
|
|
|
+ bb,e
|
|
|
+ | TBinop(OpAssign,({eexpr = TLocal v} as e1),e2) ->
|
|
|
+ block_element bb e,e1
|
|
|
+ | TBlock [e1] ->
|
|
|
+ value bb e1
|
|
|
+ | TBlock _ | TIf _ | TSwitch _ | TTry _ ->
|
|
|
+ bind_to_temp bb false e
|
|
|
+ | TCall({eexpr = TLocal v},el) when is_really_unbound v ->
|
|
|
+ check_unbound_call v el;
|
|
|
+ bb,e
|
|
|
+ | TCall(e1,el) ->
|
|
|
+ call bb e e1 el
|
|
|
+ | TBinop((OpAssign | OpAssignOp _) as op,e1,e2) ->
|
|
|
+ let bb,e2 = value bb e2 in
|
|
|
+ let bb,e1 = value bb e1 in
|
|
|
+ bb,{e with eexpr = TBinop(op,e1,e2)}
|
|
|
+ | TBinop(op,e1,e2) ->
|
|
|
+ let bb,e1,e2 = match ordered_value_list bb [e1;e2] with
|
|
|
+ | bb,[e1;e2] -> bb,e1,e2
|
|
|
+ | _ -> assert false
|
|
|
+ in
|
|
|
+ bb,{e with eexpr = TBinop(op,e1,e2)}
|
|
|
+ | TUnop(op,flag,e1) ->
|
|
|
+ let bb,e1 = value bb e1 in
|
|
|
+ bb,{e with eexpr = TUnop(op,flag,e1)}
|
|
|
+ | TArrayDecl el ->
|
|
|
+ let bb,el = ordered_value_list bb el in
|
|
|
+ bb,{e with eexpr = TArrayDecl el}
|
|
|
+ | TObjectDecl fl ->
|
|
|
+ let el = List.map snd fl in
|
|
|
+ let bb,el = ordered_value_list bb el in
|
|
|
+ bb,{e with eexpr = TObjectDecl (List.map2 (fun (s,_) e -> s,e) fl el)}
|
|
|
+ | TField({eexpr = TTypeExpr _},fa) ->
|
|
|
+ bb,e
|
|
|
+ | TField(e1,fa) ->
|
|
|
+ let bb,e1 = value bb e1 in
|
|
|
+ bb,{e with eexpr = TField(e1,fa)}
|
|
|
+ | TArray(e1,e2) ->
|
|
|
+ let bb,e1,e2 = match ordered_value_list bb [e1;e2] with
|
|
|
+ | bb,[e1;e2] -> bb,e1,e2
|
|
|
+ | _ -> assert false
|
|
|
+ in
|
|
|
+ bb,{e with eexpr = TArray(e1,e2)}
|
|
|
+ | TMeta(m,e1) ->
|
|
|
+ let bb,e1 = value bb e1 in
|
|
|
+ bb,{e with eexpr = TMeta(m,e1)}
|
|
|
+ | TParenthesis e1 ->
|
|
|
+ let bb,e1 = value bb e1 in
|
|
|
+ bb,{e with eexpr = TParenthesis e1}
|
|
|
+ | TCast(e1,mto) ->
|
|
|
+ let bb,e1 = value bb e1 in
|
|
|
+ bb,{e with eexpr = TCast(e1,mto)}
|
|
|
+ | TNew(c,tl,el) ->
|
|
|
+ let bb,el = ordered_value_list bb el in
|
|
|
+ bb,{e with eexpr = TNew(c,tl,el)}
|
|
|
+ | TEnumParameter(e1,ef,ei) ->
|
|
|
+ let bb,e1 = value bb e1 in
|
|
|
+ bb,{e with eexpr = TEnumParameter(e1,ef,ei)}
|
|
|
+ | TFunction tf ->
|
|
|
+ let bb_func,bb_func_end = func ctx bb tf e.etype e.epos in
|
|
|
+ let e_fun = mk (TConst (TString "fun")) t_dynamic p in
|
|
|
+ let econst = mk (TConst (TInt (Int32.of_int bb_func.bb_id))) ctx.com.basic.tint e.epos in
|
|
|
+ let ec = mk (TCall(e_fun,[econst])) t_dynamic p in
|
|
|
+ let bb_next = create_node BKNormal bb.bb_type bb.bb_pos in
|
|
|
+ add_cfg_edge bb bb_next CFGGoto;
|
|
|
+ set_syntax_edge bb (SEMerge bb_next);
|
|
|
+ close_node g bb;
|
|
|
+ add_cfg_edge bb_func_end bb_next CFGGoto;
|
|
|
+ bb_next,ec
|
|
|
+ | TTypeExpr(TClassDecl {cl_kind = KAbstractImpl a}) when not (Meta.has Meta.RuntimeValue a.a_meta) ->
|
|
|
+ error "Cannot use abstract as value" e.epos
|
|
|
+ | TTypeExpr(TClassDecl c) ->
|
|
|
+ List.iter (fun cf -> if not (Meta.has Meta.MaybeUsed cf.cf_meta) then cf.cf_meta <- (Meta.MaybeUsed,[],cf.cf_pos) :: cf.cf_meta;) c.cl_ordered_statics;
|
|
|
+ bb,e
|
|
|
+ | TConst _ | TTypeExpr _ ->
|
|
|
+ bb,e
|
|
|
+ | TThrow _ | TReturn _ | TBreak | TContinue ->
|
|
|
+ let bb = block_element bb e in
|
|
|
+ bb,mk (TConst TNull) t_dynamic e.epos
|
|
|
+ | TVar _ | TFor _ | TWhile _ ->
|
|
|
+ error "Cannot use this expression as value" e.epos
|
|
|
+ and ordered_value_list bb el =
|
|
|
+ let might_be_affected,collect_modified_locals = Optimizer.create_affection_checker() in
|
|
|
+ let rec can_be_optimized e = match e.eexpr with
|
|
|
+ | TBinop _ | TArray _ | TCall _ -> true
|
|
|
+ | TParenthesis e1 -> can_be_optimized e1
|
|
|
+ | _ -> false
|
|
|
+ in
|
|
|
+ let _,el = List.fold_left (fun (had_side_effect,acc) e ->
|
|
|
+ if had_side_effect then
|
|
|
+ (true,(might_be_affected e || Optimizer.has_side_effect e,can_be_optimized e,e) :: acc)
|
|
|
+ else begin
|
|
|
+ let had_side_effect = Optimizer.has_side_effect e in
|
|
|
+ if had_side_effect then collect_modified_locals e;
|
|
|
+ let opt = can_be_optimized e in
|
|
|
+ (had_side_effect || opt,(false,opt,e) :: acc)
|
|
|
+ end
|
|
|
+ ) (false,[]) (List.rev el) in
|
|
|
+ let bb,values = List.fold_left (fun (bb,acc) (aff,opt,e) ->
|
|
|
+ let bb,value = if aff || opt then bind_to_temp bb aff e else value bb e in
|
|
|
+ bb,(value :: acc)
|
|
|
+ ) (bb,[]) el in
|
|
|
+ bb,List.rev values
|
|
|
+ and bind_to_temp bb sequential e =
|
|
|
+ let rec loop fl e = match e.eexpr with
|
|
|
+ | TField(e1,fa) when (match extract_field fa with Some {cf_kind = Method MethNormal} -> true | _ -> false) ->
|
|
|
+ loop ((fun e' -> {e with eexpr = TField(e',fa)}) :: fl) e1
|
|
|
+ | _ ->
|
|
|
+ fl,e
|
|
|
+ in
|
|
|
+ let fl,e = loop [] e in
|
|
|
+ let v = alloc_var ctx.temp_var_name e.etype in
|
|
|
+ begin match ctx.com.platform with
|
|
|
+ | Cpp when sequential && not (Common.defined ctx.com Define.Cppia) -> ()
|
|
|
+ | _ -> v.v_meta <- [Meta.CompilerGenerated,[],e.epos];
|
|
|
+ end;
|
|
|
+ let bb = declare_var_and_assign bb v e in
|
|
|
+ let e = {e with eexpr = TLocal v} in
|
|
|
+ let e = List.fold_left (fun e f -> f e) e (List.rev fl) in
|
|
|
+ bb,e
|
|
|
+ and declare_var_and_assign bb v e =
|
|
|
+ let rec loop bb e = match e.eexpr with
|
|
|
+ | TParenthesis e1 ->
|
|
|
+ loop bb e1
|
|
|
+ | TBlock el ->
|
|
|
+ let rec loop2 bb el = match el with
|
|
|
+ | [e] ->
|
|
|
+ bb,e
|
|
|
+ | e1 :: el ->
|
|
|
+ let bb = block_element bb e1 in
|
|
|
+ loop2 bb el
|
|
|
+ | [] ->
|
|
|
+ assert false
|
|
|
+ in
|
|
|
+ let bb,e = loop2 bb el in
|
|
|
+ loop bb e
|
|
|
+ | _ ->
|
|
|
+ bb,e
|
|
|
+ in
|
|
|
+ let bb,e = loop bb e in
|
|
|
+ begin match follow v.v_type with
|
|
|
+ | TAbstract({a_path=[],"Void"},_) -> error "Cannot use Void as value" e.epos
|
|
|
+ | _ -> ()
|
|
|
+ end;
|
|
|
+ let ev = mk (TLocal v) v.v_type e.epos in
|
|
|
+ let was_assigned = ref false in
|
|
|
+ let assign e =
|
|
|
+ if not !was_assigned then begin
|
|
|
+ was_assigned := true;
|
|
|
+ add_texpr bb (mk (TVar(v,None)) ctx.com.basic.tvoid ev.epos);
|
|
|
+ end;
|
|
|
+ mk (TBinop(OpAssign,ev,e)) ev.etype e.epos
|
|
|
+ in
|
|
|
+ begin try
|
|
|
+ block_element_plus bb (map_values assign e) (fun e -> mk (TVar(v,Some e)) ctx.com.basic.tvoid e.epos)
|
|
|
+ with Exit ->
|
|
|
+ let bb,e = value bb e in
|
|
|
+ add_texpr bb (mk (TVar(v,Some e)) ctx.com.basic.tvoid ev.epos);
|
|
|
+ bb
|
|
|
+ end
|
|
|
+ and block_element_plus bb (e,efinal) f =
|
|
|
+ let bb = block_element bb e in
|
|
|
+ let bb = match efinal with
|
|
|
+ | None -> bb
|
|
|
+ | Some e -> block_element bb (f e)
|
|
|
+ in
|
|
|
+ bb
|
|
|
+ and block_element_value bb e f =
|
|
|
+ let e,efinal = map_values f e in
|
|
|
+ block_element_plus bb (e,efinal) f
|
|
|
+ and call bb e e1 el =
|
|
|
+ begin match e1.eexpr with
|
|
|
+ | TConst TSuper when ctx.com.platform = Java || ctx.com.platform = Cs ->
|
|
|
+ bb,e
|
|
|
+ | _ ->
|
|
|
+ let check e t = match e.eexpr with
|
|
|
+ | TLocal v when is_ref_type t ->
|
|
|
+ v.v_capture <- true;
|
|
|
+ e
|
|
|
+ | _ ->
|
|
|
+ e
|
|
|
+ in
|
|
|
+ let el = Codegen.UnificationCallback.check_call check el e1.etype in
|
|
|
+ let bb,el = ordered_value_list bb (e1 :: el) in
|
|
|
+ match el with
|
|
|
+ | e1 :: el -> bb,{e with eexpr = TCall(e1,el)}
|
|
|
+ | _ -> assert false
|
|
|
+ end
|
|
|
+ and block_element bb e = match e.eexpr with
|
|
|
+ (* variables *)
|
|
|
+ | TVar(v,None) ->
|
|
|
+ add_texpr bb e;
|
|
|
+ bb
|
|
|
+ | TVar(v,Some e1) ->
|
|
|
+ declare_var_and_assign bb v e1
|
|
|
+ | TBinop(OpAssign,({eexpr = TLocal v} as e1),e2) ->
|
|
|
+ let assign e =
|
|
|
+ mk (TBinop(OpAssign,e1,e)) e.etype e.epos
|
|
|
+ in
|
|
|
+ begin try
|
|
|
+ block_element_value bb e2 assign
|
|
|
+ with Exit ->
|
|
|
+ let bb,e2 = value bb e2 in
|
|
|
+ add_texpr bb {e with eexpr = TBinop(OpAssign,e1,e2)};
|
|
|
+ bb
|
|
|
+ end
|
|
|
+ (* branching *)
|
|
|
+ | TMeta((Meta.MergeBlock,_,_),{eexpr = TBlock el}) ->
|
|
|
+ block_el bb el
|
|
|
+ | TBlock el ->
|
|
|
+ let bb_sub = create_node BKSub e.etype e.epos in
|
|
|
+ add_cfg_edge bb bb_sub CFGGoto;
|
|
|
+ close_node g bb;
|
|
|
+ let bb_sub_next = block_el bb_sub el in
|
|
|
+ if bb_sub_next != g.g_unreachable then begin
|
|
|
+ let bb_next = create_node BKNormal bb.bb_type bb.bb_pos in
|
|
|
+ set_syntax_edge bb (SESubBlock(bb_sub,bb_next));
|
|
|
+ add_cfg_edge bb_sub_next bb_next CFGGoto;
|
|
|
+ close_node g bb_sub_next;
|
|
|
+ bb_next;
|
|
|
+ end else begin
|
|
|
+ set_syntax_edge bb (SEMerge bb_sub);
|
|
|
+ close_node g bb_sub_next;
|
|
|
+ bb_sub_next
|
|
|
+ end
|
|
|
+ | TIf(e1,e2,None) ->
|
|
|
+ let bb,e1 = bind_to_temp bb false e1 in
|
|
|
+ let bb_then = create_node BKConditional e2.etype e2.epos in
|
|
|
+ add_texpr bb (wrap_meta ":cond-branch" e1);
|
|
|
+ add_cfg_edge bb bb_then (CFGCondBranch (mk (TConst (TBool true)) ctx.com.basic.tbool e2.epos));
|
|
|
+ let bb_then_next = block bb_then e2 in
|
|
|
+ let bb_next = create_node BKNormal bb.bb_type bb.bb_pos in
|
|
|
+ set_syntax_edge bb (SEIfThen(bb_then,bb_next));
|
|
|
+ add_cfg_edge bb bb_next CFGCondElse;
|
|
|
+ close_node g bb;
|
|
|
+ add_cfg_edge bb_then_next bb_next CFGGoto;
|
|
|
+ close_node g bb_then_next;
|
|
|
+ bb_next
|
|
|
+ | TIf(e1,e2,Some e3) ->
|
|
|
+ let bb,e1 = bind_to_temp bb false e1 in
|
|
|
+ let bb_then = create_node BKConditional e2.etype e2.epos in
|
|
|
+ let bb_else = create_node BKConditional e3.etype e3.epos in
|
|
|
+ add_texpr bb (wrap_meta ":cond-branch" e1);
|
|
|
+ add_cfg_edge bb bb_then (CFGCondBranch (mk (TConst (TBool true)) ctx.com.basic.tbool e2.epos));
|
|
|
+ add_cfg_edge bb bb_else CFGCondElse;
|
|
|
+ close_node g bb;
|
|
|
+ let bb_then_next = block bb_then e2 in
|
|
|
+ let bb_else_next = block bb_else e3 in
|
|
|
+ if bb_then_next == g.g_unreachable && bb_else_next == g.g_unreachable then begin
|
|
|
+ set_syntax_edge bb (SEIfThenElse(bb_then,bb_else,g.g_unreachable,e.etype));
|
|
|
+ g.g_unreachable
|
|
|
+ end else begin
|
|
|
+ let bb_next = create_node BKNormal bb.bb_type bb.bb_pos in
|
|
|
+ set_syntax_edge bb (SEIfThenElse(bb_then,bb_else,bb_next,e.etype));
|
|
|
+ add_cfg_edge bb_then_next bb_next CFGGoto;
|
|
|
+ add_cfg_edge bb_else_next bb_next CFGGoto;
|
|
|
+ close_node g bb_then_next;
|
|
|
+ close_node g bb_else_next;
|
|
|
+ bb_next
|
|
|
+ end
|
|
|
+ | TSwitch(e1,cases,edef) ->
|
|
|
+ let is_exhaustive = edef <> None || Optimizer.is_exhaustive e1 in
|
|
|
+ let bb,e1 = bind_to_temp bb false e1 in
|
|
|
+ add_texpr bb (wrap_meta ":cond-branch" e1);
|
|
|
+ let reachable = ref [] in
|
|
|
+ let make_case e =
|
|
|
+ let bb_case = create_node BKConditional e.etype e.epos in
|
|
|
+ let bb_case_next = block bb_case e in
|
|
|
+ if bb_case_next != g.g_unreachable then
|
|
|
+ reachable := bb_case_next :: !reachable;
|
|
|
+ close_node g bb_case_next;
|
|
|
+ bb_case
|
|
|
+ in
|
|
|
+ let cases = List.map (fun (el,e) ->
|
|
|
+ let bb_case = make_case e in
|
|
|
+ List.iter (fun e -> add_cfg_edge bb bb_case (CFGCondBranch e)) el;
|
|
|
+ el,bb_case
|
|
|
+ ) cases in
|
|
|
+ let def = match edef with
|
|
|
+ | None ->
|
|
|
+ None
|
|
|
+ | Some e ->
|
|
|
+ let bb_case = make_case e in
|
|
|
+ add_cfg_edge bb bb_case (CFGCondElse);
|
|
|
+ Some (bb_case)
|
|
|
+ in
|
|
|
+ if is_exhaustive && !reachable = [] then begin
|
|
|
+ set_syntax_edge bb (SESwitch(cases,def,g.g_unreachable));
|
|
|
+ close_node g bb;
|
|
|
+ g.g_unreachable;
|
|
|
+ end else begin
|
|
|
+ let bb_next = create_node BKNormal bb.bb_type bb.bb_pos in
|
|
|
+ if not is_exhaustive then add_cfg_edge bb bb_next CFGGoto;
|
|
|
+ List.iter (fun bb -> add_cfg_edge bb bb_next CFGGoto) !reachable;
|
|
|
+ set_syntax_edge bb (SESwitch(cases,def,bb_next));
|
|
|
+ close_node g bb;
|
|
|
+ bb_next
|
|
|
+ end
|
|
|
+ | TWhile(e1,e2,NormalWhile) ->
|
|
|
+ let bb_loop_pre = create_node BKNormal e1.etype e1.epos in
|
|
|
+ add_cfg_edge bb bb_loop_pre CFGGoto;
|
|
|
+ set_syntax_edge bb (SEMerge bb_loop_pre);
|
|
|
+ close_node g bb;
|
|
|
+ let bb_loop_head = create_node BKLoopHead e1.etype e1.epos in
|
|
|
+ add_cfg_edge bb_loop_pre bb_loop_head CFGGoto;
|
|
|
+ let close = begin_loop bb bb_loop_head in
|
|
|
+ let bb_loop_body = create_node BKNormal e2.etype e2.epos in
|
|
|
+ let bb_loop_body_next = block bb_loop_body e2 in
|
|
|
+ let bb_breaks = close() in
|
|
|
+ let bb_next = if bb_breaks = [] then begin
|
|
|
+ (* The loop appears to be infinite, let's assume that something within it throws.
|
|
|
+ Otherwise DCE's mark-pass won't see its body and removes everything. *)
|
|
|
+ add_cfg_edge bb_loop_body_next bb_exit CFGMaybeThrow;
|
|
|
+ g.g_unreachable
|
|
|
+ end else
|
|
|
+ create_node BKNormal bb.bb_type bb.bb_pos
|
|
|
+ in
|
|
|
+ List.iter (fun bb -> add_cfg_edge bb bb_next CFGGoto) bb_breaks;
|
|
|
+ set_syntax_edge bb_loop_pre (SEWhile(bb_loop_head,bb_loop_body,bb_next));
|
|
|
+ close_node g bb_loop_pre;
|
|
|
+ add_texpr bb_loop_pre {e with eexpr = TWhile(e1,make_block_meta bb_loop_body,NormalWhile)};
|
|
|
+ add_cfg_edge bb_loop_body_next bb_loop_head CFGGoto;
|
|
|
+ add_cfg_edge bb_loop_head bb_loop_body CFGGoto;
|
|
|
+ close_node g bb_loop_body_next;
|
|
|
+ close_node g bb_loop_head;
|
|
|
+ bb_next;
|
|
|
+ | TTry(e1,catches) ->
|
|
|
+ let bb_try = create_node BKNormal e1.etype e1.epos in
|
|
|
+ let bb_exc = create_node BKException t_dynamic e.epos in
|
|
|
+ add_cfg_edge bb bb_try CFGGoto;
|
|
|
+ let close = begin_try bb_exc in
|
|
|
+ let bb_try_next = block bb_try e1 in
|
|
|
+ close();
|
|
|
+ let bb_next = if bb_exc.bb_incoming = [] then
|
|
|
+ let bb_next = if bb_try_next == g.g_unreachable then
|
|
|
+ g.g_unreachable
|
|
|
+ else begin
|
|
|
+ let bb_next = create_node BKNormal bb.bb_type bb.bb_pos in
|
|
|
+ add_cfg_edge bb_try_next bb_next CFGGoto;
|
|
|
+ close_node g bb_try_next;
|
|
|
+ bb_next
|
|
|
+ end in
|
|
|
+ set_syntax_edge bb (SESubBlock(bb_try,bb_next));
|
|
|
+ bb_next
|
|
|
+ else begin
|
|
|
+ let is_reachable = ref (not (bb_try_next == g.g_unreachable)) in
|
|
|
+ let catches = List.map (fun (v,e) ->
|
|
|
+ let bb_catch = create_node (BKCatch v) e.etype e.epos in
|
|
|
+ add_cfg_edge bb_exc bb_catch CFGGoto;
|
|
|
+ let bb_catch_next = block bb_catch e in
|
|
|
+ is_reachable := !is_reachable || (not (bb_catch_next == g.g_unreachable));
|
|
|
+ v,bb_catch,bb_catch_next
|
|
|
+ ) catches in
|
|
|
+ let bb_next = if !is_reachable then create_node BKNormal bb.bb_type bb.bb_pos else g.g_unreachable in
|
|
|
+ let catches = List.map (fun (v,bb_catch,bb_catch_next) ->
|
|
|
+ if bb_catch_next != g.g_unreachable then add_cfg_edge bb_catch_next bb_next CFGGoto;
|
|
|
+ close_node g bb_catch_next;
|
|
|
+ v,bb_catch
|
|
|
+ ) catches in
|
|
|
+ set_syntax_edge bb (SETry(bb_try,bb_exc,catches,bb_next));
|
|
|
+ if bb_try_next != g.g_unreachable then add_cfg_edge bb_try_next bb_next CFGGoto;
|
|
|
+ close_node g bb_try_next;
|
|
|
+ bb_next
|
|
|
+ end in
|
|
|
+ close_node g bb_exc;
|
|
|
+ close_node g bb;
|
|
|
+ bb_next
|
|
|
+ (* control flow *)
|
|
|
+ | TReturn None ->
|
|
|
+ add_cfg_edge bb bb_exit CFGGoto;
|
|
|
+ add_terminator bb e
|
|
|
+ | TReturn (Some e1) ->
|
|
|
+ begin try
|
|
|
+ let mk_return e1 = mk (TReturn (Some e1)) t_dynamic e.epos in
|
|
|
+ block_element_value bb e1 mk_return
|
|
|
+ with Exit ->
|
|
|
+ let bb,e1 = value bb e1 in
|
|
|
+ add_cfg_edge bb bb_exit CFGGoto;
|
|
|
+ add_terminator bb {e with eexpr = TReturn(Some e1)};
|
|
|
+ end
|
|
|
+ | TBreak ->
|
|
|
+ bb_breaks := bb :: !bb_breaks;
|
|
|
+ add_terminator bb e
|
|
|
+ | TContinue ->
|
|
|
+ begin match !bb_continue with
|
|
|
+ | Some bb_continue -> add_cfg_edge bb bb_continue CFGGoto
|
|
|
+ | _ -> assert false
|
|
|
+ end;
|
|
|
+ add_terminator bb e
|
|
|
+ | TThrow e1 ->
|
|
|
+ begin try
|
|
|
+ let mk_throw e1 = mk (TThrow e1) t_dynamic e.epos in
|
|
|
+ block_element_value bb e1 mk_throw
|
|
|
+ with Exit ->
|
|
|
+ let bb,e1 = value bb e1 in
|
|
|
+ begin match !b_try_stack with
|
|
|
+ | [] -> add_cfg_edge bb bb_exit CFGGoto
|
|
|
+ | _ -> List.iter (fun bb_exc -> add_cfg_edge bb bb_exc CFGGoto) !b_try_stack;
|
|
|
+ end;
|
|
|
+ add_terminator bb {e with eexpr = TThrow e1};
|
|
|
+ end
|
|
|
+ (* side_effects *)
|
|
|
+ | TCall({eexpr = TLocal v},el) when is_really_unbound v ->
|
|
|
+ check_unbound_call v el;
|
|
|
+ add_texpr bb e;
|
|
|
+ bb
|
|
|
+ | TCall(e1,el) ->
|
|
|
+ let bb,e = call bb e e1 el in
|
|
|
+ add_texpr bb e;
|
|
|
+ bb
|
|
|
+ | TNew(c,tl,el) ->
|
|
|
+ let bb,el = ordered_value_list bb el in
|
|
|
+ add_texpr bb {e with eexpr = TNew(c,tl,el)};
|
|
|
+ bb
|
|
|
+ | TCast(e1,Some mt) ->
|
|
|
+ let b,e1 = value bb e1 in
|
|
|
+ add_texpr bb {e with eexpr = TCast(e1,Some mt)};
|
|
|
+ bb
|
|
|
+ | TBinop((OpAssign | OpAssignOp _) as op,({eexpr = TArray(e1,e2)} as ea),e3) ->
|
|
|
+ let bb,e1,e2,e3 = match ordered_value_list bb [e1;e2;e3] with
|
|
|
+ | bb,[e1;e2;e3] -> bb,e1,e2,e3
|
|
|
+ | _ -> assert false
|
|
|
+ in
|
|
|
+ add_texpr bb {e with eexpr = TBinop(op,{ea with eexpr = TArray(e1,e2)},e3)};
|
|
|
+ bb
|
|
|
+ | TBinop((OpAssign | OpAssignOp _ as op),e1,e2) ->
|
|
|
+ let bb,e1 = value bb e1 in
|
|
|
+ let bb,e2 = value bb e2 in
|
|
|
+ add_texpr bb {e with eexpr = TBinop(op,e1,e2)};
|
|
|
+ bb
|
|
|
+ | TUnop((Increment | Decrement as op),flag,e1) ->
|
|
|
+ let bb,e1 = value bb e1 in
|
|
|
+ add_texpr bb {e with eexpr = TUnop(op,flag,e1)};
|
|
|
+ bb
|
|
|
+ | TLocal _ when not ctx.config.AnalyzerConfig.local_dce ->
|
|
|
+ add_texpr bb e;
|
|
|
+ bb
|
|
|
+ (* no-side-effect *)
|
|
|
+ | TEnumParameter _ | TFunction _ | TConst _ | TTypeExpr _ | TLocal _ ->
|
|
|
+ bb
|
|
|
+ (* no-side-effect composites *)
|
|
|
+ | TParenthesis e1 | TMeta(_,e1) | TCast(e1,None) | TField(e1,_) | TUnop(_,_,e1) ->
|
|
|
+ block_element bb e1
|
|
|
+ | TArray(e1,e2) | TBinop(_,e1,e2) ->
|
|
|
+ let bb = block_element bb e1 in
|
|
|
+ block_element bb e2
|
|
|
+ | TArrayDecl el ->
|
|
|
+ block_el bb el
|
|
|
+ | TObjectDecl fl ->
|
|
|
+ block_el bb (List.map snd fl)
|
|
|
+ | TFor _ | TWhile(_,_,DoWhile) ->
|
|
|
+ assert false
|
|
|
+ and block_el bb el =
|
|
|
+ match !b_try_stack with
|
|
|
+ | [] ->
|
|
|
+ let rec loop bb el = match el with
|
|
|
+ | [] -> bb
|
|
|
+ | e :: el ->
|
|
|
+ let bb = block_element bb e in
|
|
|
+ if bb == g.g_unreachable then bb else loop bb el
|
|
|
+ in
|
|
|
+ loop bb el
|
|
|
+ | bbl ->
|
|
|
+ let rec loop bb el = match el with
|
|
|
+ | [] -> bb
|
|
|
+ | e :: el ->
|
|
|
+ let bb = if not (can_throw e) then
|
|
|
+ block_element bb e
|
|
|
+ else begin
|
|
|
+ let bb' = create_node BKNormal e.etype e.epos in
|
|
|
+ add_cfg_edge bb bb' CFGGoto;
|
|
|
+ List.iter (fun bb_exc -> add_cfg_edge bb bb_exc CFGMaybeThrow) bbl;
|
|
|
+ set_syntax_edge bb (SEMerge bb');
|
|
|
+ close_node g bb;
|
|
|
+ block_element bb' e
|
|
|
+ end in
|
|
|
+ if bb == g.g_unreachable then bb else loop bb el
|
|
|
+ in
|
|
|
+ loop bb el
|
|
|
+ and block bb e =
|
|
|
+ let el = match e.eexpr with
|
|
|
+ | TBlock el -> el
|
|
|
+ | _ -> [e]
|
|
|
+ in
|
|
|
+ block_el bb el
|
|
|
+ in
|
|
|
+ let bb_last = block bb_root tf.tf_expr in
|
|
|
+ close_node g bb_last;
|
|
|
+ add_cfg_edge bb_last bb_exit CFGGoto; (* implied return *)
|
|
|
+ close_node g bb_exit;
|
|
|
+ bb_root,bb_exit
|
|
|
+
|
|
|
+let from_texpr com config e =
|
|
|
+ let g = Graph.create e.etype e.epos in
|
|
|
+ let tf,is_real_function = match e.eexpr with
|
|
|
+ | TFunction tf ->
|
|
|
+ tf,true
|
|
|
+ | _ ->
|
|
|
+ (* Wrap expression in a function so we don't have to treat it as a special case throughout. *)
|
|
|
+ let e = mk (TReturn (Some e)) t_dynamic e.epos in
|
|
|
+ let tf = { tf_args = []; tf_type = e.etype; tf_expr = e; } in
|
|
|
+ tf,false
|
|
|
+ in
|
|
|
+ let ctx = {
|
|
|
+ com = com;
|
|
|
+ config = config;
|
|
|
+ graph = g;
|
|
|
+ (* For CPP we want to use variable names which are "probably" not used by users in order to
|
|
|
+ avoid problems with the debugger, see https://github.com/HaxeFoundation/hxcpp/issues/365 *)
|
|
|
+ temp_var_name = (match com.platform with Cpp -> "_hx_tmp" | _ -> "tmp");
|
|
|
+ is_real_function = is_real_function;
|
|
|
+ entry = g.g_unreachable;
|
|
|
+ has_unbound = false;
|
|
|
+ loop_counter = 0;
|
|
|
+ loop_stack = [];
|
|
|
+ } in
|
|
|
+ let bb_func,bb_exit = func ctx g.g_root tf e.etype e.epos in
|
|
|
+ ctx.entry <- bb_func;
|
|
|
+ close_node g g.g_root;
|
|
|
+ g.g_exit <- bb_exit;
|
|
|
+ set_syntax_edge bb_exit SEEnd;
|
|
|
+ ctx
|
|
|
+
|
|
|
+let rec block_to_texpr_el ctx bb =
|
|
|
+ if bb.bb_dominator == ctx.graph.g_unreachable then
|
|
|
+ []
|
|
|
+ else begin
|
|
|
+ let block bb = block_to_texpr ctx bb in
|
|
|
+ let rec loop bb se =
|
|
|
+ let el = List.rev (DynArray.to_list bb.bb_el) in
|
|
|
+ match el,se with
|
|
|
+ | el,SESubBlock(bb_sub,bb_next) ->
|
|
|
+ Some bb_next,(block bb_sub) :: el
|
|
|
+ | el,SEMerge bb_next ->
|
|
|
+ Some bb_next,el
|
|
|
+ | el,(SEEnd | SENone) ->
|
|
|
+ None,el
|
|
|
+ | {eexpr = TWhile(e1,_,flag)} as e :: el,(SEWhile(_,bb_body,bb_next)) ->
|
|
|
+ let e2 = block bb_body in
|
|
|
+ Some bb_next,{e with eexpr = TWhile(e1,e2,flag)} :: el
|
|
|
+ | el,SETry(bb_try,_,bbl,bb_next) ->
|
|
|
+ Some bb_next,(mk (TTry(block bb_try,List.map (fun (v,bb) -> v,block bb) bbl)) ctx.com.basic.tvoid bb_try.bb_pos) :: el
|
|
|
+ | e1 :: el,se ->
|
|
|
+ let e1 = Texpr.skip e1 in
|
|
|
+ let bb_next,e1_def,t = match se with
|
|
|
+ | SEIfThen(bb_then,bb_next) -> Some bb_next,TIf(e1,block bb_then,None),ctx.com.basic.tvoid
|
|
|
+ | SEIfThenElse(bb_then,bb_else,bb_next,t) -> Some bb_next,TIf(e1,block bb_then,Some (block bb_else)),t
|
|
|
+ | SESwitch(bbl,bo,bb_next) -> Some bb_next,TSwitch(e1,List.map (fun (el,bb) -> el,block bb) bbl,Option.map block bo),ctx.com.basic.tvoid
|
|
|
+ | _ -> error (Printf.sprintf "Invalid node exit: %s" (s_expr_pretty e1)) bb.bb_pos
|
|
|
+ in
|
|
|
+ bb_next,(mk e1_def t e1.epos) :: el
|
|
|
+ | [],_ ->
|
|
|
+ None,[]
|
|
|
+ in
|
|
|
+ let bb_next,el = loop bb bb.bb_syntax_edge in
|
|
|
+ let el = match bb_next with
|
|
|
+ | None -> el
|
|
|
+ | Some bb -> (block_to_texpr_el ctx bb) @ el
|
|
|
+ in
|
|
|
+ el
|
|
|
+ end
|
|
|
+
|
|
|
+and block_to_texpr ctx bb =
|
|
|
+ assert(bb.bb_closed);
|
|
|
+ let el = block_to_texpr_el ctx bb in
|
|
|
+ let e = mk (TBlock (List.rev el)) bb.bb_type bb.bb_pos in
|
|
|
+ e
|
|
|
+
|
|
|
+and func ctx i =
|
|
|
+ let bb,t,p,tf = Hashtbl.find ctx.graph.g_functions i in
|
|
|
+ let e = block_to_texpr ctx bb in
|
|
|
+ let rec loop e = match e.eexpr with
|
|
|
+ | TLocal v when not (is_unbound v) ->
|
|
|
+ {e with eexpr = TLocal (get_var_origin ctx.graph v)}
|
|
|
+ | TVar(v,eo) when not (is_unbound v) ->
|
|
|
+ let eo = Option.map loop eo in
|
|
|
+ let v' = get_var_origin ctx.graph v in
|
|
|
+ {e with eexpr = TVar(v',eo)}
|
|
|
+ | TBinop(OpAssign,e1,({eexpr = TBinop(op,e2,e3)} as e4)) ->
|
|
|
+ let e1 = loop e1 in
|
|
|
+ let e2 = loop e2 in
|
|
|
+ let e3 = loop e3 in
|
|
|
+ let is_valid_assign_op = function
|
|
|
+ | OpAdd | OpMult | OpDiv | OpSub | OpAnd
|
|
|
+ | OpOr | OpXor | OpShl | OpShr | OpUShr | OpMod ->
|
|
|
+ true
|
|
|
+ | OpAssignOp _ | OpInterval | OpArrow | OpAssign | OpEq
|
|
|
+ | OpNotEq | OpGt | OpGte | OpLt | OpLte | OpBoolAnd | OpBoolOr ->
|
|
|
+ false
|
|
|
+ in
|
|
|
+ begin match e1.eexpr,e2.eexpr with
|
|
|
+ | TLocal v1,TLocal v2 when v1 == v2 && is_valid_assign_op op ->
|
|
|
+ begin match op,e3.eexpr with
|
|
|
+ | OpAdd,TConst (TInt i32) when Int32.to_int i32 = 1 -> {e with eexpr = TUnop(Increment,Prefix,e1)}
|
|
|
+ | OpSub,TConst (TInt i32) when Int32.to_int i32 = 1 -> {e with eexpr = TUnop(Decrement,Prefix,e1)}
|
|
|
+ | _ -> {e with eexpr = TBinop(OpAssignOp op,e1,e3)}
|
|
|
+ end
|
|
|
+ | _ ->
|
|
|
+ {e with eexpr = TBinop(OpAssign,e1,{e4 with eexpr = TBinop(op,e2,e3)})}
|
|
|
+ end
|
|
|
+ | TCall({eexpr = TConst (TString "fun")},[{eexpr = TConst (TInt i32)}]) ->
|
|
|
+ func ctx (Int32.to_int i32)
|
|
|
+ | TCall({eexpr = TLocal v},_) when is_really_unbound v ->
|
|
|
+ e
|
|
|
+ | _ ->
|
|
|
+ Type.map_expr loop e
|
|
|
+ in
|
|
|
+ let e = loop e in
|
|
|
+ mk (TFunction {tf with tf_expr = e}) t p
|
|
|
+
|
|
|
+let to_texpr ctx =
|
|
|
+ func ctx ctx.entry.bb_id
|
Simon Krajewski