Explorar el Código

[optimizer] remove some stuff and see if anyone notices

Simon Krajewski hace 5 años
padre
commit
c41f1b5cff
Se han modificado 3 ficheros con 2 adiciones y 490 borrados
  1. 0 10
      src-json/define.json
  2. 1 1
      src/filters/filters.ml
  3. 1 479
      src/optimization/optimizer.ml

+ 0 - 10
src-json/define.json

@@ -427,11 +427,6 @@
 		"doc": "Disable final compilation.",
 		"platforms": ["cs", "java", "cpp", "hl"]
 	},
-	{
-		"name": "NoCOpt",
-		"define": "no_copt",
-		"doc": "Disable completion optimization (for debug purposes)."
-	},
 	{
 		"name": "NoDebug",
 		"define": "no_debug",
@@ -493,11 +488,6 @@
 		"doc": "Sets the hxcpp output to Objective-C++ classes. Must be defined for interop.",
 		"platforms": ["cpp"]
 	},
-	{
-		"name": "OldConstructorInline",
-		"define": "old-constructor-inline",
-		"doc": "Use old constructor inlining logic (from Haxe 3.4.2) instead of the reworked version."
-	},
 	{
 		"name": "OldErrorFormat",
 		"define": "old-error-format",

+ 1 - 1
src/filters/filters.ml

@@ -721,7 +721,7 @@ let run com tctx main =
 		check_abstract_as_value;
 		if defined com Define.AnalyzerOptimize then Tre.run tctx else (fun e -> e);
 		Optimizer.reduce_expression tctx;
-		if Common.defined com Define.OldConstructorInline then Optimizer.inline_constructors tctx else InlineConstructors.inline_constructors tctx;
+		InlineConstructors.inline_constructors tctx;
 		Exceptions.filter tctx;
 		CapturedVars.captured_vars com;
 	] in

+ 1 - 479
src/optimization/optimizer.ml

@@ -374,482 +374,4 @@ let rec make_constant_expression ctx ?(concat_strings=false) e =
 			| None -> None
 			| Some e -> make_constant_expression ctx e)
 		with Not_found -> None) *)
-	| _ -> None
-
-(* ---------------------------------------------------------------------- *)
-(* INLINE CONSTRUCTORS *)
-(* This version is disabled by default, use -D old-constructor-inline to use this *)
-
-(*
-	First pass :
-	We will look at local variables in the form   var v = new ....
-	we only capture the ones which have constructors marked as inlined
-	then we make sure that these locals are no more referenced except for fields accesses
-
-	Second pass :
-	We replace the variables by their fields lists, and the corresponding fields accesses as well
-*)
-
-type inline_info_kind =
-	| IKCtor of tclass_field * bool
-	| IKStructure
-	| IKArray of int
-
-type inline_info = {
-	ii_var : tvar;
-	ii_expr : texpr;
-	ii_kind : inline_info_kind;
-	mutable ii_fields : (string,tvar) PMap.t;
-}
-
-let inline_constructors ctx e =
-	let vars = ref IntMap.empty in
-	let cancel v p =
-		try
-			let ii = IntMap.find v.v_id !vars in
-			vars := IntMap.remove v.v_id !vars;
-			v.v_id <- -v.v_id;
-			begin match ii.ii_kind with
-				| IKCtor(cf,true) ->
-					display_error ctx "Extern constructor could not be inlined" p;
-					error (compl_msg "Variable is used here") p;
-				| _ ->
-					()
-			end;
-		with Not_found ->
-			()
-	in
-	let add v e kind =
-		let ii = {
-			ii_var = v;
-			ii_fields = PMap.empty;
-			ii_expr = e;
-			ii_kind = kind
-		} in
-		v.v_id <- -v.v_id;
-		vars := IntMap.add v.v_id ii !vars;
-	in
-	let get_field_var v s =
-		let ii = IntMap.find v.v_id !vars in
-		PMap.find s ii.ii_fields
-	in
-	let add_field_var v s t =
-		let ii = IntMap.find v.v_id !vars in
-		let v' = alloc_var VInlinedConstructorVariable (Printf.sprintf "%s_%s" v.v_name s) t v.v_pos in
-		ii.ii_fields <- PMap.add s v' ii.ii_fields;
-		v'
-	in
-	let int_field_name i =
-		if i < 0 then "n" ^ (string_of_int (-i))
-		else (string_of_int i)
-	in
-	let is_extern_ctor c cf = c.cl_extern || has_class_field_flag cf CfExtern in
-	let rec find_locals e = match e.eexpr with
-		| TVar(v,Some e1) ->
-			find_locals e1;
-			let rec loop el_init e1 = match e1.eexpr with
-				| TBlock el ->
-					begin match List.rev el with
-					| e1 :: el ->
-						loop (el @ el_init) e1
-					| [] ->
-						()
-					end
-				| TNew({ cl_constructor = Some ({cf_kind = Method MethInline; cf_expr = Some ({eexpr = TFunction tf})} as cf)} as c,tl,pl) when type_iseq v.v_type e1.etype ->
-					begin match type_inline_ctor ctx c cf tf (mk (TLocal v) (TInst (c,tl)) e1.epos) pl e1.epos with
-					| Some e ->
-						let e' = match el_init with
-							| [] -> e
-							| _ -> mk (TBlock (List.rev (e :: el_init))) e.etype e.epos
-						in
-						add v e' (IKCtor(cf,is_extern_ctor c cf));
-						find_locals e
-					| None ->
-						()
-					end
-				| TObjectDecl fl when fl <> [] ->
-					begin try
-						let ev = mk (TLocal v) v.v_type e.epos in
-						let el = List.fold_left (fun acc ((s,_,_),e) ->
-							if not (Lexer.is_valid_identifier s) then raise Exit;
-							let ef = mk (TField(ev,FDynamic s)) e.etype e.epos in
-							let e = mk (TBinop(OpAssign,ef,e)) e.etype e.epos in
-							e :: acc
-						) el_init fl in
-						let e = mk (TBlock (List.rev el)) ctx.t.tvoid e.epos in
-						add v e IKStructure
-					with Exit ->
-						()
-					end
-				| TArrayDecl el ->
-					let ev = mk (TLocal v) v.v_type e.epos in
-					let el,_ = List.fold_left (fun (acc,i) e ->
-						let ef = mk (TField(ev,FDynamic (string_of_int i))) e.etype e.epos in
-						let e = mk (TBinop(OpAssign,ef,e)) e.etype e.epos in
-						e :: acc,i + 1
-					) (el_init,0) el in
-					let e = mk (TBlock (List.rev el)) ctx.t.tvoid e.epos in
-					add v e (IKArray (List.length el))
-				| TCast(e1,None) | TParenthesis e1 ->
-					loop el_init e1
-				| _ ->
-					()
-			in
-			loop [] e1
-		| TBinop(OpAssign,({eexpr = TField({eexpr = TLocal v},fa)} as e1),e2) when v.v_id < 0 ->
-			let s = field_name fa in
-			(try ignore(get_field_var v s) with Not_found -> ignore(add_field_var v s e1.etype));
-			find_locals e2
-		| TField({eexpr = TLocal v},fa) when v.v_id < 0 ->
-			begin match extract_field fa with
-			| Some ({cf_kind = Var _} as cf) ->
-				(* Arrays are not supposed to have public var fields, besides "length" (which we handle when inlining),
-				   however, its inlined methods may generate access to private implementation fields (such as internal
-				   native array), in this case we have to cancel inlining.
-				*)
-				if cf.cf_name <> "length" then
-					begin match (IntMap.find v.v_id !vars).ii_kind with
-					| IKArray _ -> cancel v e.epos
-					| _ -> (try ignore(get_field_var v cf.cf_name) with Not_found -> ignore(add_field_var v cf.cf_name e.etype));
-					end
-			| _ -> cancel v e.epos
-			end
-		| TArray({eexpr = TLocal v},{eexpr = TConst (TInt i)}) when v.v_id < 0 ->
-			let i = Int32.to_int i in
-			begin try
-				let ii = IntMap.find v.v_id !vars in
-				let l = match ii.ii_kind with
-					| IKArray l -> l
-					| _ -> raise Not_found
-				in
-				if i < 0 || i >= l then raise Not_found;
-			with Not_found ->
-				cancel v e.epos
-			end
-		| TLocal v when v.v_id < 0 ->
-			cancel v e.epos;
-		| _ ->
-			Type.iter find_locals e
-	in
-	find_locals e;
-	(* Pass 2 *)
-	let inline v p =
-		try
-			let ii = IntMap.find v.v_id !vars in
-			let el = PMap.fold (fun v acc -> (mk (TVar(v,None)) ctx.t.tvoid p) :: acc) ii.ii_fields [] in
-			let e = {ii.ii_expr with eexpr = TBlock (el @ [ii.ii_expr])} in
-			Some e
-		with Not_found ->
-			None
-	in
-	let assign_or_declare v name e2 t p =
-		 try
-			let v = get_field_var v name in
-			let e1 = mk (TLocal v) t p in
-			mk (TBinop(OpAssign,e1,e2)) e1.etype p
-		with Not_found ->
-			let v = add_field_var v name t in
-			mk (TVar(v,Some e2)) ctx.t.tvoid e.epos
-	in
-	let use_local_or_null v name t p =
-		try
-			let v' = get_field_var v name in
-			mk (TLocal v') t p
-		with Not_found -> try
-			if name <> "length" then raise Not_found;
-			let ii = IntMap.find v.v_id !vars in
-			begin match ii.ii_kind with
-			| IKArray l -> mk (TConst (TInt (Int32.of_int l))) ctx.t.tint p
-			| _ -> raise Not_found
-			end
-		with Not_found ->
-			mk (TConst TNull) t p
-	in
-	let flatten e =
-		let el = ref [] in
-		let rec loop e = match e.eexpr with
-			| TBlock el ->
-				List.iter loop el
-			| _ ->
-				el := e :: !el
-		in
-		loop e;
-		let e = mk (TBlock (List.rev !el)) e.etype e.epos in
-		mk (TMeta((Meta.MergeBlock,[],e.epos),e)) e.etype e.epos
-	in
-	let rec loop e = match e.eexpr with
-		| TVar(v,_) when v.v_id < 0 ->
-			begin match inline v e.epos with
-			| Some e ->
-				let e = flatten e in
-				loop e
-			| None ->
-				cancel v e.epos;
-				e
-			end
-		| TBinop(OpAssign,({eexpr = TField({eexpr = TLocal v},fa)} as e1),e2) when v.v_id < 0 ->
-			let e2 = loop e2 in
-			assign_or_declare v (field_name fa) e2 e1.etype e.epos
-		| TField({eexpr = TLocal v},fa) when v.v_id < 0 ->
-			use_local_or_null v (field_name fa) e.etype e.epos
-		| TBinop(OpAssign,({eexpr = TArray({eexpr = TLocal v},{eexpr = TConst (TInt i)})} as e1),e2) when v.v_id < 0 ->
-			let e2 = loop e2 in
-			let name = int_field_name (Int32.to_int i) in
-			assign_or_declare v name e2 e1.etype e.epos
-		| TArray({eexpr = TLocal v},{eexpr = TConst (TInt i)}) when v.v_id < 0	->
-			use_local_or_null v (int_field_name (Int32.to_int i)) e.etype e.epos
-		| TBlock el ->
-			let rec block acc el = match el with
-				| e1 :: el ->
-					begin match loop e1 with
-					| {eexpr = TMeta((Meta.MergeBlock,_,_),{eexpr = TBlock el2})} ->
-						let acc = block acc el2 in
-						block acc el
-					| e -> block (e :: acc) el
-					end
-				| [] ->
-					acc
-			in
-			let el = block [] el in
-			mk (TBlock (List.rev el)) e.etype e.epos
-		| TNew({ cl_constructor = Some ({cf_kind = Method MethInline; cf_expr = Some ({eexpr = TFunction _})} as cf)} as c,_,_) when is_extern_ctor c cf ->
-			display_error ctx "Extern constructor could not be inlined" e.epos;
-			Type.map_expr loop e
-		| _ ->
-			Type.map_expr loop e
-	in
-	loop e
-
-(* ---------------------------------------------------------------------- *)
-(* COMPLETION *)
-
-exception Return of Ast.expr
-
-type compl_locals = {
-	mutable r : (string, (complex_type option * (int * Ast.expr * compl_locals) option)) PMap.t;
-}
-
-let optimize_completion_expr e args =
-	let iid = ref 0 in
-	let typing_side_effect = ref false in
-	let locals : compl_locals = { r = PMap.empty } in
-	let save() = let old = locals.r in (fun() -> locals.r <- old) in
-	let get_local n = PMap.find n locals.r in
-	let maybe_typed e =
-		match fst e with
-		| EConst (Ident "null") -> false
-		| _ -> true
-	in
-	let decl n t e =
-		typing_side_effect := true;
-		locals.r <- PMap.add n (t,(match e with Some e when maybe_typed e -> incr iid; Some (!iid,e,{ r = locals.r }) | _ -> None)) locals.r
-	in
-	let rec hunt_idents e = match fst e with
-		| EConst (Ident i) -> decl i None None
-		| _ -> Ast.iter_expr hunt_idents e
-	in
-	let e0 = e in
-	let rec loop e =
-		let p = snd e in
-		match fst e with
-		| EConst (Ident n) ->
-			(try
-				(match get_local n with
-				| Some _ , _ -> ()
-				| _ -> typing_side_effect := true)
-			with Not_found ->
-				());
-			e
-		| EBinop (OpAssign,(EConst (Ident n),_),esub) ->
-			(try
-				(match get_local n with
-				| None, None when maybe_typed esub -> decl n None (Some esub)
-				| _ -> ())
-			with Not_found ->
-				());
-			map e
-		| EVars vl ->
-			let vl = List.map (fun v ->
-				let e = (match v.ev_expr with None -> None | Some e -> Some (loop e)) in
-				decl (fst v.ev_name) (Option.map fst v.ev_type) e;
-				{ v with ev_expr = e }
-			) vl in
-			(EVars vl,p)
-		| EBlock el ->
-			let old = save() in
-			let told = ref (!typing_side_effect) in
-			let el = List.fold_left (fun acc e ->
-				typing_side_effect := false;
-				let e = loop e in
-				if !typing_side_effect || DisplayPosition.display_position#enclosed_in (pos e) then begin told := true; e :: acc end else acc
-			) [] el in
-			old();
-			typing_side_effect := !told;
-			(EBlock (List.rev el),p)
-		| EFunction (kind,f) ->
-			(match kind with
-			| FKNamed ((name,_),_) ->
-				decl name None (Some e)
-			| _ -> ());
-			let old = save() in
-			List.iter (fun ((n,_),_,_,t,e) -> decl n (Option.map fst t) e) f.f_args;
-			let e = map e in
-			old();
-			e
-		| EFor (header,body) ->
-			let idents = ref []
-			and has_in = ref false in
-			let rec collect_idents e =
-				match e with
-					| EConst (Ident name), p ->
-						idents := (name,p) :: !idents;
-						e
-					| EBinop (OpIn, e, it), p ->
-						has_in := true;
-						(EBinop (OpIn, collect_idents e, loop it), p)
-					| _ ->
-						Ast.map_expr collect_idents e
-			in
-			let header = collect_idents header in
-			(match !idents,!has_in with
-				| [],_ | _,false -> map e
-				| idents,true ->
-					let old = save() in
-					List.iter
-						(fun (name, pos) ->
-							let etmp = (EConst (Ident "`tmp"),pos) in
-							decl name None (Some (EBlock [
-								(EVars [mk_evar ("`tmp",null_pos)],p);
-								(EFor(header,(EBinop (OpAssign,etmp,(EConst (Ident name),p)),p)), p);
-								etmp
-							],p));
-						)
-						idents;
-					let body = loop body in
-					old();
-					(EFor(header,body),p)
-			)
-		| EReturn _ ->
-			typing_side_effect := true;
-			map e
-		| ESwitch (e1,cases,def) when DisplayPosition.display_position#enclosed_in p ->
-			let e1 = loop e1 in
-			hunt_idents e1;
-			(* Prune all cases that aren't our display case *)
-			let cases = List.filter (fun (_,_,_,p) -> DisplayPosition.display_position#enclosed_in p) cases in
-			(* Don't throw away the switch subject when we optimize in a case expression because we might need it *)
-			let cases = List.map (fun (el,eg,eo,p) ->
-				List.iter hunt_idents el;
-				el,eg,(try Option.map loop eo with Return e -> Some e),p
-			) cases in
-			let def = match def with
-				| None -> None
-				| Some (None,p) -> Some (None,p)
-				| Some (Some e,p) -> Some (Some (loop e),p)
-			in
-			(ESwitch (e1,cases,def),p)
-		| ESwitch (e,cases,def) ->
-			let e = loop e in
-			let cases = List.map (fun (el,eg,eo,p) -> match eo with
-				| None ->
-					el,eg,eo,p
-				| Some e ->
-					let el = List.map loop el in
-					let old = save() in
-					List.iter hunt_idents el;
-					let e = loop e in
-					old();
-					el, eg, Some e, p
-			) cases in
-			let def = match def with
-				| None -> None
-				| Some (None,p) -> Some (None,p)
-				| Some (Some e,p) -> Some (Some (loop e),p)
-			in
-			(ESwitch (e,cases,def),p)
-		| ETry (et,cl) ->
-			let et = loop et in
-			let cl = List.map (fun ((n,pn),th,e,p) ->
-				let old = save() in
-				decl n (Option.map fst th) None;
-				let e = loop e in
-				old();
-				(n,pn), th, e, p
-			) cl in
-			(ETry (et,cl),p)
-		| ECall(e1,el) when DisplayPosition.display_position#enclosed_in p ->
-			let e1 = loop e1 in
-			let el = List.map (fun e ->
-				if DisplayPosition.display_position#enclosed_in (pos e) then
-					(try loop e with Return e -> e)
-				else
-					(EConst (Ident "null"),(pos e))
-			) el in
-			(ECall(e1,el),p)
-		| ECheckType(e1,th) ->
-			typing_side_effect := true;
-			let e1 = loop e1 in
-			(ECheckType(e1,th),p)
-		| EMeta(m,e1) ->
-			begin try
-				let e1 = loop e1 in
-				(EMeta(m,e1),(pos e))
-			with Return e1 ->
-				let e1 = (EMeta(m,e1),(pos e)) in
-				raise (Return e1)
-			end
-		| EDisplay(_,DKStructure) ->
-			raise (Return e0)
-		| EDisplay (s,call) ->
-			typing_side_effect := true;
-			let tmp_locals = ref [] in
-			let tmp_hlocals = ref PMap.empty in
-			let rec subst_locals locals e =
-				match fst e with
-				| EConst (Ident n) ->
-					let p = snd e in
-					(try
-						(match PMap.find n locals.r with
-						| Some t , _ -> (ECheckType ((EConst (Ident "null"),p),(t,p)),p)
-						| _, Some (id,e,lc) ->
-							let name = (try
-								PMap.find id (!tmp_hlocals)
-							with Not_found ->
-								let eo = subst_locals lc e in
-								let name = "`tmp_" ^ string_of_int id in
-								tmp_locals := (mk_evar ~eo (name,null_pos)) :: !tmp_locals;
-								tmp_hlocals := PMap.add id name !tmp_hlocals;
-								name
-							) in
-							(EConst (Ident name),p)
-						| None, None ->
-							(* we can't replace the var *)
-							raise Exit)
-					with Not_found ->
-						(* not found locals are most likely to be member/static vars *)
-						e)
-				| EFunction (_,f) ->
-					Ast.map_expr (subst_locals { r = PMap.foldi (fun n i acc -> if List.exists (fun ((a,_),_,_,_,_) -> a = n) f.f_args then acc else PMap.add n i acc) locals.r PMap.empty }) e
-				| EObjectDecl [] ->
-					(* this probably comes from { | completion so we need some context} *)
-					raise Exit
-				| _ ->
-					Ast.map_expr (subst_locals locals) e
-			in
-			(try
-				let e = subst_locals locals s in
-				let e = (EBlock [(EVars (List.rev !tmp_locals),p);(EDisplay (e,call),p)],p) in
-				raise (Return e)
-			with Exit ->
-				map e)
-		| EDisplayNew _ ->
-			raise (Return e)
-		| _ ->
-			map e
-	and map e =
-		Ast.map_expr loop e
-	in
-	List.iter (fun ((n,_),_,_,t,e) -> decl n (Option.map fst t) e) args;
-	(try loop e with Return e -> e)
-
-(* ---------------------------------------------------------------------- *)
+	| _ -> None