From e6754bb26a223a9cf8215fa2f0266353ec9bd9ab Mon Sep 17 00:00:00 2001 From: Rudy Ges Date: Mon, 25 Sep 2023 11:58:01 +0200 Subject: [PATCH] Remove hard references from if_features (#11315) * Remove hard references from if_features * introduce class_field_ref_kind --------- Co-authored-by: Simon Krajewski --- src/core/tFunctions.ml | 7 ++ src/core/tPrinting.ml | 5 ++ src/core/tType.ml | 17 ++++- src/optimization/dce.ml | 121 ++++++++++++++++++++--------------- src/typing/typeloadFields.ml | 8 ++- 5 files changed, 103 insertions(+), 55 deletions(-) diff --git a/src/core/tFunctions.ml b/src/core/tFunctions.ml index ff3540b08ef..67f34223306 100644 --- 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 index fd4351ea0a2..30245cf9f8b 100644 --- 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 index 6ec5f025b21..f53d47b9358 100644 --- 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" -] \ No newline at end of file +] diff --git a/src/optimization/dce.ml b/src/optimization/dce.ml index acdd2af9cc7..51ec187aac0 100644 --- 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,15 +129,16 @@ 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 @@ -124,7 +146,7 @@ let rec keep_field dce cf c is_static = 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,19 +174,20 @@ 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 @@ -171,27 +195,27 @@ and mark_field dce c cf stat = | 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,7 +320,7 @@ 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; @@ -303,7 +328,7 @@ let rec to_string dce t = match t with 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,13 +721,13 @@ 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 @@ -716,7 +735,7 @@ let collect_entry_points dce com = (* 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,7 +825,7 @@ 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; @@ -814,7 +833,7 @@ let sweep dce com = 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 index f1320af4951..49a418913a1 100644 --- 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