Properly represent final on classes and fields (#7381)

* support `final class`

see #6584

* fix parsing so it allows both `extern final` and `final extern`

Also hold back on the warnings because the Flash API has `@:final` everywhere

* properly represent final fields as `cf_final`

* add missing isExtern on ClassField

* fix extends display handling of final classes

* ctrl s

* annoying

* don't require inits for extern final fields

* don't check for final inits on interfaces

* don't lose final on structure type fields

src/codegen/dotnet.ml

@@ -412,11 +412,11 @@ let convert_ilmethod ctx p m is_explicit_impl =
 	if PMap.mem "net_loader_debug" ctx.ncom.defines.Define.values then
 		Printf.printf "\t%smethod %s : %s\n" (if !is_static then "static " else "") cff_name (IlMetaDebug.ilsig_s m.msig.ssig);
 
-	let meta = match is_final with
+	let acc = match is_final with
 		| None | Some true when not force_check ->
-			(Meta.Final,[],p) :: meta
+			(AFinal,null_pos) :: acc
 		| _ ->
-			meta
+			acc
 	in
 	let meta = if is_explicit_impl then
 			(Meta.NoCompletion,[],p) :: (Meta.SkipReflection,[],p) :: meta
@@ -725,7 +725,8 @@ let convert_ilclass ctx p ?(delegate=false) ilcls = match ilcls.csuper with
 
 		let is_interface = ref false in
 		List.iter (fun f -> match f with
-			| SSealed -> meta := (Meta.Final, [], p) :: !meta
+			| SSealed ->
+				flags := HFinal :: !flags
 			| SInterface ->
 				is_interface := true;
 				flags := HInterface :: !flags

src/codegen/gencommon/closuresToClass.ml

@@ -463,7 +463,7 @@ let configure gen ft =
 				let pos = cls.cl_pos in
 				let cf = mk_class_field "Delegate" (TFun(fun_args tfunc.tf_args, tfunc.tf_type)) true pos (Method MethNormal) [] in
 				cf.cf_expr <- Some { fexpr with eexpr = TFunction { tfunc with tf_expr = func_expr }; };
-				cf.cf_meta <- (Meta.Final,[],pos) :: cf.cf_meta;
+				cf.cf_final <- true;
 				cls.cl_ordered_fields <- cf :: cls.cl_ordered_fields;
 				cls.cl_fields <- PMap.add cf.cf_name cf cls.cl_fields;
 				(* invoke function body: call Delegate function *)

src/codegen/gencommon/enumToClass.ml

@@ -182,7 +182,7 @@ struct
 
 		let getTag_cf_type = tfun [] basic.tstring in
 		let getTag_cf = mk_class_field "getTag" getTag_cf_type true pos (Method MethNormal) [] in
-		getTag_cf.cf_meta <- [(Meta.Final, [], pos)];
+		getTag_cf.cf_final <- true;
 		getTag_cf.cf_expr <- Some {
 			eexpr = TFunction {
 				tf_args = [];

src/codegen/gencommon/enumToClass2.ml

@@ -94,11 +94,11 @@ module EnumToClass2Modf = struct
 			let pos = ef.ef_pos in
 
 			let cl_ctor = mk_class en.e_module (e_pack, e_name ^ "_" ^ name) pos in
+			cl_ctor.cl_final <- true;
 			cl_ctor.cl_super <- Some (cl_enum, []);
 			cl_ctor.cl_meta <- [
 				(Meta.Enum,[],pos);
 				(Meta.NativeGen,[],pos);
-				(Meta.Final,[],pos);
 			] @ cl_ctor.cl_meta;
 			ctors_map := PMap.add name cl_ctor !ctors_map;
 

src/codegen/genxml.ml

@@ -172,7 +172,7 @@ and gen_field att f =
 			cf.cf_name
 	in
 	let att = if f.cf_public then ("public","1") :: att else att in
-	let att = if (Meta.has Meta.Final) f.cf_meta then ("final","1") :: att else att in
+	let att = if f.cf_final then ("final","1") :: att else att in
 	node (field_name f) att (gen_type ~values:(Some values) f.cf_type :: gen_meta f.cf_meta @ gen_doc_opt f.cf_doc @ overloads)
 
 let gen_constr e =

src/codegen/java.ml

@@ -263,7 +263,7 @@ let convert_java_enum ctx p pe =
 				cff_access := (APrivate,null_pos) :: !cff_access
 			| JStatic -> cff_access := (AStatic,null_pos) :: !cff_access
 			| JFinal ->
-				cff_meta := (Meta.Final, [], p) :: !cff_meta;
+				cff_access := (AFinal, p) :: !cff_access;
 				(match field.jf_kind, field.jf_vmsignature, field.jf_constant with
 				| JKField, TObject _, _ ->
 					jf_constant := None
@@ -414,7 +414,7 @@ let convert_java_enum ctx p pe =
 
 			let is_interface = ref false in
 			List.iter (fun f -> match f with
-				| JFinal -> meta := (Meta.Final, [], p) :: !meta
+				| JFinal -> flags := HFinal :: !flags
 				| JInterface ->
 						is_interface := true;
 						flags := HInterface :: !flags

src/codegen/swfLoader.ml

@@ -347,11 +347,12 @@ let build_class com c file =
 		} in
 		(path.tpackage, [(EEnum enum_data,pos)])
 	with Exit ->
+	let flags = if c.hlc_final && List.exists (fun f -> fst f.cff_name <> "new" && not (List.mem_assoc AStatic f.cff_access)) fields then HFinal :: flags else flags in
 	let class_data = {
 		d_name = path.tname,null_pos;
 		d_doc = None;
 		d_params = [];
-		d_meta = if c.hlc_final && List.exists (fun f -> fst f.cff_name <> "new" && not (List.mem_assoc AStatic f.cff_access)) fields then [Meta.Final,[],pos] else [];
+		d_meta = [];
 		d_flags = flags;
 		d_data = fields;
 	} in

src/core/ast.ml

@@ -264,6 +264,7 @@ type class_flag =
 	| HPrivate
 	| HExtends of placed_type_path
 	| HImplements of placed_type_path
+	| HFinal
 
 type abstract_flag =
 	| AbPrivate

src/core/display/completionItem.ml

@@ -66,6 +66,7 @@ module CompletionModuleType = struct
 		meta: metadata;
 		doc : documentation;
 		is_extern : bool;
+		is_final : bool;
 		kind : CompletionModuleKind.t;
 		has_constructor : not_bool;
 		source : module_type_source;
@@ -87,6 +88,7 @@ module CompletionModuleType = struct
 				meta = d.d_meta;
 				doc = d.d_doc;
 				is_extern = List.mem HExtern d.d_flags;
+				is_final = List.mem HFinal d.d_flags;
 				kind = if List.mem HInterface d.d_flags then Interface else Class;
 				has_constructor = ctor;
 				source = Syntax td;
@@ -101,6 +103,7 @@ module CompletionModuleType = struct
 				meta = d.d_meta;
 				doc = d.d_doc;
 				is_extern = List.mem EExtern d.d_flags;
+				is_final = false;
 				kind = Enum;
 				has_constructor = No;
 				source = Syntax td;
@@ -117,6 +120,7 @@ module CompletionModuleType = struct
 				meta = d.d_meta;
 				doc = d.d_doc;
 				is_extern = List.mem EExtern d.d_flags;
+				is_final = false;
 				kind = kind;
 				has_constructor = if kind = Struct then No else Maybe;
 				source = Syntax td;
@@ -131,6 +135,7 @@ module CompletionModuleType = struct
 				meta = d.d_meta;
 				doc = d.d_doc;
 				is_extern = List.mem AbExtern d.d_flags;
+				is_final = false;
 				kind = if Meta.has Meta.Enum d.d_meta then EnumAbstract else Abstract;
 				has_constructor = if (List.exists (fun cff -> fst cff.cff_name = "new") d.d_data) then Yes else No;
 				source = Syntax td;
@@ -143,21 +148,21 @@ module CompletionModuleType = struct
 			| None -> false
 			| Some c -> PMap.mem "_new" c.cl_statics
 		in
-		let is_extern,kind,has_ctor = match mt with
+		let is_extern,is_final,kind,has_ctor = match mt with
 			| TClassDecl c ->
-				c.cl_extern,(if c.cl_interface then Interface else Class),has_constructor c
+				c.cl_extern,c.cl_final,(if c.cl_interface then Interface else Class),has_constructor c
 			| TEnumDecl en ->
-				en.e_extern,Enum,false
+				en.e_extern,false,Enum,false
 			| TTypeDecl td ->
 				let kind,has_ctor = match follow td.t_type with
 					| TAnon _ -> Struct,false
 					| TInst(c,_) -> TypeAlias,has_constructor c
 					| TAbstract(a,_) -> TypeAlias,has_ctor a
 					| _ -> TypeAlias,false
 				in
-				false,kind,has_ctor
+				false,false,kind,has_ctor
 			| TAbstractDecl a ->
-				false,(if Meta.has Meta.Enum a.a_meta then EnumAbstract else Abstract),has_ctor a
+				false,false,(if Meta.has Meta.Enum a.a_meta then EnumAbstract else Abstract),has_ctor a
 		in
 		let infos = t_infos mt in
 		let convert_type_param (s,t) = match follow t with
@@ -180,6 +185,7 @@ module CompletionModuleType = struct
 			meta = infos.mt_meta;
 			doc = infos.mt_doc;
 			is_extern = is_extern;
+			is_final = is_final;
 			kind = kind;
 			has_constructor = if has_ctor then Yes else No;
 			source = Typed mt;
@@ -238,7 +244,7 @@ end
 let decl_of_class c = match c.cl_kind with
 	| KAbstractImpl a -> TAbstractDecl a
 	| _ -> TClassDecl c
-	
+
 module CompletionClassField = struct
 	type t = {
 		field : tclass_field;

src/core/type.ml

@@ -190,6 +190,7 @@ and tclass_field = {
 	mutable cf_expr_unoptimized : tfunc option;
 	mutable cf_overloads : tclass_field list;
 	mutable cf_extern : bool; (* this is only true if the field itself is extern, not its class *)
+	mutable cf_final : bool;
 }
 
 and tclass_kind =
@@ -227,6 +228,7 @@ and tclass = {
 	(* do not insert any fields above *)
 	mutable cl_kind : tclass_kind;
 	mutable cl_extern : bool;
+	mutable cl_final : bool;
 	mutable cl_interface : bool;
 	mutable cl_super : (tclass * tparams) option;
 	mutable cl_implements : (tclass * tparams) list;
@@ -422,6 +424,7 @@ let mk_class m path pos name_pos =
 		cl_private = false;
 		cl_kind = KNormal;
 		cl_extern = false;
+		cl_final = false;
 		cl_interface = false;
 		cl_params = [];
 		cl_super = None;
@@ -477,6 +480,7 @@ let mk_field name t p name_pos = {
 	cf_params = [];
 	cf_overloads = [];
 	cf_extern = false;
+	cf_final = false;
 }
 
 let null_module = {
@@ -1422,6 +1426,7 @@ module Printer = struct
 			"cl_params",s_type_params c.cl_params;
 			"cl_kind",s_class_kind c.cl_kind;
 			"cl_extern",string_of_bool c.cl_extern;
+			"cl_final",string_of_bool c.cl_final;
 			"cl_interface",string_of_bool c.cl_interface;
 			"cl_super",s_opt (fun (c,tl) -> s_type (TInst(c,tl))) c.cl_super;
 			"cl_implements",s_list ", " (fun (c,tl) -> s_type (TInst(c,tl))) c.cl_implements;
@@ -1555,6 +1560,7 @@ module Printer = struct
 		| HPrivate -> "HPrivate"
 		| HExtends tp -> "HExtends " ^ (s_type_path (fst tp))
 		| HImplements tp -> "HImplements " ^ (s_type_path (fst tp))
+		| HFinal -> "HFinal"
 
 	let s_placed f (x,p) =
 		s_pair (f x) (s_pos p)

src/generators/genas3.ml

@@ -967,9 +967,6 @@ and gen_value ctx e =
 		)) e.etype e.epos);
 		v()
 
-let final m =
-	if Meta.has Meta.Final m then " final " else ""
-
 let generate_field ctx static f =
 	newline ctx;
 	ctx.in_static <- static;
@@ -1006,7 +1003,7 @@ let generate_field ctx static f =
 	let p = ctx.curclass.cl_pos in
 	match f.cf_expr, f.cf_kind with
 	| Some { eexpr = TFunction fd }, Method (MethNormal | MethInline) ->
-		print ctx "%s%s " rights (if static then "" else final f.cf_meta);
+		print ctx "%s%s " rights (if static || not f.cf_final then "" else " final ");
 		let rec loop c =
 			match c.cl_super with
 			| None -> ()
@@ -1099,7 +1096,7 @@ let generate_class ctx c =
 	define_getset ctx false c;
 	ctx.local_types <- List.map snd c.cl_params;
 	let pack = open_block ctx in
-	print ctx "\tpublic %s%s%s %s " (final c.cl_meta) (match c.cl_dynamic with None -> "" | Some _ -> if c.cl_interface then "" else "dynamic ") (if c.cl_interface then "interface" else "class") (snd c.cl_path);
+	print ctx "\tpublic %s%s%s %s " (if c.cl_final then " final " else "") (match c.cl_dynamic with None -> "" | Some _ -> if c.cl_interface then "" else "dynamic ") (if c.cl_interface then "interface" else "class") (snd c.cl_path);
 	(match c.cl_super with
 	| None -> ()
 	| Some (csup,_) -> print ctx "extends %s " (s_path ctx true csup.cl_path c.cl_pos));

src/generators/gencs.ml

@@ -630,7 +630,6 @@ let rec get_class_modifiers meta cl_type cl_access cl_modifiers =
 		| (Meta.Internal,[],_) :: meta -> get_class_modifiers meta cl_type "internal" cl_modifiers
 		(* no abstract for now | (":abstract",[],_) :: meta -> get_class_modifiers meta cl_type cl_access ("abstract" :: cl_modifiers)
 		| (":static",[],_) :: meta -> get_class_modifiers meta cl_type cl_access ("static" :: cl_modifiers) TODO: support those types *)
-		| (Meta.Final,[],_) :: meta -> get_class_modifiers meta cl_type cl_access ("sealed" :: cl_modifiers)
 		| (Meta.Unsafe,[],_) :: meta -> get_class_modifiers meta cl_type cl_access ("unsafe" :: cl_modifiers)
 		| _ :: meta -> get_class_modifiers meta cl_type cl_access cl_modifiers
 
@@ -1847,7 +1846,7 @@ let generate con =
 													acc
 
 												(* non-sealed class *)
-												| TInst ({ cl_interface = false; cl_meta = meta},_) when not (Meta.has Meta.Final meta) ->
+												| TInst ({ cl_interface = false; cl_final = false},_) ->
 													base_class_constraints := (t_s t) :: !base_class_constraints;
 													acc;
 
@@ -1907,10 +1906,10 @@ let generate con =
 			let fn_is_final = function
 				| None -> true
 				| Some ({ cf_kind = Method mkind } as m) ->
-					(match mkind with | MethInline -> true | _ -> false) || Meta.has Meta.Final m.cf_meta
+					(match mkind with | MethInline -> true | _ -> false) || m.cf_final
 				| _ -> assert false
 			in
-			let is_virtual = not (is_interface || is_final || Meta.has Meta.Final prop.cf_meta || fn_is_final get || fn_is_final set) in
+			let is_virtual = not (is_interface || is_final || prop.cf_final || fn_is_final get || fn_is_final set) in
 
 			let fn_is_override = function
 				| Some cf -> List.memq cf cl.cl_overrides
@@ -2045,7 +2044,7 @@ let generate con =
 					end (* TODO see how (get,set) variable handle when they are interfaces *)
 				| Method _ when not (Type.is_physical_field cf) || (match cl.cl_kind, cf.cf_expr with | KAbstractImpl _, None -> true | _ -> false) ->
 					List.iter (fun cf -> if cl.cl_interface || cf.cf_expr <> None then
-						gen_class_field w ~is_overload:true is_static cl (Meta.has Meta.Final cf.cf_meta) cf
+						gen_class_field w ~is_overload:true is_static cl cf.cf_final cf
 					) cf.cf_overloads
 				| Var _ | Method MethDynamic -> ()
 				| Method _ when is_new && Meta.has Meta.Struct cl.cl_meta && fst (get_fun cf.cf_type) = [] ->
@@ -2065,15 +2064,15 @@ let generate con =
 							| _ -> ());
 						List.iter (fun cf ->
 							if cl.cl_interface || cf.cf_expr <> None then
-								gen_class_field w ~is_overload:true is_static cl (Meta.has Meta.Final cf.cf_meta) cf
+								gen_class_field w ~is_overload:true is_static cl cf.cf_final cf
 						) cf.cf_overloads;
 				| Method mkind ->
 					List.iter (fun cf ->
 						if cl.cl_interface || cf.cf_expr <> None then
-							gen_class_field w ~is_overload:true is_static cl (Meta.has Meta.Final cf.cf_meta) cf
+							gen_class_field w ~is_overload:true is_static cl cf.cf_final cf
 					) cf.cf_overloads;
 					let is_virtual = not is_final && match mkind with | MethInline -> false | _ when not is_new -> true | _ -> false in
-					let is_virtual = if not is_virtual || Meta.has Meta.Final cf.cf_meta then false else is_virtual in
+					let is_virtual = if not is_virtual || cf.cf_final then false else is_virtual in
 					let is_override = List.memq cf cl.cl_overrides in
 					let is_override = is_override || match cf.cf_name, follow cf.cf_type with
 						| "Equals", TFun([_,_,targ], tret) ->
@@ -2085,7 +2084,7 @@ let generate con =
 					in
 					let is_override = if Meta.has (Meta.Custom "?prop_impl") cf.cf_meta then false else is_override in
 
-					let is_virtual = is_virtual && not (Meta.has Meta.Final cl.cl_meta) && not (is_interface) in
+					let is_virtual = is_virtual && not cl.cl_final && not (is_interface) in
 					let visibility = if is_interface then "" else "public" in
 
 					let visibility, modifiers = get_fun_modifiers cf.cf_meta visibility [] in
@@ -2410,7 +2409,8 @@ let generate con =
 			in
 
 			let clt, access, modifiers = get_class_modifiers cl.cl_meta (if cl.cl_interface then "interface" else "class") "public" [] in
-			let is_final = clt = "struct" || Meta.has Meta.Final cl.cl_meta in
+			let modifiers = if cl.cl_final then "sealed" :: modifiers else modifiers in
+			let is_final = clt = "struct" || cl.cl_final in
 
 			let modifiers = [access] @ modifiers in
 			print w "%s %s %s" (String.concat " " modifiers) clt (change_clname (snd cl.cl_path));

src/generators/genjava.ml

@@ -940,7 +940,6 @@ let rec get_class_modifiers meta cl_type cl_access cl_modifiers =
 		| (Meta.Internal,[],_) :: meta -> get_class_modifiers meta cl_type "" cl_modifiers
 		(* no abstract for now | (":abstract",[],_) :: meta -> get_class_modifiers meta cl_type cl_access ("abstract" :: cl_modifiers)
 		| (Meta.Static,[],_) :: meta -> get_class_modifiers meta cl_type cl_access ("static" :: cl_modifiers) TODO: support those types *)
-		| (Meta.Final,[],_) :: meta -> get_class_modifiers meta cl_type cl_access ("final" :: cl_modifiers)
 		| _ :: meta -> get_class_modifiers meta cl_type cl_access cl_modifiers
 
 let rec get_fun_modifiers meta access modifiers =
@@ -1930,13 +1929,13 @@ let generate con =
 				end (* TODO see how (get,set) variable handle when they are interfaces *)
 			| Method _ when not (Type.is_physical_field cf) || (match cl.cl_kind, cf.cf_expr with | KAbstractImpl _, None -> true | _ -> false) ->
 				List.iter (fun cf -> if cl.cl_interface || cf.cf_expr <> None then
-					gen_class_field w ~is_overload:true is_static cl (Meta.has Meta.Final cf.cf_meta) cf
+					gen_class_field w ~is_overload:true is_static cl cf.cf_final cf
 				) cf.cf_overloads
 			| Var _ | Method MethDynamic -> ()
 			| Method mkind ->
 				List.iter (fun cf ->
 					if cl.cl_interface || cf.cf_expr <> None then
-						gen_class_field w ~is_overload:true is_static cl (Meta.has Meta.Final cf.cf_meta) cf
+						gen_class_field w ~is_overload:true is_static cl cf.cf_final cf
 				) cf.cf_overloads;
 				let is_virtual = is_new || (not is_final && match mkind with | MethInline -> false | _ when not is_new -> true | _ -> false) in
 				let is_override = match cf.cf_name with
@@ -2094,7 +2093,8 @@ let generate con =
 		gen_annotations w cl.cl_meta;
 
 		let clt, access, modifiers = get_class_modifiers cl.cl_meta (if cl.cl_interface then "interface" else "class") "public" [] in
-		let is_final = Meta.has Meta.Final cl.cl_meta in
+		let modifiers = if cl.cl_final then "final" :: modifiers else modifiers in
+		let is_final = cl.cl_final in
 
 		write_parts w (access :: modifiers @ [clt; (change_clname (snd cl.cl_path))]);
 

src/generators/genphp7.ml

@@ -3219,7 +3219,7 @@ class class_builder ctx (cls:tclass) =
 			Indicates if type should be declared as `final`
 		*)
 		method is_final =
-			if not (Meta.has Meta.Final cls.cl_meta) then
+			if not cls.cl_final then
 				false
 			else begin
 				let hacked = ref false in
@@ -3238,7 +3238,7 @@ class class_builder ctx (cls:tclass) =
 			Indicates if `field` should be declared as `final`
 		*)
 		method is_final_field (field:tclass_field) : bool =
-			Meta.has Meta.Final field.cf_meta
+			field.cf_final
 		(**
 			Check if there is no native php constructor in inheritance chain of this class.
 			E.g. `StsClass` does have a constructor while still can be called with `new StdClass()`.