[flash] native property support rework (#8241)

* add @:flash.property metadata

* factor out the assignment generation function

* merge this/super.field() call processing into the generic field call case

* extract field call generation into a separate function

* add a note

* rewrite extern get_/set_ calls to a property access (when the property is there)

* extract some functions

* extract more fucntions

* only consider non-physical properties when searching for properties for an accessor

* implement native getter/setter generation

* make swf loader generate proper get/set properties

* support private fields in genhxold

* patch getter/setter along with property type

* regenerate flash externs with new extern properties

* also rewrite static extern property accessors

* also generate static native properties

* remove @:flash.property, we don't really need it

* realize inherited fake accessors that are required by interfaces

* do not try to "realize" methods on interfaces, lol

* don't process interfaces that are already implemented by the super class

* also generate native getter/setter for properties with inherited get_/set_

* bring back the old overriding logic for normal @:getter/@:setter methods

* re-introduce @:flash.property

* only consider @:flash.property properties for generating native property(access)

* really bring back the old overriding logic for normal @:getter/@:setter methods

* error when implementing a native property without marking it with @:flash.property

* make as3 tests pass

should be good enough

* add some tests

src/codegen/swfLoader.ml

@@ -320,26 +320,66 @@ let build_class com c file =
 			| Some (t1,meta1), Some (t2,meta2) -> true, true, (if t1 <> t2 then None else t1), meta1 @ (List.filter (fun m -> not (List.mem m meta1)) meta2)
 		) in
 		let t = if name = "endian" then Some (HMPath (["flash";"utils"],"Endian")) else t in
-		let flags = [APublic,null_pos] in
-		let flags = if stat then (AStatic,null_pos) :: flags else flags in
+		let flags, accessor_flags = [APublic,null_pos], [APrivate,null_pos] in
+		let flags, accessor_flags = if stat then (AStatic,null_pos) :: flags, (AStatic,null_pos) :: accessor_flags else flags, accessor_flags in
+		let property_typehint = Some (make_dyn_type t,null_pos) in
+		let fields = [] in
+		let read_access, fields =
+			if get then
+				let getter = {
+					cff_name = "get_" ^ name,null_pos;
+					cff_pos = pos;
+					cff_doc = None;
+					cff_access = accessor_flags;
+					cff_meta = [];
+					cff_kind = FFun {
+						f_params = [];
+						f_args = [];
+						f_type = property_typehint;
+						f_expr = None;
+					};
+				} in
+				("get",null_pos), getter :: fields
+			else
+				("never",null_pos), fields
+		in
+		let write_access, fields =
+			if set then
+				let setter = {
+					cff_name = "set_" ^ name,null_pos;
+					cff_pos = pos;
+					cff_doc = None;
+					cff_access = accessor_flags;
+					cff_meta = [];
+					cff_kind = FFun {
+						f_params = [];
+						f_args = [(("value",null_pos),false,[],property_typehint,None)];
+						f_type = property_typehint;
+						f_expr = None;
+					};
+				} in
+				("set",null_pos), setter :: fields
+			else
+				("never",null_pos), fields
+		in
 		{
 			cff_name = name,null_pos;
 			cff_pos = pos;
 			cff_doc = None;
 			cff_access = flags;
-			cff_meta = meta;
-			cff_kind = if get && set then FVar (Some (make_dyn_type t,null_pos), None) else FProp (((if get then "default" else "never"),null_pos),((if set then "default" else "never"),null_pos),Some (make_dyn_type t,null_pos),None);
-		}
+			cff_meta = (Meta.FlashProperty,[],pos) :: meta;
+			cff_kind = FProp (read_access,write_access,property_typehint,None);
+		} :: fields
 	in
 	let fields = Hashtbl.fold (fun (name,stat) t acc ->
 		if Hashtbl.mem override (name,stat) then acc else
-		make_get_set name stat (Some t) (try Some (Hashtbl.find setters (name,stat)) with Not_found -> None) :: acc
+		make_get_set name stat (Some t) (try Some (Hashtbl.find setters (name,stat)) with Not_found -> None) @ acc
 	) getters fields in
 	let fields = Hashtbl.fold (fun (name,stat) t acc ->
 		if Hashtbl.mem getters (name,stat) || Hashtbl.mem override (name,stat) then
 			acc
 		else
-			make_get_set name stat None (Some t) :: acc
+			make_get_set name stat None (Some t) @ acc
 	) setters fields in
 	try
 		(*

src/core/meta.ml

@@ -50,6 +50,7 @@ type strict_meta =
 	| Final
 	| Fixed
 	| FlatEnum
+	| FlashProperty
 	| Font
 	| ForLoopVariable
 	| Forward
@@ -257,6 +258,7 @@ let get_info = function
 	| Final -> ":final",("Prevents a class or interface from being extended or a method from being overriden",[UsedOnEither [TClass;TClassField]])
 	| Fixed -> ":fixed",("Delcares an anonymous object to have fixed fields",[ (*UsedOn TObjectDecl(_)*)])
 	| FlatEnum -> ":flatEnum",("Internally used to mark an enum as being flat, i.e. having no function constructors",[UsedOn TEnum; UsedInternally])
+	| FlashProperty -> ":flash.property",("",[UsedOn TClassField; Platform Flash])
 	| Font -> ":font",("Embeds the given TrueType font into the class (must extend flash.text.Font)",[HasParam "TTF path";HasParam "Range String";UsedOn TClass])
 	| ForLoopVariable -> ":forLoopVariable",("Internally used to mark for-loop variables",[UsedInternally])
 	| Forward -> ":forward",("Forwards field access to underlying type",[HasParam "List of field names";UsedOn TAbstract])

src/generators/flashProps.ml

@@ -0,0 +1,60 @@
+(*
+	The Haxe Compiler
+	Copyright (C) 2005-2019  Haxe Foundation
+
+	This program is free software; you can redistribute it and/or
+	modify it under the terms of the GNU General Public License
+	as published by the Free Software Foundation; either version 2
+	of the License, or (at your option) any later version.
+
+	This program is distributed in the hope that it will be useful,
+	but WITHOUT ANY WARRANTY; without even the implied warranty of
+	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+	GNU General Public License for more details.
+
+	You should have received a copy of the GNU General Public License
+	along with this program; if not, write to the Free Software
+	Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+ *)
+open Type
+
+let is_getter_name name = ExtString.String.starts_with name "get_"
+let is_setter_name name = ExtString.String.starts_with name "set_"
+let get_property_name accessor_name = String.sub accessor_name 4 (String.length accessor_name - 4)
+let is_flash_property cf = Meta.has Meta.FlashProperty cf.cf_meta
+
+let find_property_for_accessor ~isget cl tl accessor_name =
+	let prop_name = get_property_name accessor_name in
+	try
+		match Type.class_field cl tl prop_name with
+		| Some (prop_cl, prop_tl), _, prop_cf ->
+			(match prop_cf.cf_kind with
+			| Var { v_read = AccCall; v_write = AccCall | AccNever } when isget && is_flash_property prop_cf -> Some (prop_cl, prop_tl, prop_cf)
+			| Var { v_read = AccCall | AccNever; v_write = AccCall } when not isget && is_flash_property prop_cf -> Some (prop_cl, prop_tl, prop_cf)
+			| _ -> None)
+		| _ -> None
+	with Not_found ->
+		None
+
+let is_extern_instance_accessor ~isget cl tl cf =
+	if cl.cl_extern && (if isget then is_getter_name cf.cf_name else is_setter_name cf.cf_name) then
+		find_property_for_accessor ~isget cl tl cf.cf_name
+	else
+		None
+
+let find_static_property_for_accessor ~isget cl accessor_name =
+	let prop_name = get_property_name accessor_name in
+	try
+		let prop_cf = PMap.find prop_name cl.cl_statics in
+		(match prop_cf.cf_kind with
+		| Var { v_read = AccCall; v_write = AccCall | AccNever } when isget && is_flash_property prop_cf -> Some prop_cf
+		| Var { v_read = AccCall | AccNever; v_write = AccCall } when not isget && is_flash_property prop_cf -> Some prop_cf
+		| _ -> None)
+	with Not_found ->
+		None
+
+let is_extern_static_accessor ~isget cl cf =
+	if cl.cl_extern && (if isget then is_getter_name cf.cf_name else is_setter_name cf.cf_name) then
+		find_static_property_for_accessor ~isget cl cf.cf_name
+	else
+		None

src/generators/genas3.ml

@@ -19,6 +19,7 @@
 
 open Type
 open Common
+open FlashProps
 
 type context_infos = {
 	com : Common.context;
@@ -533,11 +534,55 @@ and gen_call ctx e el r =
 		concat ctx "," (gen_value ctx) el;
 		spr ctx ")";
 		print ctx ") as %s)" s
+	| TField (e1, f), el ->
+		begin
+		let default () = gen_call_default ctx e el in
+		let mk_prop_acccess prop_cl prop_tl prop_cf = mk (TField (e1, FInstance (prop_cl, prop_tl, prop_cf))) prop_cf.cf_type e.epos in
+		let mk_static_acccess cl prop_cf = mk (TField (e1, FStatic (cl, prop_cf))) prop_cf.cf_type e.epos in
+		let gen_assign lhs rhs = gen_expr ctx (mk (TBinop (OpAssign, lhs, rhs)) rhs.etype e.epos) in
+		match f, el with
+		| FInstance (cl, tl, cf), [] ->
+			(match is_extern_instance_accessor ~isget:true cl tl cf with
+			| Some (prop_cl, prop_tl, prop_cf) ->
+				let efield = mk_prop_acccess prop_cl prop_tl prop_cf in
+				gen_expr ctx efield
+			| None ->
+				default ())
+
+		| FInstance (cl, tl, cf), [evalue] ->
+			(match is_extern_instance_accessor ~isget:false cl tl cf with
+			| Some (prop_cl, prop_tl, prop_cf) ->
+				let efield = mk_prop_acccess prop_cl prop_tl prop_cf in
+				gen_assign efield evalue
+			| None ->
+				default ())
+
+		| FStatic (cl, cf), [] ->
+			(match is_extern_static_accessor ~isget:true cl cf with
+			| Some prop_cf ->
+				let efield = mk_static_acccess cl prop_cf in
+				gen_expr ctx efield
+			| None ->
+				default ())
+
+		| FStatic (cl, cf), [evalue] ->
+			(match is_extern_static_accessor ~isget:false cl cf with
+			| Some prop_cf ->
+				let efield = mk_static_acccess cl prop_cf in
+				gen_assign efield evalue
+			| None ->
+				default ())
+		| _ ->
+			default ()
+		end
 	| _ ->
-		gen_value ctx e;
-		spr ctx "(";
-		concat ctx "," (gen_value ctx) el;
-		spr ctx ")"
+		gen_call_default ctx e el
+
+and gen_call_default ctx e el =
+	gen_value ctx e;
+	spr ctx "(";
+	concat ctx "," (gen_value ctx) el;
+	spr ctx ")"
 
 and gen_value_op ctx e =
 	match e.eexpr with

src/generators/genhxold.ml

@@ -153,6 +153,7 @@ let generate_type com t =
 	let rec print_field stat f =
 		p "\t";
 		print_meta f.cf_meta;
+		if not (has_class_field_flag f CfPublic) then p "private ";
 		if stat then p "static ";
 		let name = try (match Meta.get Meta.RealPath f.cf_meta with
 				| (Meta.RealPath, [EConst( String s ), _], _) ->
@@ -233,7 +234,7 @@ let generate_type com t =
 		p "%s" (String.concat "" (List.rev ext));
 		p " {\n";
 		let sort l =
-			let a = Array.of_list (List.filter (fun f -> has_class_field_flag f CfPublic && not (List.memq f c.cl_overrides)) l) in
+			let a = Array.of_list (List.filter (fun f -> not (List.memq f c.cl_overrides)) l) in
 			let name = function "new" -> "" | n -> n in
 			Array.sort (fun f1 f2 ->
 				match f1.cf_kind, f2.cf_kind with