Browse Source

[php7] reduce amount of generated temp vars (fixes #4760)

Alexander Kuzmenko 8 years ago
parent
commit
e2ee412d9b
5 changed files with 59 additions and 20 deletions
  1. 2 2
      src/context/common.ml
  2. 42 11
      src/generators/genphp7.ml
  3. 2 2
      src/main.ml
  4. 12 4
      src/optimization/analyzerTexpr.ml
  5. 1 1
      src/optimization/filters.ml

+ 2 - 2
src/context/common.ml

@@ -316,7 +316,7 @@ let get_signature com =
 		com.defines_signature <- Some s;
 		com.defines_signature <- Some s;
 		s
 		s
 
 
-let php7 com = com.platform = Php && PMap.exists "php7" com.defines
+let is_php7 com = com.platform = Php && PMap.exists "php7" com.defines
 
 
 module CompilationServer = struct
 module CompilationServer = struct
 	type cache = {
 	type cache = {
@@ -707,7 +707,7 @@ let get_config com =
 			pf_reserved_type_paths = [([],"Object");([],"Error")];
 			pf_reserved_type_paths = [([],"Object");([],"Error")];
 		}
 		}
 	| Php ->
 	| Php ->
-		if php7 com then
+		if is_php7 com then
 			{
 			{
 				default_config with
 				default_config with
 				pf_static = false;
 				pf_static = false;

+ 42 - 11
src/generators/genphp7.ml

@@ -684,6 +684,26 @@ let ensure_return_in_block block_expr =
 			{ block_expr with eexpr = TBlock (List.rev reversed) }
 			{ block_expr with eexpr = TBlock (List.rev reversed) }
 		| _ -> fail block_expr.epos (try assert false with Assert_failure mlpos -> mlpos)
 		| _ -> fail block_expr.epos (try assert false with Assert_failure mlpos -> mlpos)
 
 
+(**
+	If `expr` is a block, then return list of expressions in that block.
+	Otherwise returns a list with `expr` as a single item.
+*)
+let unpack_block expr =
+		match expr.eexpr with
+			| TBlock exprs -> exprs
+			| _ -> [ expr ]
+
+(**
+	If `expr` is a block of a single expression, then return that single expression.
+	If `expr` is a block with multiple expressions, fail compilation.
+	Otherwise return `expr` as-is.
+*)
+let unpack_single_expr_block expr =
+		match expr.eexpr with
+			| TBlock [ e ] -> e
+			| TBlock _ -> fail expr.epos (try assert false with Assert_failure mlpos -> mlpos)
+			| _ -> expr
+
 (**
 (**
 	Check if specified type has rtti meta
 	Check if specified type has rtti meta
 *)
 *)
@@ -1251,26 +1271,34 @@ class virtual type_builder ctx wrapper =
 		(**
 		(**
 			Indicates whether current expression nesting level is a top level of a block
 			Indicates whether current expression nesting level is a top level of a block
 		*)
 		*)
-		method private parent_expr_is_block =
-			let rec expr_is_block expr parents =
+		method private parent_expr_is_block single_expr_is_not_block =
+			let rec expr_is_block expr parents no_parent_is_block =
 				match expr.eexpr with
 				match expr.eexpr with
+					| TBlock [_] when single_expr_is_not_block ->
+						(match parents with
+							| { eexpr = TBlock _ } :: _ -> true
+							| { eexpr = TFunction _ } :: _ -> true
+							| _ :: _ -> false
+							| [] -> no_parent_is_block
+						)
 					| TBlock _ -> true
 					| TBlock _ -> true
 					| TIf (_, if_expr, Some else_expr) ->
 					| TIf (_, if_expr, Some else_expr) ->
-						if (expr_is_block if_expr []) || (expr_is_block else_expr []) then
+						if (expr_is_block if_expr [] false) || (expr_is_block else_expr [] false) then
 							true
 							true
 						else
 						else
 							(match parents with
 							(match parents with
-								| parent :: rest -> expr_is_block parent rest
+								| parent :: rest -> expr_is_block parent rest true
 								| [] -> false
 								| [] -> false
 							)
 							)
 					| TIf (_, _, None) -> true
 					| TIf (_, _, None) -> true
 					| TTry _ -> true
 					| TTry _ -> true
 					| TWhile _ -> true
 					| TWhile _ -> true
+					| TFor _ -> true
 					| TSwitch _ -> true
 					| TSwitch _ -> true
 					| _ -> false
 					| _ -> false
 			in
 			in
 			match expr_hierarchy with
 			match expr_hierarchy with
-				| _ :: parent :: rest -> expr_is_block parent rest
+				| _ :: parent :: rest -> expr_is_block parent rest true
 				| _ -> false
 				| _ -> false
 		(**
 		(**
 			Returns parent expression.
 			Returns parent expression.
@@ -1750,7 +1778,7 @@ class virtual type_builder ctx wrapper =
 				end
 				end
 			else
 			else
 				begin
 				begin
-					let inline_block = self#parent_expr_is_block in
+					let inline_block = self#parent_expr_is_block false in
 					self#write_as_block ~inline:inline_block block_expr
 					self#write_as_block ~inline:inline_block block_expr
 				end
 				end
 		(**
 		(**
@@ -2546,8 +2574,9 @@ class virtual type_builder ctx wrapper =
 			Writes ternary operator expressions to output buffer
 			Writes ternary operator expressions to output buffer
 		*)
 		*)
 		method private write_expr_ternary condition if_expr (else_expr:texpr) pos =
 		method private write_expr_ternary condition if_expr (else_expr:texpr) pos =
-			let parent_is_if = match self#parent_expr with Some { eexpr = TIf _ } -> true | _ -> false in
-			if parent_is_if then self#write "(";
+			let if_expr = unpack_single_expr_block if_expr
+			and else_expr = unpack_single_expr_block else_expr in
+			self#write "(";
 			(match condition.eexpr with
 			(match condition.eexpr with
 				| TParenthesis expr -> self#write_expr expr;
 				| TParenthesis expr -> self#write_expr expr;
 				| _ -> self#write_expr else_expr
 				| _ -> self#write_expr else_expr
@@ -2556,17 +2585,19 @@ class virtual type_builder ctx wrapper =
 			self#write_expr if_expr;
 			self#write_expr if_expr;
 			self#write " : ";
 			self#write " : ";
 			self#write_expr else_expr;
 			self#write_expr else_expr;
-			if parent_is_if then self#write ")"
+			self#write ")"
 		(**
 		(**
 			Writes "if...else..." expression to output buffer
 			Writes "if...else..." expression to output buffer
 		*)
 		*)
 		method private write_expr_if condition if_expr (else_expr:texpr option) =
 		method private write_expr_if condition if_expr (else_expr:texpr option) =
 			let is_ternary =
 			let is_ternary =
-				if self#parent_expr_is_block then
+				if self#parent_expr_is_block true then
 					false
 					false
 				else
 				else
 					match (if_expr.eexpr, else_expr) with
 					match (if_expr.eexpr, else_expr) with
-						| (TBlock _, _) | (_, Some { eexpr=TBlock _ }) -> false
+						| (TBlock exprs, _)  when (List.length exprs) > 1 -> false
+						| (_, Some { eexpr=TBlock exprs }) when (List.length exprs) > 1 -> false
+						| (_, None) -> false
 						| _ -> true
 						| _ -> true
 			in
 			in
 			if is_ternary then
 			if is_ternary then

+ 2 - 2
src/main.ml

@@ -277,7 +277,7 @@ module Initialize = struct
 				add_std "lua";
 				add_std "lua";
 				"lua"
 				"lua"
 			| Php ->
 			| Php ->
-				if Common.php7 com then
+				if Common.is_php7 com then
 					begin
 					begin
 						com.package_rules <- PMap.add "php" (Directory "php7") com.package_rules;
 						com.package_rules <- PMap.add "php" (Directory "php7") com.package_rules;
 						com.package_rules <- PMap.add "php7" Forbidden com.package_rules;
 						com.package_rules <- PMap.add "php7" Forbidden com.package_rules;
@@ -353,7 +353,7 @@ let generate tctx ext xml_out interp swf_header =
 		| Lua ->
 		| Lua ->
 			Genlua.generate,"lua"
 			Genlua.generate,"lua"
 		| Php ->
 		| Php ->
-			if Common.php7 com then
+			if Common.is_php7 com then
 				Genphp7.generate,"php"
 				Genphp7.generate,"php"
 			else
 			else
 				Genphp.generate,"php"
 				Genphp.generate,"php"

+ 12 - 4
src/optimization/analyzerTexpr.ml

@@ -123,7 +123,7 @@ let rec can_be_used_as_value com e =
 		(* | TCall _ | TNew _ when (match com.platform with Cpp | Php -> true | _ -> false) -> raise Exit *)
 		(* | TCall _ | TNew _ when (match com.platform with Cpp | Php -> true | _ -> false) -> raise Exit *)
 		| TReturn _ | TThrow _ | TBreak | TContinue -> raise Exit
 		| TReturn _ | TThrow _ | TBreak | TContinue -> raise Exit
 		| TUnop((Increment | Decrement),_,_) when not (target_handles_unops com) -> raise Exit
 		| TUnop((Increment | Decrement),_,_) when not (target_handles_unops com) -> raise Exit
-		| TNew _ when com.platform = Php && not (Common.php7 com) -> raise Exit
+		| TNew _ when com.platform = Php && not (Common.is_php7 com) -> raise Exit
 		| TFunction _ -> ()
 		| TFunction _ -> ()
 		| _ -> Type.iter loop e
 		| _ -> Type.iter loop e
 	in
 	in
@@ -634,7 +634,15 @@ module Fusion = struct
 				let e1 = {e1 with eexpr = TVar(v1,Some e2)} in
 				let e1 = {e1 with eexpr = TVar(v1,Some e2)} in
 				state#dec_writes v1;
 				state#dec_writes v1;
 				fuse (e1 :: acc) el
 				fuse (e1 :: acc) el
-			| ({eexpr = TVar(v1,None)} as e1) :: ({eexpr = TIf(eif,_,Some _)} as e2) :: el when can_be_used_as_value com e2 && not (ExtType.is_void e2.etype) && (match com.platform with Php -> false | Cpp when not (Common.defined com Define.Cppia) -> false | _ -> true) ->
+			| ({eexpr = TVar(v1,None)} as e1) :: ({eexpr = TIf(eif,_,Some _)} as e2) :: el
+				when
+					can_be_used_as_value com e2 &&
+					not (ExtType.is_void e2.etype) &&
+					(match com.platform with
+						| Php when not (Common.is_php7 com) -> false
+						| Cpp when not (Common.defined com Define.Cppia) -> false
+						| _ -> true)
+				->
 				begin try
 				begin try
 					let i = ref 0 in
 					let i = ref 0 in
 					let check_assign e = match e.eexpr with
 					let check_assign e = match e.eexpr with
@@ -689,7 +697,7 @@ module Fusion = struct
 							let el = List.map replace el in
 							let el = List.map replace el in
 							let e2 = replace e2 in
 							let e2 = replace e2 in
 							e2,el
 							e2,el
-						| Php | Cpp  when not (Common.defined com Define.Cppia) && not (Common.php7 com) ->
+						| Php | Cpp  when not (Common.defined com Define.Cppia) && not (Common.is_php7 com) ->
 							let is_php_safe e1 =
 							let is_php_safe e1 =
 								let rec loop e = match e.eexpr with
 								let rec loop e = match e.eexpr with
 									| TCall _ -> raise Exit
 									| TCall _ -> raise Exit
@@ -801,7 +809,7 @@ module Fusion = struct
 							let e3 = replace e3 in
 							let e3 = replace e3 in
 							if not !found && has_state_read ir then raise Exit;
 							if not !found && has_state_read ir then raise Exit;
 							{e with eexpr = TBinop(OpAssign,{ea with eexpr = TArray(e1,e2)},e3)}
 							{e with eexpr = TBinop(OpAssign,{ea with eexpr = TArray(e1,e2)},e3)}
-						| TBinop(op,e1,e2) when (match com.platform with Cpp | Php when not (Common.php7 com) -> true | _ -> false) ->
+						| TBinop(op,e1,e2) when (match com.platform with Cpp | Php when not (Common.is_php7 com) -> true | _ -> false) ->
 							let e1 = replace e1 in
 							let e1 = replace e1 in
 							let temp_found = !found in
 							let temp_found = !found in
 							found := false;
 							found := false;

+ 1 - 1
src/optimization/filters.ml

@@ -901,7 +901,7 @@ let add_meta_field ctx t = match t with
 			f.cf_expr <- Some e;
 			f.cf_expr <- Some e;
 			let can_deal_with_interface_metadata () = match ctx.com.platform with
 			let can_deal_with_interface_metadata () = match ctx.com.platform with
 				| Flash when Common.defined ctx.com Define.As3 -> false
 				| Flash when Common.defined ctx.com Define.As3 -> false
-				| Php when not (Common.php7 ctx.com) -> false
+				| Php when not (Common.is_php7 ctx.com) -> false
 				| _ -> true
 				| _ -> true
 			in
 			in
 			if c.cl_interface && not (can_deal_with_interface_metadata()) then begin
 			if c.cl_interface && not (can_deal_with_interface_metadata()) then begin