Browse Source

[analyzer] restructure var flags so we can store usage count; restrict TEnumParameter propagation to usage == 1

Simon Krajewski 10 years ago
parent
commit
86228d0a64
1 changed files with 85 additions and 45 deletions
  1. 85 45
      analyzer.ml

+ 85 - 45
analyzer.ml

@@ -592,42 +592,70 @@ module Ssa = struct
 			ctx.exception_stack <- List.tl ctx.exception_stack;
 		)
 
-	let get_origin_var v = match v.v_extra with
-		| Some (_,Some {eexpr = TArrayDecl ({eexpr = TLocal v'} :: _)}) -> v'
-		| _ -> raise Not_found
-
-	let set_origin_var v v_origin p =
-		let ev = mk_loc v_origin p in
-		let create tl =
-			let e_extra = mk (TArrayDecl [
-				ev
-			]) t_dynamic p in
-			v.v_extra <- Some (tl,Some e_extra)
-		in
+	let create_v_extra v =
 		match v.v_extra with
-		| Some (tl,Some ({eexpr = TArrayDecl (_ :: el)} as ee)) ->
-			v.v_extra <- Some(tl, Some {ee with eexpr = TArrayDecl (ev :: el)})
+		| Some (_,Some _) ->
+			()
 		| Some (tl,None) ->
-			create tl
+			let e_extra = mk (TObjectDecl []) t_dynamic null_pos in
+			v.v_extra <- Some (tl,Some e_extra)
 		| None ->
-			create []
+			let e_extra = mk (TObjectDecl []) t_dynamic null_pos in
+			v.v_extra <- Some ([],Some e_extra)
+
+	let set_v_extra_value v s e = match v.v_extra with
+		| Some (tl, Some {eexpr = TObjectDecl fl}) ->
+			let rec loop fl = match fl with
+				| (s',_) :: fl when s' = s ->
+					(s,e) :: fl
+				| f1 :: fl ->
+					f1 :: loop fl
+				| [] ->
+					[s,e]
+			in
+			let e_extra = mk (TObjectDecl (loop fl)) t_dynamic null_pos in
+			v.v_extra <- Some (tl, Some e_extra)
 		| _ ->
 			assert false
 
+	let get_origin_var v = match v.v_extra with
+		| Some (_,Some {eexpr = TObjectDecl fl}) ->
+			begin match List.assoc "origin_var" fl with
+				| {eexpr = TLocal v'} -> v'
+				| _ -> raise Not_found
+			end
+		| _ ->
+			raise Not_found
+
+	let set_origin_var v v_origin p =
+		let ev = mk_loc v_origin p in
+		set_v_extra_value v "origin_var" ev
+
 	let get_var_value v = match v.v_extra with
-		| Some (_,Some {eexpr = TArrayDecl (_ :: e :: _)}) -> e
-		| _ -> raise Not_found
+		| Some (_,Some {eexpr = TObjectDecl fl}) ->
+			List.assoc "var_value" fl
+		| _ ->
+			raise Not_found
 
 	let set_var_value v e =
-		match v.v_extra with
-		| Some (tl,Some ({eexpr = TArrayDecl (e1 :: el)} as ee)) ->
-			let el = match el with
-				| [] -> [e]
-				| _ :: el -> e :: el
-			in
-			v.v_extra <- Some (tl,Some {ee with eexpr = TArrayDecl (e1 :: el)})
+		set_v_extra_value v "var_value" e
+
+	let get_var_usage_count v = match v.v_extra with
+		| Some (_,Some {eexpr = TObjectDecl fl}) ->
+			begin try
+				begin match List.assoc "usage_count" fl with
+				| {eexpr = TConst (TInt i32)} -> Int32.to_int i32
+				| _ -> 0
+				end
+			with Not_found ->
+				0
+			end
 		| _ ->
-			assert false
+			raise Not_found
+
+	let set_var_usage_count v i =
+		let e = mk (TConst (TInt (Int32.of_int i))) t_dynamic null_pos in
+		set_v_extra_value v "usage_count" e
 
 	let declare_var ctx v p =
 		let old = v.v_extra in
@@ -636,6 +664,8 @@ module Ssa = struct
 		) :: ctx.cleanup;
 		ctx.cur_data.nd_var_map <- IntMap.add v.v_id v ctx.cur_data.nd_var_map;
 		v.v_meta <- ((Meta.Custom ":blockDepth",[EConst (Int (string_of_int ctx.block_depth)),p],p)) :: v.v_meta;
+		v.v_extra <- None;
+		create_v_extra v;
 		set_origin_var v v p
 
 	let assign_var ctx v e p =
@@ -650,6 +680,7 @@ module Ssa = struct
 					error "Something went wrong" p
 			in
 			let v' = alloc_var (Printf.sprintf "%s<%i>" v.v_name i) v.v_type in
+			create_v_extra v';
 			v'.v_meta <- [(Meta.Custom ":ssa"),[],p];
 			set_origin_var v' v p;
 			ctx.cur_data.nd_var_map <- IntMap.add v.v_id v' ctx.cur_data.nd_var_map;
@@ -729,7 +760,7 @@ module Ssa = struct
 			ctx.var_conds <- IntMap.add v.v_id [cond] ctx.var_conds
 		end
 
-	let apply_cond ctx = function
+(* 	let apply_cond ctx = function
 		| Equal({v_extra = Some(_,Some {eexpr = TLocal v})} as v0,e1) ->
 			let v' = assign_var ctx v (mk_loc v0 e1.epos) e1.epos in
 			append_cond ctx v' (Equal(v',e1)) e1.epos
@@ -739,27 +770,27 @@ module Ssa = struct
 		| _ -> ()
 
 	let apply_not_null_cond ctx v p =
-		apply_cond ctx (NotEqual(v,(mk (TConst TNull) t_dynamic p)))
+		apply_cond ctx (NotEqual(v,(mk (TConst TNull) t_dynamic p))) *)
 
 	let apply com e =
 		let rec handle_if ctx e econd eif eelse =
 			let econd = loop ctx econd in
-			let cond = eval_cond ctx econd in
+			(* let cond = eval_cond ctx econd in *)
 			let join = mk_join_node() in
 			let close = branch ctx eif.epos in
-			List.iter (apply_cond ctx) cond;
+			(* List.iter (apply_cond ctx) cond; *)
 			let eif = loop ctx eif in
 			close join;
 			let eelse = match eelse with
 				| None ->
-					let cond = invert_conds cond in
-					List.iter (apply_cond ctx) cond;
+					(* let cond = invert_conds cond in *)
+					(* List.iter (apply_cond ctx) cond; *)
 					add_branch join ctx.cur_data e.epos;
 					None
 				| Some e ->
 					let close = branch ctx e.epos in
-					let cond = invert_conds cond in
-					List.iter (apply_cond ctx) cond;
+					(* let cond = invert_conds cond in *)
+					(* List.iter (apply_cond ctx) cond; *)
 					let eelse = loop ctx e in
 					close join;
 					Some eelse
@@ -797,9 +828,9 @@ module Ssa = struct
 				let close = branch ctx e.epos in
 				List.iter (fun (v,co) ->
 					declare_var ctx v e.epos;
-					match co with
+(* 					match co with
 						| Some TNull when (match v.v_type with TType({t_path=["haxe"],"PosInfos"},_) -> false | _ -> true) -> ()
-						| _ -> apply_not_null_cond ctx v e.epos
+						| _ -> apply_not_null_cond ctx v e.epos *)
 				) tf.tf_args;
 				let e' = loop ctx tf.tf_expr in
 				close (mk_join_node());
@@ -865,7 +896,7 @@ module Ssa = struct
 				e
 			| TFor(v,e1,ebody) ->
 				declare_var ctx v e.epos;
-				apply_not_null_cond ctx v e1.epos;
+				(* apply_not_null_cond ctx v e1.epos; *)
 				let v' = IntMap.find v.v_id ctx.cur_data.nd_var_map in
 				let e1 = loop ctx e1 in
 				let ebody = handle_loop_body ctx ebody in
@@ -881,7 +912,7 @@ module Ssa = struct
 				close_join_node ctx join_ex e.epos;
 				let catches = List.map (fun (v,e) ->
 					declare_var ctx v e.epos;
-					apply_not_null_cond ctx v e.epos;
+					(* apply_not_null_cond ctx v e.epos; *)
 					let close = branch ctx e.epos in
 					let e = loop ctx e in
 					close join_bottom;
@@ -953,11 +984,13 @@ module Ssa = struct
 
 	let unapply com e =
 		let rec loop e = match e.eexpr with
-			| TFor(({v_extra = Some([],Some {eexpr = TArrayDecl ({eexpr = TLocal v'} :: _)})} as v),e1,e2) when Meta.has (Meta.Custom ":ssa") v.v_meta ->
+			| TFor(v,e1,e2) when Meta.has (Meta.Custom ":ssa") v.v_meta ->
+				let v' = get_origin_var v in
 				let e1 = loop e1 in
 				let e2 = loop e2 in
 				{e with eexpr = TFor(v',e1,e2)}
-			| TLocal ({v_extra = Some([],Some {eexpr = TArrayDecl ({eexpr = TLocal v'} :: _)})} as v) when Meta.has (Meta.Custom ":ssa") v.v_meta ->
+			| TLocal v when Meta.has (Meta.Custom ":ssa") v.v_meta ->
+				let v' = get_origin_var v in
 				{e with eexpr = TLocal v'}
 			| TBlock el ->
 				let rec filter e = match e.eexpr with
@@ -993,7 +1026,7 @@ module ConstPropagation = struct
 		with Not_found ->
 			-1
 
-	let can_be_inlined com d e = match e.eexpr with
+	let can_be_inlined com v0 e = match e.eexpr with
 		| TConst ct ->
 			begin match ct with
 				| TThis | TSuper -> false
@@ -1007,14 +1040,14 @@ module ConstPropagation = struct
 			begin try
 				let v' = Ssa.get_origin_var v in
 				begin match v'.v_extra with
-					| Some ([],_) -> get_block_depth v <= d
+					| Some ([],_) -> get_block_depth v <= get_block_depth v0
 					| _ -> false
 				end
 			with Not_found ->
 				false
 			end
 		| TEnumParameter _ when not (com.platform = Php) ->
-			true
+			Ssa.get_var_usage_count v0 <= 1
 		| _ ->
 			false
 
@@ -1078,7 +1111,7 @@ module ConstPropagation = struct
 			value ssa force e1
 		| TLocal v ->
 			let e' = local ssa force v e in
-			if force || can_be_inlined ssa.com (get_block_depth v) e' then
+			if force || can_be_inlined ssa.com v e' then
 				e'
 			else
 				e
@@ -1102,6 +1135,13 @@ module ConstPropagation = struct
 			| _ -> raise Not_found
 
 	let apply ssa e =
+		let rec loop e = match e.eexpr with
+			| TLocal v when not (Meta.has Meta.Unbound v.v_meta) ->
+				set_var_usage_count v (get_var_usage_count v + 1);
+			| _ ->
+				Type.iter loop e
+		in
+		loop e;
 		let had_function = ref false in
 		let rec loop e = match e.eexpr with
 			| TFunction _ when !had_function ->
@@ -1111,7 +1151,7 @@ module ConstPropagation = struct
 				{e with eexpr = TFunction {tf with tf_expr = loop tf.tf_expr}}
 			| TLocal v ->
 				let e' = local ssa false v e in
-				if can_be_inlined ssa.com (get_block_depth v) e' then
+				if can_be_inlined ssa.com v e' then
 					e'
 				else
 					e