Private getters/setters (#12204)

* Private getters/setters

* Add public error, expose AccPrivateCall to haxe

and make different property access error more readable

* macro test

src/codegen/codegen.ml

@@ -28,8 +28,8 @@ open Extlib_leftovers
 let rec has_properties c =
 	List.exists (fun f ->
 		match f.cf_kind with
-		| Var { v_read = AccCall } -> true
-		| Var { v_write = AccCall } -> true
+		| Var { v_read = AccCall | AccPrivateCall } -> true
+		| Var { v_write = AccCall | AccPrivateCall } -> true
 		| _ when Meta.has Meta.Accessor f.cf_meta -> true
 		| _ -> false
 	) c.cl_ordered_fields || (match c.cl_super with Some (c,_) -> has_properties c | _ -> false)
@@ -40,10 +40,10 @@ let get_properties fields =
 			(f.cf_name, f.cf_name) :: acc
 		else
 			let acc = (match f.cf_kind with
-			| Var { v_read = AccCall } -> ("get_" ^ f.cf_name , "get_" ^ f.cf_name) :: acc
+			| Var { v_read = AccCall | AccPrivateCall } -> ("get_" ^ f.cf_name , "get_" ^ f.cf_name) :: acc
 			| _ -> acc) in
 			match f.cf_kind with
-			| Var { v_write = AccCall } -> ("set_" ^ f.cf_name , "set_" ^ f.cf_name) :: acc
+			| Var { v_write = AccCall | AccPrivateCall } -> ("set_" ^ f.cf_name , "set_" ^ f.cf_name) :: acc
 			| _ -> acc
 	) [] fields
 

src/codegen/genxml.ml

@@ -135,7 +135,7 @@ and gen_field att f =
 		match acc with
 		| AccNormal | AccRequire _ | AccCtor -> att
 		| AccNo | AccNever -> (name, "null") :: att
-		| AccCall -> (name,"accessor") :: att
+		| AccCall | AccPrivateCall -> (name,"accessor") :: att
 		| AccInline -> (name,"inline") :: att
 	in
 	let att = (match f.cf_expr with None -> att | Some e -> ("line",string_of_int (Lexer.get_error_line e.epos)) :: att) in

src/compiler/hxb/hxbReader.ml

@@ -993,6 +993,7 @@ class hxb_reader
 					let s = self#read_string in
 					let so = self#read_option (fun () -> self#read_string) in
 					AccRequire(s,so)
+				| 7 -> AccPrivateCall
 				| i ->
 					error (Printf.sprintf "Bad accessor kind: %i" i)
 			in

src/compiler/hxb/hxbWriter.ml

@@ -1710,6 +1710,7 @@ module HxbWriter = struct
 					Chunk.write_u8 writer.chunk 6;
 					Chunk.write_string writer.chunk s;
 					Chunk.write_option writer.chunk so (Chunk.write_string writer.chunk)
+				| AccPrivateCall -> Chunk.write_u8 writer.chunk 7
 			in
 			f r;
 			f w

src/context/display/findReferences.ml

@@ -39,7 +39,7 @@ let rec collect_reference_positions com (name,pos,kind) =
 			| Var vk ->
 				let host = FieldAccess.get_host c cf in
 				let check r mode = match r with
-					| AccCall ->
+					| AccCall | AccPrivateCall ->
 						begin match FieldAccess.find_accessor_for_field host cf cf.cf_type mode with
 						| AccessorFound (cf_acc,new_host) ->
 							let c_host = FieldAccess.get_host_class_raise new_host in

src/context/typecore.ml

@@ -517,8 +517,12 @@ let needs_inline ctx c cf =
 	cf.cf_kind = Method MethInline && ctx.allow_inline && (ctx.com.doinline || is_forced_inline c cf)
 
 (** checks if we can access to a given class field using current context *)
-let can_access ctx c cf stat =
-	if (has_class_field_flag cf CfPublic) then
+let can_access ctx c cf ?(check_prop=false) ?(is_setter=false) stat =
+	let is_not_private_prop = not check_prop || match cf.cf_kind with
+		| Var { v_read = AccPrivateCall } when not is_setter -> false
+		| Var { v_write = AccPrivateCall } when is_setter -> false
+		| _ -> true in
+	if (is_not_private_prop && has_class_field_flag cf CfPublic) then
 		true
 	else if c == ctx.c.curclass then
 		true

src/core/json/genjson.ml

@@ -497,6 +497,7 @@ and generate_class_field' ctx cfs cf =
 				| AccNever -> "AccNever",None
 				| AccCtor -> "AccCtor",None
 				| AccCall -> "AccCall",None
+				| AccPrivateCall -> "AccPrivateCall",None
 				| AccInline -> "AccInline",None
 				| AccRequire(s,so) -> "AccRequire",Some (jobject ["require",jstring s;"message",jopt jstring so])
 			in
@@ -736,4 +737,4 @@ let generate timer_ctx types file =
 		let ch = open_out_bin file in
 		Json.write_json (output_string ch) json;
 		close_out ch;
-	) ()
+	) ()

src/core/tOther.ml

@@ -58,7 +58,7 @@ module TExprToExpr = struct
 								| AccNormal | AccCtor | AccInline | AccRequire _ -> "default"
 								| AccNo -> "null"
 								| AccNever -> "never"
-								| AccCall -> get_or_set
+								| AccCall | AccPrivateCall -> get_or_set
 							in
 							let read = (var_access_to_string v.v_read "get",null_pos) in
 							let write = (var_access_to_string v.v_write "set",null_pos) in

src/core/tPrinting.ml

@@ -164,6 +164,7 @@ let s_access is_read = function
 	| AccNo -> "null"
 	| AccNever -> "never"
 	| AccCall -> if is_read then "get" else "set"
+	| AccPrivateCall -> if is_read then "private get" else "private set"
 	| AccInline	-> "inline"
 	| AccRequire (n,_) -> "require " ^ n
 	| AccCtor -> "ctor"

src/core/tType.ml

@@ -16,6 +16,7 @@ and var_access =
 	| AccNever          (* can't be accessed, even in subclasses *)
 	| AccCtor           (* can only be accessed from the constructor *)
 	| AccCall           (* perform a method call when accessed *)
+	| AccPrivateCall    (* perform a method call when accessed, but private like AccNo *)
 	| AccInline         (* similar to Normal but inline when accessed *)
 	| AccRequire of string * string option (* set when @:require(cond) fails *)
 

src/core/tUnification.ml

@@ -511,11 +511,12 @@ let unify_access a1 a2 =
 	a1 = a2 || match a1, a2 with
 	| _, AccNo | _, AccNever -> true
 	| AccInline, AccNormal -> true
+	| AccCall, AccPrivateCall -> true
 	| _ -> false
 
 let direct_access = function
 	| AccNo | AccNever | AccNormal | AccInline | AccRequire _ | AccCtor -> true
-	| AccCall -> false
+	| AccCall | AccPrivateCall -> false
 
 let unify_kind ~(strict:bool) k1 k2 =
 	k1 = k2 || match k1, k2 with
@@ -908,8 +909,8 @@ let rec unify (uctx : unification_context) a b =
 							with Not_found ->
 								()
 						in
-						(match vk.v_read with AccCall -> check ("get_" ^ f1.cf_name) | _ -> ());
-						(match vk.v_write with AccCall -> check ("set_" ^ f1.cf_name) | _ -> ());
+						(match vk.v_read with AccCall | AccPrivateCall -> check ("get_" ^ f1.cf_name) | _ -> ());
+						(match vk.v_write with AccCall | AccPrivateCall -> check ("set_" ^ f1.cf_name) | _ -> ());
 					| _ -> ()
 				end;
 				(match f1.cf_kind with

src/generators/cpp/cppRetyper.ml

@@ -1505,7 +1505,7 @@ let get_id path ids =
   | None ->
     let new_id = make_id 0 in
     (new_id, ObjectIds.add path new_id ids)
-  
+
 let native_field_name_remap field =
   match get_meta_string field.cf_meta Meta.Native with
   | Some nativeImpl ->
@@ -1533,7 +1533,7 @@ let rec tcpp_class_from_tclass ctx ids slots class_def class_params =
     tcv_type = field.cf_type;
     tcv_default = None;
 
-    tcv_has_getter = (match field.cf_kind with | Var { v_read = AccCall } -> true | _ -> false);
+    tcv_has_getter = (match field.cf_kind with | Var { v_read = AccCall | AccPrivateCall } -> true | _ -> false);
     tcv_is_stackonly = has_meta Meta.StackOnly field.cf_meta;
     tcv_is_reflective = reflective class_def field;
     tcv_is_gc_element = cpp_type_of field.cf_type |> is_gc_element ctx;
@@ -1567,14 +1567,14 @@ let rec tcpp_class_from_tclass ctx ids slots class_def class_params =
             (* We can't implement abstract functions as pure virtual due to cppia needing to construct the class *)
             let map_arg (name, _, t) =
               ( (alloc_var VGenerated name t null_pos), (get_default_value name) ) in
-            let expr = 
+            let expr =
               match follow ret with
               | TAbstract ({ a_path = ([], "Void") }, _) ->
                 { eexpr = TReturn None; etype = ret; epos = null_pos }
               | _ ->
                 let zero_val = Some { eexpr = TConst (TInt Int32.zero); etype = ret; epos = null_pos } in
                 { eexpr = TReturn zero_val; etype = ret; epos = null_pos } in
-            
+
             {
               tf_args = args |> List.map map_arg;
               tf_type = ret;
@@ -1611,7 +1611,7 @@ let rec tcpp_class_from_tclass ctx ids slots class_def class_params =
       | Var _, _ ->
         Some (create_variable field)
       (* Dynamic methods are implemented as a physical field holding a closure *)
-      | Method MethDynamic, Some { eexpr = TFunction func } -> 
+      | Method MethDynamic, Some { eexpr = TFunction func } ->
         Some (create_variable { field with cf_expr = None; cf_kind = Var ({ v_read = AccNormal; v_write = AccNormal }) })
       (* Below should cause abstracts which have functions with no implementation to be generated as a field *)
       (* See Int32.hx as an example *)
@@ -1631,7 +1631,7 @@ let rec tcpp_class_from_tclass ctx ids slots class_def class_params =
       None in
 
   let id, ids = get_id class_def.cl_path ids in
-  
+
   let static_functions =
     class_def.cl_ordered_statics
     |> List.filter_map (filter_functions true) in
@@ -1650,7 +1650,7 @@ let rec tcpp_class_from_tclass ctx ids slots class_def class_params =
     |> List.filter (fun field -> field.cf_name <> "__meta__" && field.cf_name <> "__rtti")
     |> List.filter_map filter_properties in
 
-  let functions = 
+  let functions =
     class_def.cl_ordered_fields
     |> List.filter_map (filter_functions true) in
 
@@ -1822,4 +1822,4 @@ and tcpp_enum_from_tenum ctx ids enum_def =
   in
   let enum = { te_enum = enum_def; te_id = self_id; te_constructors = constructors } in
 
-  (ids, enum)
+  (ids, enum)

src/generators/cpp/gen/cppCppia.ml

@@ -1799,7 +1799,7 @@ let generate_script_class common_ctx script class_def =
           | AccNormal | AccCtor -> IaAccessNormal
           | AccNo -> IaAccessNot
           | AccNever -> IaAccessNot
-          | AccCall ->
+          | AccCall | AccPrivateCall ->
               if
                 Meta.has Meta.NativeProperty class_def.cl_meta
                 || Meta.has Meta.NativeProperty field.cf_meta

src/generators/cpp/gen/cppGenClassImplementation.ml

@@ -47,7 +47,7 @@ let gen_function ctx class_def class_name is_static func =
       (gen_cpp_function_body ctx class_def is_static func.tcf_field.cf_name func.tcf_func code tail_code);
 
     output "\n\n";
-    
+
     (* generate dynamic version too ... *)
     if (not func.tcf_is_virtual || not func.tcf_is_overriding) && func.tcf_is_reflective then
       let tcpp_args = List.map (fun (v, _) -> cpp_type_of v.v_type) func.tcf_func.tf_args in
@@ -85,7 +85,7 @@ let gen_function ctx class_def class_name is_static func =
             Printf.sprintf "(::cpp::Struct< %s >) a%i" (tcpp_to_string arg) idx
           | _ ->
             Printf.sprintf "a%i" idx in
-            
+
         tcpp_args
         |> ExtList.List.mapi cast_prefix
         |> String.concat ", "
@@ -120,7 +120,7 @@ let gen_dynamic_function ctx class_def class_name is_static is_for_static_var (f
   let ret = if is_void then "(void)" else "return " in
 
   ctx.ctx_real_this_ptr <- false;
-  Printf.sprintf "HX_BEGIN_DEFAULT_FUNC(%s, %s)\n" func_name class_name |> output; 
+  Printf.sprintf "HX_BEGIN_DEFAULT_FUNC(%s, %s)\n" func_name class_name |> output;
   Printf.sprintf "%s _hx_run(%s)" return_type_str (print_arg_list func.tcf_func.tf_args "__o_") |> output;
 
   gen_cpp_function_body ctx class_def is_static func_name func.tcf_func "" "" no_debug;
@@ -273,7 +273,7 @@ let generate_native_class base_ctx tcpp_class =
   output_cpp "\n";
 
   gen_dynamic_function_allocator ctx output_cpp tcpp_class;
-  
+
   generate_native_constructor ctx output_cpp class_def false;
   gen_boot_field ctx output_cpp tcpp_class;
 
@@ -394,13 +394,13 @@ let generate_managed_class base_ctx tcpp_class =
     let impl_name = cpp_class_name class_def in
 
     let fold_interface (glued, acc) interface =
-    
+
       let rec gen_interface_funcs interface =
 
         let fold_field (glued, acc) func =
           let cast      = cpp_tfun_signature false func.iff_args func.iff_return in
           let real_name = cpp_member_name_of func.iff_field in
-          
+
           (* C++ can't work out which function it needs to take the addrss of
               when the implementation is overloaded - currently the map-set functions.
               Change the castKey to force a glue function in this case (could double-cast the pointer, but it is ugly)
@@ -452,7 +452,7 @@ let generate_managed_class base_ctx tcpp_class =
       let call     = Printf.sprintf "static %s %s_%s = {\n%s\n};\n" (cpp_class_name interface.if_class) cname interface_name combined in
       (glued, call :: acc)
     in
-    
+
     let glued, calls =
       List.fold_left
         fold_interface
@@ -615,7 +615,7 @@ let generate_managed_class base_ctx tcpp_class =
     else
       acc
   in
-  
+
   let castable f =
     match cpp_type_of f.cf_type with
     | TCppInst (t, _) as inst when Meta.has Meta.StructAccess t.cl_meta ->
@@ -671,7 +671,7 @@ let generate_managed_class base_ctx tcpp_class =
           Printf.sprintf "%s = inValue.Cast< %s >(); return inValue;" var.tcv_name casted in
 
         match var.tcv_field.cf_kind with
-        | Var { v_write = AccCall } ->
+        | Var { v_write = AccCall | AccPrivateCall } ->
           let prop_call = checkPropCall var.tcv_field in
           let setter    = Printf.sprintf "set_%s" var.tcv_field.cf_name |> get_wrapper var.tcv_field in
           let call      = Printf.sprintf "if (%s) { return ::hx::Val( %s(inValue.Cast< %s >()) ); } else { %s }" prop_call setter casted default in
@@ -690,7 +690,7 @@ let generate_managed_class base_ctx tcpp_class =
         let casted  = castable var.tcv_field in
 
         match var.tcv_field.cf_kind with
-        | Var { v_write = AccCall } ->
+        | Var { v_write = AccCall | AccPrivateCall } ->
           let prop_call = checkPropCall var.tcv_field in
           let setter    = Printf.sprintf "set_%s" var.tcv_field.cf_name |> get_wrapper var.tcv_field in
           let call      = Printf.sprintf "if (%s) { return ::hx::Val( %s(inValue.Cast< %s >()) ); }" prop_call setter casted in
@@ -717,7 +717,7 @@ let generate_managed_class base_ctx tcpp_class =
         let casted = castable var.tcv_field in
 
         match var.tcv_field.cf_kind with
-        | Var { v_write = AccCall } ->
+        | Var { v_write = AccCall | AccPrivateCall } ->
           let prop_call = checkPropCall var.tcv_field in
           let setter    = Printf.sprintf "set_%s" var.tcv_field.cf_name |> get_wrapper var.tcv_field in
           let call      = Printf.sprintf "if (%s) { ioValue = %s(ioValue.Cast< %s >()); } else { %s = ioValue.Cast< %s >(); } return true;" prop_call setter casted var.tcv_name casted in
@@ -734,7 +734,7 @@ let generate_managed_class base_ctx tcpp_class =
     let fold_property (var:tcpp_class_variable) acc =
       if var.tcv_is_reflective && not (is_abstract_impl class_def) then
         match var.tcv_field.cf_kind with
-        | Var { v_write = AccCall } ->
+        | Var { v_write = AccCall | AccPrivateCall } ->
           let prop_call = checkPropCall var.tcv_field in
           let setter    = Printf.sprintf "set_%s" var.tcv_field.cf_name |> get_wrapper var.tcv_field in
           let casted    = castable var.tcv_field in
@@ -965,7 +965,7 @@ let generate_managed_class base_ctx tcpp_class =
           | _ -> [] in
         current_virtual_functions_rev cls initial
       in
-    
+
       flatten_tcpp_class_functions_rec tcpp_class |> List.rev
     in
 

src/generators/flashProps.ml

@@ -29,8 +29,8 @@ let find_property_for_accessor ~isget cl tl accessor_name =
 		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)
+			| Var { v_read = AccCall | AccPrivateCall; v_write = AccCall | AccPrivateCall | AccNever } when isget && is_flash_property prop_cf -> Some (prop_cl, prop_tl, prop_cf)
+			| Var { v_read = AccCall | AccPrivateCall | AccNever; v_write = AccCall | AccPrivateCall } when not isget && is_flash_property prop_cf -> Some (prop_cl, prop_tl, prop_cf)
 			| _ -> None)
 		| _ -> None
 	with Not_found ->
@@ -47,8 +47,8 @@ let find_static_property_for_accessor ~isget cl accessor_name =
 	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
+		| Var { v_read = AccCall | AccPrivateCall; v_write = AccCall | AccPrivateCall | AccNever } when isget && is_flash_property prop_cf -> Some prop_cf
+		| Var { v_read = AccCall | AccPrivateCall | AccNever; v_write = AccCall | AccPrivateCall } when not isget && is_flash_property prop_cf -> Some prop_cf
 		| _ -> None)
 	with Not_found ->
 		None

src/generators/genphp7.ml

@@ -3891,6 +3891,8 @@ class class_builder ctx (cls:tclass) =
 					| Var { v_read = read; v_write = write } ->
 						if read = AccCall then getters := field.cf_name :: !getters;
 						if write = AccCall then setters := field.cf_name :: !setters;
+						if read = AccPrivateCall then getters := field.cf_name :: !getters;
+						if write = AccPrivateCall then setters := field.cf_name :: !setters;
 					| _ -> ()
 			in
 			List.iter collect cls.cl_ordered_fields;

src/generators/genpy.ml

@@ -1718,7 +1718,7 @@ module Generator = struct
 			match cf.cf_kind with
 				| Var _ when not (is_physical_field cf) ->
 					()
-				| Var({v_read = AccCall}) ->
+				| Var({v_read = AccCall | AccPrivateCall}) ->
 					if Meta.has Meta.IsVar cf.cf_meta then
 						DynArray.add fields cf.cf_name
 					else
@@ -1922,7 +1922,7 @@ module Generator = struct
 			print ctx "    @staticmethod\n    def _hx_empty_init(_hx_o):";
 			let found_fields = ref false in
 			List.iter (fun cf -> match cf.cf_kind with
-					| Var ({v_read = AccCall}) ->
+					| Var ({v_read = AccCall | AccPrivateCall}) ->
 						()
 					| Var _ ->
 						found_fields := true;

src/generators/genswf9.ml

@@ -2324,7 +2324,7 @@ let realize_required_accessors ctx cl =
 				if not (is_implemented_by_super ci) then begin
 					List.iter (fun cf ->
 						match cf.cf_kind with
-						| Var { v_read = (AccCall | AccNever) as read; v_write = (AccCall | AccNever) as write } ->
+						| Var { v_read = (AccCall | AccPrivateCall | AccNever) as read; v_write = (AccCall | AccPrivateCall | AccNever) as write } ->
 							begin try
 								let read', write', native = Hashtbl.find h cf.cf_name in
 								let read = if read = AccNever then read' else true in
@@ -2496,10 +2496,10 @@ let generate_class ctx c =
 				maybe_gen_instance_setter ctx c f acc alloc_slot
 			else
 				maybe_gen_static_setter ctx c f acc alloc_slot
-		| Var { v_read = (AccCall | AccNever) as read; v_write = (AccCall | AccNever) as write } when not (has_class_flag c CInterface) && not (Meta.has Meta.IsVar f.cf_meta) ->
+		| Var { v_read = (AccCall | AccPrivateCall | AccNever) as read; v_write = (AccCall | AccPrivateCall | AccNever) as write } when not (has_class_flag c CInterface) && not (Meta.has Meta.IsVar f.cf_meta) ->
 			(* if the accessor methods were defined in super classes, we still need to generate native getter/setter *)
 			let acc =
-				if read = AccCall then begin
+				if read = AccCall || read = AccPrivateCall then begin
 					try
 						begin
 						let tl = extract_param_types c.cl_params in
@@ -2524,7 +2524,7 @@ let generate_class ctx c =
 						acc
 				end else acc
 			in
-			if write = AccCall then begin
+			if write = AccCall || write = AccPrivateCall then begin
 				try
 					begin
 					let tl = extract_param_types c.cl_params in

src/macro/macroApi.ml

@@ -1126,6 +1126,7 @@ and encode_var_access a =
 		| AccInline	-> 5, []
 		| AccRequire (s,msg) -> 6, [encode_string s; null encode_string msg]
 		| AccCtor -> 7, []
+		| AccPrivateCall -> 8, []
 	) in
 	encode_enum IVarAccess tag pl
 
@@ -1452,6 +1453,7 @@ let decode_var_access v =
 	| 5, [] -> AccInline
 	| 6, [s1;s2] -> AccRequire(decode_string s1, opt decode_string s2)
 	| 7, [] -> AccCtor
+	| 8, [] -> AccPrivateCall
 	| _ -> raise Invalid_expr
 
 let decode_method_kind v =

src/optimization/dce.ml

@@ -140,8 +140,8 @@ let rec keep_field dce cf c kind =
 			with Not_found -> false
 		in
 		match cf.cf_kind with
-		| Var { v_read = AccCall } -> check_accessor "get_"
-		| Var { v_write = AccCall } -> check_accessor "set_"
+		| Var { v_read = AccCall | AccPrivateCall } -> check_accessor "get_"
+		| Var { v_write = AccCall | AccPrivateCall } -> check_accessor "set_"
 		| _ -> false
 	end
 
@@ -747,11 +747,17 @@ let fix_accessors types =
 				| Var {v_read = AccCall; v_write = a} ->
 					let s = "get_" ^ cf.cf_name in
 					cf.cf_kind <- Var {v_read = if has_accessor c s stat then AccCall else AccNever; v_write = a}
+				| Var {v_read = AccPrivateCall; v_write = a} ->
+					let s = "get_" ^ cf.cf_name in
+					cf.cf_kind <- Var {v_read = if has_accessor c s stat then AccPrivateCall else AccNever; v_write = a}
 				| _ -> ());
 				(match cf.cf_kind with
 				| Var {v_write = AccCall; v_read = a} ->
 					let s = "set_" ^ cf.cf_name in
 					cf.cf_kind <- Var {v_write = if has_accessor c s stat then AccCall else AccNever; v_read = a}
+				| Var {v_write = AccPrivateCall; v_read = a} ->
+					let s = "set_" ^ cf.cf_name in
+					cf.cf_kind <- Var {v_write = if has_accessor c s stat then AccPrivateCall else AccNever; v_read = a}
 				| _ -> ())
 			in
 			List.iter (check_prop true) c.cl_ordered_statics;
@@ -863,7 +869,7 @@ let sweep dce types =
 					if not (Meta.has Meta.Accessor cf.cf_meta) then cf.cf_meta <- (Meta.Accessor,[],mk_zero_range_pos c.cl_pos) :: cf.cf_meta
 				in
 				begin match cf.cf_kind with
-				| Var {v_read = AccCall} ->
+				| Var {v_read = AccCall | AccPrivateCall} ->
 					begin try
 						add_accessor_metadata (PMap.find ("get_" ^ cf.cf_name) (if stat then c.cl_statics else c.cl_fields))
 					with Not_found ->
@@ -873,7 +879,7 @@ let sweep dce types =
 					()
 				end;
 				begin match cf.cf_kind with
-				| Var {v_write = AccCall} ->
+				| Var {v_write = AccCall | AccPrivateCall} ->
 					begin try
 						add_accessor_metadata (PMap.find ("set_" ^ cf.cf_name) (if stat then c.cl_statics else c.cl_fields))
 					with Not_found ->

src/syntax/grammar.ml

@@ -85,6 +85,7 @@ let lower_ident_or_macro = function%parser
 
 let property_ident = function%parser
 	| [ ident as i ] -> i
+	| [ (Kwd Private,p1); (Const (Ident i),p2) ] -> "private " ^ i, punion p1 p2
 	| [ (Kwd Dynamic,p) ] -> "dynamic",p
 	| [ (Kwd Default,p) ] -> "default",p
 	| [ (Kwd Null,p) ] -> "null",p

src/typing/callUnification.ml

@@ -626,7 +626,7 @@ object(self)
 			end;
 		| Var v ->
 			begin match (if is_set then v.v_write else v.v_read) with
-			| AccCall ->
+			| AccCall | AccPrivateCall ->
 				self#accessor_call fa el_typed el
 			| _ ->
 				self#expr_call (FieldAccess.get_field_expr fa FCall) el_typed el
@@ -665,4 +665,4 @@ let make_static_call_better ctx c cf tl el t p =
 	let e1 = Builder.make_static_this c p in
 	let fa = FieldAccess.create e1 cf fh false p in
 	let fcc = unify_field_call ctx fa el [] p false in
-	fcc.fc_data()
+	fcc.fc_data()

src/typing/calls.ml

@@ -231,6 +231,19 @@ let rec acc_get ctx g =
 				FieldAccess.get_field_expr fa FRead
 		end
 	| AKAccessor fa ->
+		let c,stat = match fa.fa_host with
+			| FHInstance(c,tl) -> Some c,false
+			| FHStatic c -> Some c,true
+			| FHAbstract(a,tl,c) -> Some c,true
+			| FHAnon -> None,false
+		in
+		begin match c with
+			| Some c ->
+				let can = can_access ctx c fa.fa_field ~check_prop:true ~is_setter:false stat in
+				if not can then
+					raise_typing_error "This property cannot be accessed for reading" fa.fa_pos
+			| _ -> ()
+		end;
 		(dispatcher fa.fa_pos)#field_call fa [] []
 	| AKUsingAccessor sea ->
 		(dispatcher sea.se_access.fa_pos)#field_call sea.se_access [sea.se_this] []

src/typing/fieldAccess.ml

@@ -93,7 +93,7 @@ let get_field_expr fa mode =
 let find_accessor_for_field host cf t mode = match cf.cf_kind with
 	| Var v ->
 		begin match (match mode with MSet _ -> v.v_write | _ -> v.v_read) with
-			| AccCall ->
+			| AccCall | AccPrivateCall ->
 				let name = (match mode with MSet _ -> "set_" | _ -> "get_") ^ cf.cf_name in
 				let forward cf_acc new_host =
 					(cf_acc,new_host)

src/typing/fields.ml

@@ -174,9 +174,9 @@ let field_access ctx mode f fh e pfield =
 				()
 			end;
 			if e.eexpr = TConst TSuper then begin match mode with
-				| MGet | MCall _ when v.v_read = AccCall ->
+				| MGet | MCall _ when v.v_read = AccCall || v.v_read = AccPrivateCall ->
 					()
-				| MSet _ when v.v_write = AccCall ->
+				| MSet _ when v.v_write = AccCall || v.v_write = AccPrivateCall ->
 					()
 				| _ ->
 					display_error ctx.com "Normal variables cannot be accessed with 'super', use 'this' instead" pfield;
@@ -203,9 +203,9 @@ let field_access ctx mode f fh e pfield =
 				if ctx.f.untyped then normal false else normal_failure())
 		| AccNormal | AccNo ->
 			normal false
-		| AccCall when (not ctx.allow_transform) || (ctx.f.in_display && DisplayPosition.display_position#enclosed_in pfull) ->
+		| AccCall | AccPrivateCall when (not ctx.allow_transform) || (ctx.f.in_display && DisplayPosition.display_position#enclosed_in pfull) ->
 			normal false
-		| AccCall ->
+		| AccCall | AccPrivateCall ->
 			let m = (match mode with MSet _ -> "set_" | _ -> "get_") ^ f.cf_name in
 			let bypass_accessor =
 				(

src/typing/nullSafety.ml

@@ -1592,7 +1592,9 @@ class class_checker cls immediate_execution report (main_expr : texpr option) =
 										| _ -> ()
 					in
 					if read_access = AccCall then check_accessor "get_";
-					if write_access = AccCall then check_accessor "set_"
+					if write_access = AccCall then check_accessor "set_";
+					if read_access = AccPrivateCall then check_accessor "get_";
+					if write_access = AccPrivateCall then check_accessor "set_";
 				| _ -> ()
 		(**
 			Get safety mode for the current class

src/typing/operators.ml

@@ -598,6 +598,19 @@ let type_assign ctx e1 e2 with_type p =
 		| AKExpr e1  ->
 			assign_to e1
 		| AKAccessor fa ->
+			let c,stat = match fa.fa_host with
+				| FHInstance(c,tl) -> Some c,false
+				| FHStatic c -> Some c,true
+				| FHAbstract(a,tl,c) -> Some c,true
+				| _ -> None,false
+			in
+			begin match c with
+				| Some c ->
+					let can = can_access ctx c fa.fa_field ~check_prop:true ~is_setter:true stat in
+					if not can then
+						raise_typing_error "This property cannot be accessed for writing" fa.fa_pos
+				| _ -> ()
+			end;
 			let dispatcher = new call_dispatcher ctx (MSet (Some e2)) with_type p in
 			dispatcher#accessor_call fa [] [e2]
 		| AKAccess(a,tl,c,ebase,ekey) ->
@@ -1028,4 +1041,4 @@ let type_unop ctx op flag e with_type p =
 			| AKUsingField _ | AKResolve _ ->
 				raise_typing_error "Invalid operation" p
 		in
-		loop (!type_access_ref ctx (fst e) (snd e) (MSet None) WithType.value (* WITHTYPETODO *))
+		loop (!type_access_ref ctx (fst e) (snd e) (MSet None) WithType.value (* WITHTYPETODO *))

src/typing/typeload.ml

@@ -582,6 +582,8 @@ and load_complex_type' ctx allow_display mode (t,p) =
 						| "dynamic" -> AccCall
 						| "get" when get -> AccCall
 						| "set" when not get -> AccCall
+						| "private get" when get -> AccPrivateCall
+						| "private set" when not get -> AccPrivateCall
 						| x when get && x = "get_" ^ n -> AccCall
 						| x when not get && x = "set_" ^ n -> AccCall
 						| _ ->

src/typing/typeloadCheck.ml

@@ -385,7 +385,7 @@ module Inheritance = struct
 					if (has_class_field_flag f CfPublic) && not (has_class_field_flag f2 CfPublic) && not (Meta.has Meta.CompilerGenerated f.cf_meta) then
 						display_error com ("Field " ^ f.cf_name ^ " should be public as requested by " ^ s_type_path intf.cl_path) p
 					else if not (unify_kind ~strict:false f2.cf_kind f.cf_kind) || not (match f.cf_kind, f2.cf_kind with Var _ , Var _ -> true | Method m1, Method m2 -> mkind m1 = mkind m2 | _ -> false) then
-						display_error com ("Field " ^ f.cf_name ^ " has different property access than in " ^ s_type_path intf.cl_path ^ " (" ^ s_kind f2.cf_kind ^ " should be " ^ s_kind f.cf_kind ^ ")") p
+						display_error com ("Field " ^ f.cf_name ^ " has different property access than in " ^ s_type_path intf.cl_path ^ ": " ^ s_kind f2.cf_kind ^ " should be " ^ s_kind f.cf_kind) p
 					else try
 						let map1 = TClass.get_map_function  intf params in
 						valid_redefinition map1 map2 f2 t2 f (apply_params intf.cl_params params f.cf_type)

src/typing/typeloadFields.ml

@@ -1142,7 +1142,8 @@ let setup_args_ret ctx cctx fctx name fd p =
 		let name = String.sub name 4 (String.length name - 4) in
 		let cf = if fctx.is_static then PMap.find name c.cl_statics else PMap.find name c.cl_fields (* TODO: inheritance? *) in
 		match Lazy.force mk, cf.cf_kind with
-			| MKGetter, Var({v_read = AccCall}) | MKSetter, Var({v_write = AccCall}) -> cf.cf_type
+			| MKGetter, Var({v_read = AccCall | AccPrivateCall})
+			| MKSetter, Var({v_write = AccCall | AccPrivateCall}) -> cf.cf_type
 			| _ -> raise Not_found;
 	in
 	let maybe_use_property_type th check def =
@@ -1459,6 +1460,11 @@ let create_property (ctx,cctx,fctx) c f cf (get,set,t,eo) p =
 			if fctx.is_display_field && DisplayPosition.display_position#enclosed_in pget then delay ctx.g PConnectField (fun () -> display_accessor get pget);
 			if not cctx.is_lib then delay_check (fun() -> check_method get t_get true);
 			AccCall
+		| "private get",pget ->
+			let get = "get_" ^ name in
+			if fctx.is_display_field && DisplayPosition.display_position#enclosed_in pget then delay ctx.g PConnectField (fun () -> display_accessor get pget);
+			if not cctx.is_lib then delay_check (fun() -> check_method get t_get true);
+			AccPrivateCall
 		| _,pget ->
 			display_error ctx.com (name ^ ": Custom property accessor is no longer supported, please use `get`") pget;
 			AccCall
@@ -1478,11 +1484,18 @@ let create_property (ctx,cctx,fctx) c f cf (get,set,t,eo) p =
 			if fctx.is_display_field && DisplayPosition.display_position#enclosed_in pset then delay ctx.g PConnectField (fun () -> display_accessor set pset);
 			if not cctx.is_lib then delay_check (fun() -> check_method set t_set false);
 			AccCall
+		| "private set",pset ->
+			let set = "set_" ^ name in
+			if fctx.is_display_field && DisplayPosition.display_position#enclosed_in pset then delay ctx.g PConnectField (fun () -> display_accessor set pset);
+			if not cctx.is_lib then delay_check (fun() -> check_method set t_set false);
+			AccPrivateCall
 		| _,pset ->
 			display_error ctx.com (name ^ ": Custom property accessor is no longer supported, please use `set`") pset;
 			AccCall
 	) in
-	if (set = AccNever && get = AccNever)  then raise_typing_error (name ^ ": Unsupported property combination") p;
+	if (set = AccNever && get = AccNever) then raise_typing_error (name ^ ": Unsupported property combination") p;
+	if (set = AccPrivateCall && get = AccPrivateCall && has_class_field_flag cf CfPublic) then
+		raise_typing_error (name ^ ": (private get, private set) property cannot be public") p;
 	cf.cf_kind <- Var { v_read = get; v_write = set };
 	if fctx.is_extern then add_class_field_flag cf CfExtern;
 	if List.mem_assoc AEnum f.cff_access then add_class_field_flag cf CfEnum;

std/haxe/display/JsonModuleTypes.hx

@@ -213,6 +213,7 @@ enum abstract JsonVarAccessKind<T>(String) {
 	var AccNever;
 	var AccResolve;
 	var AccCall;
+	var AccPrivateCall;
 	var AccInline;
 	var AccRequire:JsonVarAccessKind<{require:String, message:Null<String>}>;
 	var AccCtor;

std/haxe/macro/Type.hx

@@ -651,6 +651,11 @@ enum VarAccess {
 	**/
 	AccCall;
 
+	/**
+		Access through private accessor function (`private get`, `private set`).
+	**/
+	AccPrivateCall;
+
 	/**
 		Inline access (`inline`).
 	**/

std/haxe/macro/TypeTools.hx

@@ -47,6 +47,7 @@ class TypeTools {
 						case AccNever: "never";
 						case AccResolve: throw "Invalid TAnonymous";
 						case AccCall: getOrSet;
+						case AccPrivateCall: 'private $getOrSet';
 						case AccInline: "default";
 						case AccRequire(_, _): "default";
 					}

tests/misc/projects/Issue3053/Main.hx

@@ -0,0 +1,161 @@
+typedef BadType = {
+	// should error but not yet
+	var foo(private get, private set):Int;
+	var foo2(never, never):Int;
+}
+
+typedef FooPrivateGetType = {
+	var foo(private get, set):Int;
+}
+
+typedef FooType = {
+	var foo(get, set):Int;
+}
+
+class Main {
+	static function main() {
+		final main = new Main();
+		main.foo = 1;
+
+		var privateObj:FooPrivateGetType = main;
+		var obj:FooType = main; // err, should be allowed?
+
+		privateObj = obj;
+		obj = privateObj; // err
+	}
+
+	public var foo(private get, set):Int;
+
+	function get_foo():Int {
+		return 0;
+	}
+
+	function set_foo(v) {
+		return v;
+	}
+
+	public var notAllowed(private get, private set):Int; // err
+
+	function set_notAllowed(value:Int):Int {
+		throw new haxe.exceptions.NotImplementedException();
+	}
+
+	function get_notAllowed():Int {
+		throw new haxe.exceptions.NotImplementedException();
+	}
+
+	public function new() {
+		foo = 1;
+		foo;
+
+		@:bypassAccessor Rect.staticFoo = 1;
+		@:privateAccess Rect.staticFoo = 1;
+		Rect.staticFoo = 1; // err
+
+		final rect = new Rect();
+		rect.width = 1; // err
+		rect.width;
+
+		final shape:Shape = rect;
+		shape.width = 1;
+		shape.width; // err
+
+		final bar = new Bar();
+
+		bar.defaultPrivateSet = 1; // err
+		@:bypassAccessor bar.defaultPrivateSet = 1;
+		@:privateAccess bar.defaultPrivateSet = 1;
+
+		@:privateAccess bar.width = 1;
+		bar.width = 1; // err
+		bar.width; // err
+
+		bar.defaultNull = 1; // err
+
+		bar.age;
+		@:bypassAccessor bar.age = 1;
+		@:privateAccess bar.age = 1;
+		bar.age = 1; // err
+
+		final child = new Child();
+		@:privateAccess child.width = 1;
+	}
+}
+
+interface Shape {
+	var width(private get, set):Int;
+}
+
+interface PublicShape {
+	var width(get, set):Int;
+}
+
+class PrivateRect implements PublicShape {
+	public var width(get, private set):Int; // err
+
+	function set_width(value:Int):Int {
+		return value;
+	}
+
+	function get_width():Int {
+		return 0;
+	}
+}
+
+class Rect implements Shape {
+	public static var staticFoo(default, private set):Int = 0;
+	static function set_staticFoo(v) {
+		return v;
+	}
+
+	public function new() {}
+	public var width(get, private set):Int; // err
+
+	function set_width(value:Int):Int {
+		return 0;
+	}
+
+	function get_width():Int {
+		return 0;
+	}
+}
+
+@:build(PropertyMacro.addIntProperty("age"))
+class Bar {
+	public function new() {
+		width = 2;
+	}
+
+	public var defaultNull(default, null):Int;
+
+	public var defaultPrivateSet(default, private set):Int;
+	function set_defaultPrivateSet(value:Int):Int {
+		return value;
+	}
+
+	var width(private get, private set):Int;
+
+	function set_width(value:Int):Int {
+		return value;
+	}
+
+	function get_width():Int {
+		return 0;
+	}
+}
+
+class Parent {
+	var width(private get, private set):Int;
+	function set_width(value:Int):Int {
+		return 0;
+	}
+	function get_width():Int {
+		return 0;
+	}
+}
+
+class Child extends Parent {
+	public function new() {
+		width = 0;
+	}
+}

tests/misc/projects/Issue3053/PropertyMacro.hx

@@ -0,0 +1,47 @@
+import haxe.macro.Context;
+import haxe.macro.Expr;
+
+class PropertyMacro {
+	public static macro function addIntProperty(name:String):Array<Field> {
+		final fields = Context.getBuildFields();
+
+		final privateField:Field = {
+			name: name,
+			access: [APublic],
+			meta: [{
+				name: ":isVar",
+				pos: Context.currentPos()
+			}],
+			kind: FProp("get", "private set", macro : Int, null),
+			pos: Context.currentPos()
+		};
+
+		final getterMethod = {
+			name: "get_" + name,
+			access: [],
+			kind: FFun({
+				args: [],
+				ret: macro : Int,
+				expr: macro return this.$name
+			}),
+			pos: Context.currentPos()
+		};
+
+		final setterMethod = {
+			name: "set_" + name,
+			access: [],
+			kind: FFun({
+				args: [{ name: "value", type: macro : Int }],
+				ret: macro : Int,
+				expr: macro return this.$name = value
+			}),
+			pos: Context.currentPos()
+		};
+
+		fields.push(privateField);
+		fields.push(getterMethod);
+		fields.push(setterMethod);
+
+		return fields;
+	}
+}

tests/misc/projects/Issue3053/compile-fail.hxml

@@ -0,0 +1,3 @@
+--main Main
+--interp
+-D message.reporting=classic

tests/misc/projects/Issue3053/compile-fail.hxml.stderr

@@ -0,0 +1,17 @@
+Main.hx:37: characters 2-54 : notAllowed: (private get, private set) property cannot be public
+Main.hx:53: characters 3-17 : This property cannot be accessed for writing
+Main.hx:56: characters 3-13 : This property cannot be accessed for writing
+Main.hx:61: characters 3-14 : This property cannot be accessed for reading
+Main.hx:65: characters 3-24 : This property cannot be accessed for writing
+Main.hx:70: characters 7-12 : Cannot access private field width
+Main.hx:70: characters 3-12 : This property cannot be accessed for writing
+Main.hx:71: characters 7-12 : Cannot access private field width
+Main.hx:71: characters 3-12 : This property cannot be accessed for reading
+Main.hx:73: characters 7-18 : This expression cannot be accessed for writing
+Main.hx:78: characters 3-10 : This property cannot be accessed for writing
+Main.hx:21: characters 3-26 : Main should be FooType
+Main.hx:21: characters 3-26 : ... Inconsistent getter for field foo : private get should be get
+Main.hx:24: characters 3-19 : FooPrivateGetType should be FooType
+Main.hx:24: characters 3-19 : ... Inconsistent getter for field foo : private get should be get
+Main.hx:112: characters 13-18 : Field width has different property access than in Shape: (get,private set) should be (private get,set)
+Main.hx:94: characters 13-18 : Field width has different property access than in PublicShape: (get,private set) should be (get,set)

tests/misc/projects/Issue9010/InterfaceFields-fail.hxml.stderr

@@ -1,3 +1,3 @@
 InterfaceFields.hx:1: characters 7-22 : Field missing needed by IFace is missing
-InterfaceFields.hx:5: characters 18-27 : Field wrongKind has different property access than in IFace (method should be var)
-InterfaceFields.hx:4: characters 13-24 : Field wrongAccess has different property access than in IFace ((never,null) should be (default,null))
+InterfaceFields.hx:5: characters 18-27 : Field wrongKind has different property access than in IFace: method should be var
+InterfaceFields.hx:4: characters 13-24 : Field wrongAccess has different property access than in IFace: (never,null) should be (default,null)