Browse Source

[analyzer] move some things arounds in Fusion

Simon Krajewski 2 years ago
parent
commit
e77c4b803e
1 changed files with 237 additions and 232 deletions
  1. 237 232
      src/optimization/analyzerTexpr.ml

+ 237 - 232
src/optimization/analyzerTexpr.ml

@@ -518,76 +518,273 @@ module Fusion = struct
 			| Cs when is_null e1.etype || is_null e2.etype -> false (* C# hates OpAssignOp on Null<T> *)
 			| _ -> true
 
-	let apply actx e =
+	let handle_assigned_local actx v1 e1 el =
 		let config = actx.AnalyzerTypes.config in
 		let com = actx.com in
-		let state = new fusion_state in
-		actx.with_timer ["<-";"fusion";"infer_from_texpr"] (fun () -> state#infer_from_texpr e);
-		(* Handles block-level expressions, e.g. by removing side-effect-free ones and recursing into compound constructs like
-		   array or object declarations. The resulting element list is reversed.
-		   INFO: `el` is a reversed list of expressions in a block.
-		*)
-		let rec block_element ?(loop_bottom=false) acc el = match el with
+		let found = ref false in
+		let blocked = ref false in
+		let ir = InterferenceReport.from_texpr e1 in
+		if config.fusion_debug then print_endline (Printf.sprintf "INTERFERENCE: %s\nINTO: %s"
+			(InterferenceReport.to_string ir) (Type.s_expr_pretty true "" false (s_type (print_context())) (mk (TBlock el) t_dynamic null_pos)));
+		(* This function walks the AST in order of evaluation and tries to find an occurrence of v1. If successful, that occurrence is
+		replaced with e1. If there's an interference "on the way" the replacement is canceled. *)
+		let rec replace e =
+			let explore e =
+				let old = !blocked in
+				blocked := true;
+				let e = replace e in
+				blocked := old;
+				e
+			in
+			let handle_el' el =
+				(* This mess deals with the fact that the order of evaluation is undefined for call
+					arguments on these targets. Even if we find a replacement, we pretend that we
+					didn't in order to find possible interferences in later call arguments. *)
+				let temp_found = false in
+				let really_found = ref !found in
+				let el = List.map (fun e ->
+					found := temp_found;
+					let e = replace e in
+					if !found then really_found := true;
+					e
+				) el in
+				found := !really_found;
+				el
+			in
+			let handle_el = if not (target_handles_side_effect_order com) then handle_el' else List.map replace in
+			let handle_call e2 el = match com.platform with
+				| Neko ->
+					(* Neko has this reversed at the moment (issue #4787) *)
+					let el = List.map replace el in
+					let e2 = replace e2 in
+					e2,el
+				| Cpp ->
+					let e2 = replace e2 in
+					let el = handle_el el in
+					e2,el
+				| _ ->
+					let e2 = replace e2 in
+					let el = List.map replace el in
+					e2,el
+			in
+			if !found then e else match e.eexpr with
+				| TWhile _ | TTry _ ->
+					raise Exit
+				| TFunction _ ->
+					e
+				| TIf(e1,e2,eo) ->
+					let e1 = replace e1 in
+					if not !found && (has_state_write ir || has_any_field_write ir || has_any_var_write ir) then raise Exit;
+					let e2 = replace e2 in
+					let eo = Option.map replace eo in
+					{e with eexpr = TIf(e1,e2,eo)}
+				| TSwitch switch ->
+					let e1 = match com.platform with
+						| Lua | Python -> explore switch.switch_subject
+						| _ -> replace switch.switch_subject
+					in
+					if not !found then raise Exit;
+					let switch = { switch with switch_subject = e1 } in
+					{e with eexpr = TSwitch switch}
+				(* locals *)
+				| TLocal v2 when v1 == v2 && not !blocked ->
+					found := true;
+					if type_change_ok com v1.v_type e1.etype then e1 else mk (TCast(e1,None)) v1.v_type e.epos
+				| TLocal v ->
+					if has_var_write ir v || ((has_var_flag v VCaptured || ExtType.has_reference_semantics v.v_type) && (has_state_write ir)) then raise Exit;
+					e
+				| TBinop(OpAssign,({eexpr = TLocal v} as e1),e2) ->
+					let e2 = replace e2 in
+					if not !found && has_var_read ir v then raise Exit;
+					{e with eexpr = TBinop(OpAssign,e1,e2)}
+				(* Never fuse into write-positions (issue #7298) *)
+				| TBinop(OpAssignOp _,{eexpr = TLocal v2},_) | TUnop((Increment | Decrement),_,{eexpr = TLocal v2}) when v1 == v2 ->
+					raise Exit
+				| TBinop(OpAssignOp _ as op,({eexpr = TLocal v} as e1),e2) ->
+					let e2 = replace e2 in
+					if not !found && (has_var_read ir v || has_var_write ir v) then raise Exit;
+					{e with eexpr = TBinop(op,e1,e2)}
+				| TUnop((Increment | Decrement),_,{eexpr = TLocal v}) when has_var_read ir v || has_var_write ir v ->
+					raise Exit
+				(* fields *)
+				| TField(e1,fa) ->
+					let e1 = replace e1 in
+					if not !found && not (is_read_only_field_access e1 fa) && (has_field_write ir (field_name fa) || has_state_write ir) then raise Exit;
+					{e with eexpr = TField(e1,fa)}
+				| TBinop(OpAssign,({eexpr = TField(e1,fa)} as ef),e2) ->
+					let e1 = replace e1 in
+					let e2 = replace e2 in
+					if not !found && (has_field_read ir (field_name fa) || has_state_read ir) then raise Exit;
+					{e with eexpr = TBinop(OpAssign,{ef with eexpr = TField(e1,fa)},e2)}
+				| TBinop(OpAssignOp _ as op,({eexpr = TField(e1,fa)} as ef),e2) ->
+					let e1 = replace e1 in
+					let s = field_name fa in
+					if not !found && (has_field_write ir s || has_state_write ir) then raise Exit;
+					let e2 = replace e2 in
+					if not !found && (has_field_read ir s || has_state_read ir) then raise Exit;
+					{e with eexpr = TBinop(op,{ef with eexpr = TField(e1,fa)},e2)}
+				| TUnop((Increment | Decrement),_,{eexpr = TField(e1,fa)}) when has_field_read ir (field_name fa) || has_state_read ir
+					|| has_field_write ir (field_name fa) || has_state_write ir ->
+					raise Exit
+				(* array *)
+				| TArray(e1,e2) ->
+					let e1 = replace e1 in
+					let e2 = replace e2 in
+					if not !found && has_state_write ir then raise Exit;
+					{e with eexpr = TArray(e1,e2)}
+				| TBinop(OpAssign,({eexpr = TArray(e1,e2)} as ef),e3) ->
+					let e1 = replace e1 in
+					let e2 = replace e2 in
+					let e3 = replace e3 in
+					if not !found && (has_state_read ir) then raise Exit;
+					{e with eexpr = TBinop(OpAssign,{ef with eexpr = TArray(e1,e2)},e3)}
+				| TBinop(OpAssignOp _ as op,({eexpr = TArray(e1,e2)} as ef),e3) ->
+					let e1 = replace e1 in
+					let e2 = replace e2 in
+					if not !found && has_state_write ir then raise Exit;
+					let e3 = replace e3 in
+					if not !found && has_state_read ir then raise Exit;
+					{e with eexpr = TBinop(op,{ef with eexpr = TArray(e1,e2)},e3)}
+				| TUnop((Increment | Decrement),_,{eexpr = TArray _}) when has_state_read ir || has_state_write ir ->
+					raise Exit
+				(* state *)
+				| TCall({eexpr = TIdent s},el) when not (is_unbound_call_that_might_have_side_effects s el) ->
+					e
+				| TNew(c,tl,el) when (match c.cl_constructor with Some cf when PurityState.is_pure c cf -> true | _ -> false) ->
+					let el = handle_el el in
+					if not !found && (has_state_write ir || has_any_field_write ir) then raise Exit;
+					{e with eexpr = TNew(c,tl,el)}
+				| TNew(c,tl,el) ->
+					let el = handle_el el in
+					if not !found && (has_state_write ir || has_state_read ir || has_any_field_read ir || has_any_field_write ir) then raise Exit;
+					{e with eexpr = TNew(c,tl,el)}
+				| TCall({eexpr = TField(_,FEnum _)} as ef,el) ->
+					let el = handle_el el in
+					{e with eexpr = TCall(ef,el)}
+				| TCall({eexpr = TField(_,fa)} as ef,el) when PurityState.is_pure_field_access fa ->
+					let ef,el = handle_call ef el in
+					if not !found && (has_state_write ir || has_any_field_write ir) then raise Exit;
+					{e with eexpr = TCall(ef,el)}
+				| TCall(e1,el) ->
+					let e1,el = match e1.eexpr with
+						| TIdent s when s <> "`trace" && s <> "__int__" -> e1,el
+						| _ -> handle_call e1 el
+					in
+					if not !found && (((has_state_read ir || has_any_field_read ir)) || has_state_write ir || has_any_field_write ir) then raise Exit;
+					{e with eexpr = TCall(e1,el)}
+				| TObjectDecl fl ->
+					(* The C# generator has trouble with evaluation order in structures (#7531). *)
+					let el = (match com.platform with Cs -> handle_el' | _ -> handle_el) (List.map snd fl) in
+					if not !found && (has_state_write ir || has_any_field_write ir) then raise Exit;
+					{e with eexpr = TObjectDecl (List.map2 (fun (s,_) e -> s,e) fl el)}
+				| TArrayDecl el ->
+					let el = handle_el el in
+					(*if not !found && (has_state_write ir || has_any_field_write ir) then raise Exit;*)
+					{e with eexpr = TArrayDecl el}
+				| TBinop(op,e1,e2) when (match com.platform with Cpp -> true | _ -> false) ->
+					let e1 = replace e1 in
+					let temp_found = !found in
+					found := false;
+					let e2 = replace e2 in
+					found := !found || temp_found;
+					{e with eexpr = TBinop(op,e1,e2)}
+				| _ ->
+					Type.map_expr replace e
+		in
+		let replace e =
+			actx.with_timer ["<-";"fusion";"fuse";"replace"] (fun () -> replace e)
+		in
+		begin try
+			let rec loop acc el = match el with
+				| e :: el ->
+					let e = replace e in
+					if !found then (List.rev (e :: acc)) @ el
+					else loop (e :: acc) el
+				| [] ->
+					List.rev acc
+			in
+			let el = loop [] el in
+			if not !found then raise Exit;
+			if config.fusion_debug then print_endline (Printf.sprintf "YES: %s" (s_expr_pretty (mk (TBlock el) t_dynamic null_pos)));
+			Some el
+		with Exit ->
+			if config.fusion_debug then print_endline (Printf.sprintf "NO: %s" (Printexc.get_backtrace()));
+			None
+		end
+
+	(* Handles block-level expressions, e.g. by removing side-effect-free ones and recursing into compound constructs like
+		array or object declarations. The resulting element list is reversed.
+		INFO: `el` is a reversed list of expressions in a block.
+	*)
+	let rec block_element config state loop_bottom acc el =
+		let rec loop acc el = match el with
 			| {eexpr = TBinop(OpAssign, { eexpr = TLocal v1 }, { eexpr = TLocal v2 })} :: el when v1 == v2 ->
-				block_element acc el
+				loop acc el
 			| {eexpr = TBinop((OpAssign | OpAssignOp _),_,_) | TUnop((Increment | Decrement),_,_)} as e1 :: el ->
-				block_element (e1 :: acc) el
+				loop (e1 :: acc) el
 			| {eexpr = TLocal _} as e1 :: el when not config.local_dce ->
-				block_element (e1 :: acc) el
+				loop (e1 :: acc) el
 			| {eexpr = TLocal v} :: el ->
 				state#dec_reads v;
-				block_element acc el
+				loop acc el
 			| {eexpr = TField (_,fa)} as e1 :: el when PurityState.is_explicitly_impure fa ->
-				block_element (e1 :: acc) el
+				loop (e1 :: acc) el
 			(* no-side-effect *)
 			| {eexpr = TFunction _ | TConst _ | TTypeExpr _} :: el ->
-				block_element acc el
+				loop acc el
 			| {eexpr = TMeta((Meta.Pure,_,_),_)} :: el ->
-				block_element acc el
+				loop acc el
 			| {eexpr = TCall({eexpr = TField(e1,fa)},el1)} :: el2 when PurityState.is_pure_field_access fa && config.local_dce ->
-				block_element acc (e1 :: el1 @ el2)
+				loop acc (e1 :: el1 @ el2)
 			| {eexpr = TNew(c,tl,el1)} :: el2 when (match c.cl_constructor with Some cf when PurityState.is_pure c cf -> true | _ -> false) && config.local_dce ->
-				block_element acc (el1 @ el2)
+				loop acc (el1 @ el2)
 			| {eexpr = TIf ({ eexpr = TConst (TBool t) },e1,e2)} :: el ->
 				if t then
-					block_element acc (e1 :: el)
+					loop acc (e1 :: el)
 				else begin match e2 with
 					| None ->
-						block_element acc el
+						loop acc el
 					| Some e ->
-						block_element acc (e :: el)
+						loop acc (e :: el)
 				end
 			| ({eexpr = TSwitch switch} as e) :: el ->
 				begin match Optimizer.check_constant_switch switch with
-				| Some e -> block_element acc (e :: el)
-				| None -> block_element (e :: acc) el
+				| Some e -> loop acc (e :: el)
+				| None -> loop (e :: acc) el
 				end
 			(* no-side-effect composites *)
 			| {eexpr = TParenthesis e1 | TMeta(_,e1) | TCast(e1,None) | TField(e1,_) | TUnop(_,_,e1) | TEnumIndex e1 | TEnumParameter(e1,_,_)} :: el ->
-				block_element acc (e1 :: el)
+				loop acc (e1 :: el)
 			| {eexpr = TArray(e1,e2) | TBinop(_,e1,e2)} :: el ->
-				block_element acc (e1 :: e2 :: el)
+				loop acc (e1 :: e2 :: el)
 			| {eexpr = TArrayDecl el1 | TCall({eexpr = TField(_,FEnum _)},el1)} :: el2 -> (* TODO: check e1 of FEnum *)
-				block_element acc (el1 @ el2)
+				loop acc (el1 @ el2)
 			| {eexpr = TObjectDecl fl} :: el ->
-				block_element acc ((List.map snd fl) @ el)
+				loop acc ((List.map snd fl) @ el)
 			| {eexpr = TIf(e1,e2,None)} :: el when not (has_side_effect e2) ->
-				block_element acc (e1 :: el)
+				loop acc (e1 :: el)
 			| {eexpr = TIf(e1,e2,Some e3)} :: el when not (has_side_effect e2) && not (has_side_effect e3) ->
-				block_element acc (e1 :: el)
+				loop acc (e1 :: el)
 			| {eexpr = TBlock [e1]} :: el ->
-				block_element acc (e1 :: el)
+				loop acc (e1 :: el)
 			| {eexpr = TBlock []} :: el ->
-				block_element acc el
+				loop acc el
 			| { eexpr = TContinue } :: el when loop_bottom ->
-				block_element [] el
+				loop [] el
 			| e1 :: el ->
-				block_element (e1 :: acc) el
+				loop (e1 :: acc) el
 			| [] ->
 				acc
 		in
-		let block_element ?(loop_bottom=false) acc el =
-			actx.with_timer ["<-";"fusion";"block_element"] (fun () -> block_element ~loop_bottom acc el)
+		loop acc el
+
+	let apply actx e =
+		let config = actx.AnalyzerTypes.config in
+		let com = actx.com in
+		let state = new fusion_state in
+		actx.with_timer ["<-";"fusion";"infer_from_texpr"] (fun () -> state#infer_from_texpr e);
+		let block_element loop_bottom acc el =
+			actx.with_timer ["<-";"fusion";"block_element"] (fun () -> block_element config state loop_bottom acc el)
 		in
 		let can_be_fused v e =
 			let num_uses = state#get_reads v in
@@ -624,200 +821,6 @@ module Fusion = struct
 			end;
 			b
 		in
-		let handle_assigned_local v1 e1 el =
-			let found = ref false in
-			let blocked = ref false in
-			let ir = InterferenceReport.from_texpr e1 in
-			if config.fusion_debug then print_endline (Printf.sprintf "INTERFERENCE: %s\nINTO: %s"
-				(InterferenceReport.to_string ir) (Type.s_expr_pretty true "" false (s_type (print_context())) (mk (TBlock el) t_dynamic null_pos)));
-			(* This function walks the AST in order of evaluation and tries to find an occurrence of v1. If successful, that occurrence is
-			replaced with e1. If there's an interference "on the way" the replacement is canceled. *)
-			let rec replace e =
-				let explore e =
-					let old = !blocked in
-					blocked := true;
-					let e = replace e in
-					blocked := old;
-					e
-				in
-				let handle_el' el =
-					(* This mess deals with the fact that the order of evaluation is undefined for call
-						arguments on these targets. Even if we find a replacement, we pretend that we
-						didn't in order to find possible interferences in later call arguments. *)
-					let temp_found = false in
-					let really_found = ref !found in
-					let el = List.map (fun e ->
-						found := temp_found;
-						let e = replace e in
-						if !found then really_found := true;
-						e
-					) el in
-					found := !really_found;
-					el
-				in
-				let handle_el = if not (target_handles_side_effect_order com) then handle_el' else List.map replace in
-				let handle_call e2 el = match com.platform with
-					| Neko ->
-						(* Neko has this reversed at the moment (issue #4787) *)
-						let el = List.map replace el in
-						let e2 = replace e2 in
-						e2,el
-					| Cpp ->
-						let e2 = replace e2 in
-						let el = handle_el el in
-						e2,el
-					| _ ->
-						let e2 = replace e2 in
-						let el = List.map replace el in
-						e2,el
-				in
-				if !found then e else match e.eexpr with
-					| TWhile _ | TTry _ ->
-						raise Exit
-					| TFunction _ ->
-						e
-					| TIf(e1,e2,eo) ->
-						let e1 = replace e1 in
-						if not !found && (has_state_write ir || has_any_field_write ir || has_any_var_write ir) then raise Exit;
-						let e2 = replace e2 in
-						let eo = Option.map replace eo in
-						{e with eexpr = TIf(e1,e2,eo)}
-					| TSwitch switch ->
-						let e1 = match com.platform with
-							| Lua | Python -> explore switch.switch_subject
-							| _ -> replace switch.switch_subject
-						in
-						if not !found then raise Exit;
-						let switch = { switch with switch_subject = e1 } in
-						{e with eexpr = TSwitch switch}
-					(* locals *)
-					| TLocal v2 when v1 == v2 && not !blocked ->
-						found := true;
-						if type_change_ok com v1.v_type e1.etype then e1 else mk (TCast(e1,None)) v1.v_type e.epos
-					| TLocal v ->
-						if has_var_write ir v || ((has_var_flag v VCaptured || ExtType.has_reference_semantics v.v_type) && (has_state_write ir)) then raise Exit;
-						e
-					| TBinop(OpAssign,({eexpr = TLocal v} as e1),e2) ->
-						let e2 = replace e2 in
-						if not !found && has_var_read ir v then raise Exit;
-						{e with eexpr = TBinop(OpAssign,e1,e2)}
-					(* Never fuse into write-positions (issue #7298) *)
-					| TBinop(OpAssignOp _,{eexpr = TLocal v2},_) | TUnop((Increment | Decrement),_,{eexpr = TLocal v2}) when v1 == v2 ->
-						raise Exit
-					| TBinop(OpAssignOp _ as op,({eexpr = TLocal v} as e1),e2) ->
-						let e2 = replace e2 in
-						if not !found && (has_var_read ir v || has_var_write ir v) then raise Exit;
-						{e with eexpr = TBinop(op,e1,e2)}
-					| TUnop((Increment | Decrement),_,{eexpr = TLocal v}) when has_var_read ir v || has_var_write ir v ->
-						raise Exit
-					(* fields *)
-					| TField(e1,fa) ->
-						let e1 = replace e1 in
-						if not !found && not (is_read_only_field_access e1 fa) && (has_field_write ir (field_name fa) || has_state_write ir) then raise Exit;
-						{e with eexpr = TField(e1,fa)}
-					| TBinop(OpAssign,({eexpr = TField(e1,fa)} as ef),e2) ->
-						let e1 = replace e1 in
-						let e2 = replace e2 in
-						if not !found && (has_field_read ir (field_name fa) || has_state_read ir) then raise Exit;
-						{e with eexpr = TBinop(OpAssign,{ef with eexpr = TField(e1,fa)},e2)}
-					| TBinop(OpAssignOp _ as op,({eexpr = TField(e1,fa)} as ef),e2) ->
-						let e1 = replace e1 in
-						let s = field_name fa in
-						if not !found && (has_field_write ir s || has_state_write ir) then raise Exit;
-						let e2 = replace e2 in
-						if not !found && (has_field_read ir s || has_state_read ir) then raise Exit;
-						{e with eexpr = TBinop(op,{ef with eexpr = TField(e1,fa)},e2)}
-					| TUnop((Increment | Decrement),_,{eexpr = TField(e1,fa)}) when has_field_read ir (field_name fa) || has_state_read ir
-						|| has_field_write ir (field_name fa) || has_state_write ir ->
-						raise Exit
-					(* array *)
-					| TArray(e1,e2) ->
-						let e1 = replace e1 in
-						let e2 = replace e2 in
-						if not !found && has_state_write ir then raise Exit;
-						{e with eexpr = TArray(e1,e2)}
-					| TBinop(OpAssign,({eexpr = TArray(e1,e2)} as ef),e3) ->
-						let e1 = replace e1 in
-						let e2 = replace e2 in
-						let e3 = replace e3 in
-						if not !found && (has_state_read ir) then raise Exit;
-						{e with eexpr = TBinop(OpAssign,{ef with eexpr = TArray(e1,e2)},e3)}
-					| TBinop(OpAssignOp _ as op,({eexpr = TArray(e1,e2)} as ef),e3) ->
-						let e1 = replace e1 in
-						let e2 = replace e2 in
-						if not !found && has_state_write ir then raise Exit;
-						let e3 = replace e3 in
-						if not !found && has_state_read ir then raise Exit;
-						{e with eexpr = TBinop(op,{ef with eexpr = TArray(e1,e2)},e3)}
-					| TUnop((Increment | Decrement),_,{eexpr = TArray _}) when has_state_read ir || has_state_write ir ->
-						raise Exit
-					(* state *)
-					| TCall({eexpr = TIdent s},el) when not (is_unbound_call_that_might_have_side_effects s el) ->
-						e
-					| TNew(c,tl,el) when (match c.cl_constructor with Some cf when PurityState.is_pure c cf -> true | _ -> false) ->
-						let el = handle_el el in
-						if not !found && (has_state_write ir || has_any_field_write ir) then raise Exit;
-						{e with eexpr = TNew(c,tl,el)}
-					| TNew(c,tl,el) ->
-						let el = handle_el el in
-						if not !found && (has_state_write ir || has_state_read ir || has_any_field_read ir || has_any_field_write ir) then raise Exit;
-						{e with eexpr = TNew(c,tl,el)}
-					| TCall({eexpr = TField(_,FEnum _)} as ef,el) ->
-						let el = handle_el el in
-						{e with eexpr = TCall(ef,el)}
-					| TCall({eexpr = TField(_,fa)} as ef,el) when PurityState.is_pure_field_access fa ->
-						let ef,el = handle_call ef el in
-						if not !found && (has_state_write ir || has_any_field_write ir) then raise Exit;
-						{e with eexpr = TCall(ef,el)}
-					| TCall(e1,el) ->
-						let e1,el = match e1.eexpr with
-							| TIdent s when s <> "`trace" && s <> "__int__" -> e1,el
-							| _ -> handle_call e1 el
-						in
-						if not !found && (((has_state_read ir || has_any_field_read ir)) || has_state_write ir || has_any_field_write ir) then raise Exit;
-						{e with eexpr = TCall(e1,el)}
-					| TObjectDecl fl ->
-						(* The C# generator has trouble with evaluation order in structures (#7531). *)
-						let el = (match com.platform with Cs -> handle_el' | _ -> handle_el) (List.map snd fl) in
-						if not !found && (has_state_write ir || has_any_field_write ir) then raise Exit;
-						{e with eexpr = TObjectDecl (List.map2 (fun (s,_) e -> s,e) fl el)}
-					| TArrayDecl el ->
-						let el = handle_el el in
-						(*if not !found && (has_state_write ir || has_any_field_write ir) then raise Exit;*)
-						{e with eexpr = TArrayDecl el}
-					| TBinop(op,e1,e2) when (match com.platform with Cpp -> true | _ -> false) ->
-						let e1 = replace e1 in
-						let temp_found = !found in
-						found := false;
-						let e2 = replace e2 in
-						found := !found || temp_found;
-						{e with eexpr = TBinop(op,e1,e2)}
-					| _ ->
-						Type.map_expr replace e
-			in
-			let replace e =
-				actx.with_timer ["<-";"fusion";"fuse";"replace"] (fun () -> replace e)
-			in
-			begin try
-				let rec loop acc el = match el with
-					| e :: el ->
-						let e = replace e in
-						if !found then (List.rev (e :: acc)) @ el
-						else loop (e :: acc) el
-					| [] ->
-						List.rev acc
-				in
-				let el = loop [] el in
-				if not !found then raise Exit;
-				state#changed;
-				state#dec_reads v1;
-				if config.fusion_debug then print_endline (Printf.sprintf "YES: %s" (s_expr_pretty (mk (TBlock el) t_dynamic null_pos)));
-				Some el
-			with Exit ->
-				if config.fusion_debug then print_endline (Printf.sprintf "NO: %s" (Printexc.get_backtrace()));
-				None
-			end
-		in
 		let rec fuse acc el = match el with
 			| ({eexpr = TVar(v1,None)} as e1) :: {eexpr = TBinop(OpAssign,{eexpr = TLocal v2},e2)} :: el when v1 == v2 ->
 				state#changed;
@@ -914,8 +917,10 @@ module Fusion = struct
 						fuse (ev :: acc) (e2 :: el)
 					end
 				| _ ->
-					begin match handle_assigned_local v1 e1 el with
+					begin match handle_assigned_local actx v1 e1 el with
 					| Some el ->
+						state#changed;
+						state#dec_reads v1;
 						fuse acc el
 					| None ->
 						fuse (ev :: acc) el
@@ -986,14 +991,14 @@ module Fusion = struct
 				Type.map_expr loop e
 		and block loop_body el t p =
 			let el = List.rev_map loop el in
-			let el = block_element ~loop_bottom:loop_body [] el in
+			let el = block_element loop_body [] el in
 			(* fuse flips element order, but block_element doesn't care and flips it back *)
 			let el = fuse [] el in
-			let el = block_element [] el in
+			let el = block_element false [] el in
 			let rec fuse_loop el =
 				state#reset;
 				let el = fuse [] el in
-				let el = block_element [] el in
+				let el = block_element false [] el in
 				if state#did_change then fuse_loop el else el
 			in
 			let el = fuse_loop el in