Remove hard references from if_features (HaxeFoundation#11315)

* Remove hard references from if_features * introduce class_field_ref_kind --------- Co-authored-by: Simon Krajewski <[email protected]>
0b1kn00b · Jan 25, 2024 · 1f0cfab · 1f0cfab
1 parent 9f5c7da
commit 1f0cfab
Show file tree

Hide file tree

Showing 5 changed files with 103 additions and 55 deletions.
diff --git a/src/core/tFunctions.ml b/src/core/tFunctions.ml
@@ -172,6 +172,13 @@ let module_extra file sign time kind policy =
 		m_check_policy = policy;
 	}
 
+let mk_class_field_ref (c : tclass) (cf : tclass_field) (kind : class_field_ref_kind) (is_macro : bool) = {
+	cfr_sign = c.cl_module.m_extra.m_sign;
+	cfr_path = c.cl_path;
+	cfr_field = cf.cf_name;
+	cfr_kind = kind;
+	cfr_is_macro = is_macro;
+}
 
 let mk_field name ?(public = true) ?(static = false) t p name_pos = {
 	cf_name = name;

diff --git a/src/core/tPrinting.ml b/src/core/tPrinting.ml
@@ -389,6 +389,11 @@ let s_class_kind = function
 	| KModuleFields m ->
 		Printf.sprintf "KModuleFields %s" (s_type_path m.m_path)
 
+let s_class_field_ref_kind = function
+	| CfrStatic -> "CfrStatic"
+	| CfrMember -> "CfrMember"
+	| CfrConstructor -> "CfrConstructor"
+
 module Printer = struct
 
 	let s_type t =

diff --git a/src/core/tType.ml b/src/core/tType.ml
@@ -393,10 +393,23 @@ and module_def_extra = {
 	mutable m_deps : (int,(string (* sign *) * path)) PMap.t;
 	mutable m_kind : module_kind;
 	mutable m_binded_res : (string, string) PMap.t;
-	mutable m_if_feature : (string *(tclass * tclass_field * bool)) list;
+	mutable m_if_feature : (string * class_field_ref) list;
 	mutable m_features : (string,bool) Hashtbl.t;
 }
 
+and class_field_ref_kind =
+	| CfrStatic
+	| CfrMember
+	| CfrConstructor
+
+and class_field_ref = {
+	cfr_sign : string;
+	cfr_path : path;
+	cfr_field : string;
+	cfr_kind : class_field_ref_kind;
+	cfr_is_macro : bool;
+}
+
 and module_kind =
 	| MCode
 	| MMacro
@@ -461,4 +474,4 @@ type flag_tvar =
 
 let flag_tvar_names = [
 	"VCaptured";"VFinal";"VUsed";"VAssigned";"VCaught";"VStatic"
-]
+]
diff --git a/src/optimization/dce.ml b/src/optimization/dce.ml
@@ -35,12 +35,12 @@ type dce = {
 	follow_expr : dce -> texpr -> unit;
 	dependent_types : (string list * string,module_type list) Hashtbl.t;
 	mutable curclass : tclass;
-	mutable added_fields : (tclass * tclass_field * bool) list;
+	mutable added_fields : (tclass * tclass_field * class_field_ref_kind) list;
 	mutable marked_fields : tclass_field list;
 	mutable marked_maybe_fields : tclass_field list;
 	mutable t_stack : t list;
 	mutable ts_stack : t list;
-	mutable features : (string,(tclass * tclass_field * bool) list) Hashtbl.t;
+	mutable features : (string, class_field_ref list) Hashtbl.t;
 }
 
 let push_class dce c =
@@ -50,6 +50,27 @@ let push_class dce c =
 		dce.curclass <- old
 	)
 
+let find_field c name kind =
+	match kind with
+	| CfrConstructor ->
+		begin match c.cl_constructor with Some cf -> cf | None -> raise Not_found end
+	| CfrStatic ->
+		PMap.find name c.cl_statics
+	| CfrMember ->
+		PMap.find name c.cl_fields
+
+let resolve_class_field_ref ctx cfr =
+	let ctx = if cfr.cfr_is_macro && not ctx.is_macro_context then Option.get (ctx.get_macros()) else ctx in
+	let path = ctx.type_to_module#find cfr.cfr_path in
+	let m = ctx.module_lut#find path in
+
+	Option.get (ExtList.List.find_map (fun mt -> match mt with
+		| TClassDecl c when c.cl_path = cfr.cfr_path ->
+			let cf = find_field c cfr.cfr_field cfr.cfr_kind in
+			Some (c, cf)
+		| _ -> None
+	) m.m_types)
+
 (* checking *)
 
 (* check for @:keepSub metadata, which forces @:keep on child classes *)
@@ -108,23 +129,24 @@ let mk_keep_meta pos =
 	`keep_field` is checked to determine the DCE entry points, i.e. all fields that have `@:keep` or kept for other reasons.
 	And then it is used at the end to check which fields can be filtered from their classes.
 *)
-let rec keep_field dce cf c is_static =
+let rec keep_field dce cf c kind =
+	let is_static = kind = CfrStatic in
 	Meta.has_one_of (Meta.Used :: keep_metas) cf.cf_meta
 	|| cf.cf_name = "__init__"
 	|| has_class_field_flag cf CfExtern
 	|| (not is_static && overrides_extern_field cf c)
 	|| (
-		cf.cf_name = "new"
+		kind = CfrConstructor
 		&& match c.cl_super with (* parent class kept constructor *)
-			| Some ({ cl_constructor = Some ctor } as csup, _) -> keep_field dce ctor csup false
+			| Some ({ cl_constructor = Some ctor } as csup, _) -> keep_field dce ctor csup CfrConstructor
 			| _ -> false
 	)
 	|| begin
 		let check_accessor prefix =
 			try
 				let fields = if is_static then c.cl_statics else c.cl_fields in
 				let accessor = PMap.find (prefix ^ cf.cf_name) fields in
-				keep_field dce accessor c is_static
+				keep_field dce accessor c kind
 			with Not_found -> false
 		in
 		match cf.cf_kind with
@@ -138,8 +160,9 @@ let rec keep_field dce cf c is_static =
 let rec check_feature dce s =
 	try
 		let l = Hashtbl.find dce.features s in
-		List.iter (fun (c,cf,stat) ->
-			mark_field dce c cf stat
+		List.iter (fun cfr ->
+			let (c, cf) = resolve_class_field_ref dce.com cfr in
+			mark_field dce c cf cfr.cfr_kind
 		) l;
 		Hashtbl.remove dce.features s;
 	with Not_found ->
@@ -151,47 +174,48 @@ and check_and_add_feature dce s =
 	Hashtbl.replace dce.curclass.cl_module.m_extra.m_features s true
 
 (* mark a field as kept *)
-and mark_field dce c cf stat =
-	let add cf =
+and mark_field dce c cf kind =
+	let add c' cf =
 		if not (Meta.has Meta.Used cf.cf_meta) then begin
 			cf.cf_meta <- (mk_used_meta cf.cf_pos) :: cf.cf_meta;
-			dce.added_fields <- (c,cf,stat) :: dce.added_fields;
+			dce.added_fields <- (c',cf,kind) :: dce.added_fields;
 			dce.marked_fields <- cf :: dce.marked_fields;
 			check_feature dce (Printf.sprintf "%s.%s" (s_type_path c.cl_path) cf.cf_name);
 		end
 	in
-	if cf.cf_name = "new" then begin
+	match kind with
+	| CfrConstructor ->
 		let rec loop c =
 			begin match c.cl_constructor with
-				| Some cf -> add cf
+				| Some cf -> add c cf
 				| None -> ()
 			end;
 			match c.cl_super with
 			| Some(csup,_) -> loop csup
 			| None -> ()
 		in
 		loop c
-	end else begin
+	| CfrStatic | CfrMember ->
+		let stat = kind = CfrStatic in
 		if not (PMap.mem cf.cf_name (if stat then c.cl_statics else c.cl_fields)) then begin
 			match c.cl_super with
-			| None -> add cf
-			| Some (c,_) -> mark_field dce c cf stat
+			| None -> add c cf
+			| Some (c,_) -> mark_field dce c cf kind
 		end else
-			add cf;
+			add c cf;
 		if not stat && is_physical_field cf then
 			match c.cl_constructor with
 				| None -> ()
-				| Some ctor -> mark_field dce c ctor false
-	end
+				| Some ctor -> mark_field dce c ctor CfrConstructor
 
 let rec update_marked_class_fields dce c =
 	let pop = push_class dce c in
 	(* mark all :?used fields as surely :used now *)
 	List.iter (fun cf ->
-		if Meta.has Meta.MaybeUsed cf.cf_meta then mark_field dce c cf true
+		if Meta.has Meta.MaybeUsed cf.cf_meta then mark_field dce c cf CfrStatic
 	) c.cl_ordered_statics;
 	List.iter (fun cf ->
-		if Meta.has Meta.MaybeUsed cf.cf_meta then mark_field dce c cf false
+		if Meta.has Meta.MaybeUsed cf.cf_meta then mark_field dce c cf CfrMember
 	) c.cl_ordered_fields;
 	(* we always have to keep super classes and implemented interfaces *)
 	(match c.cl_init with None -> () | Some init -> dce.follow_expr dce init);
@@ -267,13 +291,14 @@ let mark_mt dce mt = match mt with
 		()
 
 (* find all dependent fields by checking implementing/subclassing types *)
-let mark_dependent_fields dce csup n stat =
+let mark_dependent_fields dce csup n kind =
 	let rec loop c =
 		(try
+			let stat = kind = CfrStatic in
 			let cf = PMap.find n (if stat then c.cl_statics else c.cl_fields) in
 			(* if it's clear that the class is kept, the field has to be kept as well. This is also true for
 				extern interfaces because we cannot remove fields from them *)
-			if Meta.has Meta.Used c.cl_meta || ((has_class_flag csup CInterface) && (has_class_flag csup CExtern)) then mark_field dce c cf stat
+			if Meta.has Meta.Used c.cl_meta || ((has_class_flag csup CInterface) && (has_class_flag csup CExtern)) then mark_field dce c cf kind
 			(* otherwise it might be kept if the class is kept later, so mark it as :?used *)
 			else if not (Meta.has Meta.MaybeUsed cf.cf_meta) then begin
 				cf.cf_meta <- (Meta.MaybeUsed,[],cf.cf_pos) :: cf.cf_meta;
@@ -295,15 +320,15 @@ let opt f e = match e with None -> () | Some e -> f e
 
 let rec to_string dce t = match t with
 	| TInst(c,tl) ->
-		field dce c "toString" false;
+		field dce c "toString" CfrMember;
 	| TType(tt,tl) ->
 		if not (List.exists (fun t2 -> Type.fast_eq t t2) dce.ts_stack) then begin
 			dce.ts_stack <- t :: dce.ts_stack;
 			to_string dce (apply_typedef tt tl)
 		end
 	| TAbstract({a_impl = Some c} as a,tl) ->
 		if Meta.has Meta.CoreType a.a_meta then
-			field dce c "toString" false
+			field dce c "toString" CfrMember
 		else
 			to_string dce (Abstract.get_underlying_type a tl)
 	| TMono r ->
@@ -318,32 +343,26 @@ let rec to_string dce t = match t with
 		(* if we to_string these it does not imply that we need all its sub-types *)
 		()
 
-and field dce c n stat =
-	let find_field n =
-		if n = "new" then match c.cl_constructor with
-			| None -> raise Not_found
-			| Some cf -> cf
-		else PMap.find n (if stat then c.cl_statics else c.cl_fields)
-	in
+and field dce c n kind =
 	(try
-		let cf = find_field n in
-		mark_field dce c cf stat;
+		let cf = find_field c n kind in
+		mark_field dce c cf kind;
 	with Not_found -> try
 		if (has_class_flag c CInterface) then begin
 			let rec loop cl = match cl with
 				| [] -> raise Not_found
 				| (c,_) :: cl ->
-					try field dce c n stat with Not_found -> loop cl
+					try field dce c n kind with Not_found -> loop cl
 			in
 			loop c.cl_implements
-		end else match c.cl_super with Some (csup,_) -> field dce csup n stat | None -> raise Not_found
+		end else match c.cl_super with Some (csup,_) -> field dce csup n kind | None -> raise Not_found
 	with Not_found -> try
 		match c.cl_kind with
 		| KTypeParameter tl ->
 			let rec loop tl = match tl with
 				| [] -> raise Not_found
 				| TInst(c,_) :: cl ->
-					(try field dce c n stat with Not_found -> loop cl)
+					(try field dce c n kind with Not_found -> loop cl)
 				| t :: tl ->
 					loop tl
 			in
@@ -448,12 +467,12 @@ and expr_field dce e fa is_call_expr =
 				| TInst(c,_), _
 				| _, FClosure (Some (c, _), _) ->
 					mark_class dce c;
-					field dce c n false;
+					field dce c n CfrMember;
 				| TAnon a, _ ->
 					(match !(a.a_status) with
 					| Statics c ->
 						mark_class dce c;
-						field dce c n true;
+						field dce c n CfrStatic;
 					| _ -> ())
 
 
@@ -477,11 +496,11 @@ and expr_field dce e fa is_call_expr =
 	begin match fa with
 		| FStatic(c,cf) ->
 			mark_class dce c;
-			mark_field dce c cf true;
+			mark_field dce c cf CfrStatic;
 		| FInstance(c,_,cf) ->
 			(*mark_instance_field_access c cf;*)
 			mark_class dce c;
-			mark_field dce c cf false
+			mark_field dce c cf CfrMember
 		| FClosure (Some(c, _), cf) ->
 		 	mark_instance_field_access c cf;
 			do_default()
@@ -499,7 +518,7 @@ and expr dce e =
 	| TNew(c,pl,el) ->
 		mark_class dce c;
 		mark_directly_used_class dce c;
-		field dce c "new" false;
+		field dce c "new" CfrConstructor;
 		List.iter (expr dce) el;
 		List.iter (mark_t dce e.epos) pl;
 	| TVar (v,e1) ->
@@ -702,21 +721,21 @@ let collect_entry_points dce com =
 		match t with
 		| TClassDecl c ->
 			let keep_class = keep_whole_class dce c && (not (has_class_flag c CExtern) || (has_class_flag c CInterface)) in
-			let loop stat cf =
-				if keep_class || keep_field dce cf c stat then mark_field dce c cf stat
+			let loop kind cf =
+				if keep_class || keep_field dce cf c kind then mark_field dce c cf kind
 			in
-			List.iter (loop true) c.cl_ordered_statics;
-			List.iter (loop false) c.cl_ordered_fields;
+			List.iter (loop CfrStatic) c.cl_ordered_statics;
+			List.iter (loop CfrMember) c.cl_ordered_fields;
 			begin match c.cl_constructor with
-				| Some cf -> loop false cf
+				| Some cf -> loop CfrConstructor cf
 				| None -> ()
 			end;
 			begin match c.cl_init with
 				| Some e when keep_class || Meta.has Meta.KeepInit c.cl_meta ->
 					(* create a fake field to deal with our internal logic (issue #3286) *)
 					let cf = mk_field "__init__" e.etype e.epos null_pos in
 					cf.cf_expr <- Some e;
-					loop true cf
+					loop CfrStatic cf
 				| _ ->
 					()
 			end;
@@ -797,7 +816,7 @@ let sweep dce com =
 			(* add :keep so subsequent filter calls do not process class fields again *)
 			c.cl_meta <- (mk_keep_meta c.cl_pos) :: c.cl_meta;
  			c.cl_ordered_statics <- List.filter (fun cf ->
-				let b = keep_field dce cf c true in
+				let b = keep_field dce cf c CfrStatic in
 				if not b then begin
 					if dce.debug then print_endline ("[DCE] Removed field " ^ (s_type_path c.cl_path) ^ "." ^ (cf.cf_name));
 					check_property cf true;
@@ -806,15 +825,15 @@ let sweep dce com =
 				b
 			) c.cl_ordered_statics;
 			c.cl_ordered_fields <- List.filter (fun cf ->
-				let b = keep_field dce cf c false in
+				let b = keep_field dce cf c CfrMember in
 				if not b then begin
 					if dce.debug then print_endline ("[DCE] Removed field " ^ (s_type_path c.cl_path) ^ "." ^ (cf.cf_name));
 					check_property cf false;
 					c.cl_fields <- PMap.remove cf.cf_name c.cl_fields;
 				end;
 				b
 			) c.cl_ordered_fields;
-			(match c.cl_constructor with Some cf when not (keep_field dce cf c false) -> c.cl_constructor <- None | _ -> ());
+			(match c.cl_constructor with Some cf when not (keep_field dce cf c CfrConstructor) -> c.cl_constructor <- None | _ -> ());
 			let inef cf = is_physical_field cf in
 			let has_non_extern_fields = List.exists inef c.cl_ordered_fields || List.exists inef c.cl_ordered_statics in
 			(* we keep a class if it was used or has a used field *)

diff --git a/src/typing/typeloadFields.ml b/src/typing/typeloadFields.ml
@@ -1820,7 +1820,11 @@ let init_class ctx c p context_init herits fields =
 			if fctx.is_static && (has_class_flag c CInterface) && fctx.field_kind <> FKInit && not cctx.is_lib && not ((has_class_flag c CExtern)) then
 				raise_typing_error "You can only declare static fields in extern interfaces" p;
 			let set_feature s =
-				ctx.m.curmod.m_extra.m_if_feature <- (s,(c,cf,fctx.is_static)) :: ctx.m.curmod.m_extra.m_if_feature
+				let ref_kind = match fctx.field_kind with
+					| FKConstructor -> CfrConstructor
+					| _ -> if fctx.is_static then CfrStatic else CfrMember
+				in
+				ctx.m.curmod.m_extra.m_if_feature <- (s, (mk_class_field_ref c cf ref_kind fctx.is_macro)) :: ctx.m.curmod.m_extra.m_if_feature;
 			in
 			List.iter set_feature cl_if_feature;
 			List.iter set_feature (check_if_feature cf.cf_meta);
@@ -1838,7 +1842,7 @@ let init_class ctx c p context_init herits fields =
 				end;
 				begin match c.cl_constructor with
 				| None ->
-						c.cl_constructor <- Some cf
+					c.cl_constructor <- Some cf
 				| Some ctor when ctx.com.config.pf_overload ->
 					if has_class_field_flag cf CfOverload && has_class_field_flag ctor CfOverload then
 						ctor.cf_overloads <- cf :: ctor.cf_overloads