changes in access names

genas3.ml

@@ -819,7 +819,7 @@ let generate_field ctx static f =
 	let rights = (if static then "static " else "") ^ (if public then "public" else "protected") in
 	let p = ctx.curclass.cl_pos in
 	match f.cf_expr with
-	| Some { eexpr = TFunction fd } when f.cf_set = MethodCantAccess || f.cf_set = NeverAccess ->
+	| Some { eexpr = TFunction fd } when f.cf_set = MethodAccess false || f.cf_set = NeverAccess ->
 		print ctx "%s " rights;
 		let rec loop c =
 			match c.cl_super with
@@ -850,14 +850,14 @@ let generate_field ctx static f =
 				print ctx ") : %s " (type_str ctx r p);
 			| _ -> ()
 		else
-		if (match f.cf_get with MethodAccess m -> true | _ -> match f.cf_set with MethodAccess m -> true | _ -> false) then begin
+		if (match f.cf_get with CallAccess m -> true | _ -> match f.cf_set with CallAccess m -> true | _ -> false) then begin
 			let t = type_str ctx f.cf_type p in
 			let id = s_ident f.cf_name in
 			(match f.cf_get with
 			| NormalAccess ->
 				print ctx "%s function get %s() : %s { return $%s; }" rights id t id;
 				newline ctx
-			| MethodAccess m ->
+			| CallAccess m ->
 				print ctx "%s function get %s() : %s { return %s(); }" rights id t m;
 				newline ctx
 			| _ -> ());
@@ -865,7 +865,7 @@ let generate_field ctx static f =
 			| NormalAccess ->
 				print ctx "%s function set %s( __v : %s ) : void { $%s = __v; }" rights id t id;
 				newline ctx
-			| MethodAccess m ->
+			| CallAccess m ->
 				print ctx "%s function set %s( __v : %s ) : void { %s(__v); }" rights id t m;
 				newline ctx
 			| _ -> ());
@@ -884,8 +884,8 @@ let rec define_getset ctx stat c =
 		Hashtbl.add ctx.get_sets (name,stat) f.cf_name
 	in
 	let field f =
-		(match f.cf_get with MethodAccess m -> def f m | _ -> ());
-		(match f.cf_set with MethodAccess m -> def f m | _ -> ())
+		(match f.cf_get with CallAccess m -> def f m | _ -> ());
+		(match f.cf_set with CallAccess m -> def f m | _ -> ())
 	in
 	List.iter field (if stat then c.cl_ordered_statics else c.cl_ordered_fields);
 	match c.cl_super with
@@ -916,7 +916,7 @@ let generate_class ctx c =
 		let f = { f with
 			cf_name = snd c.cl_path;
 			cf_public = true;
-			cf_set = MethodCantAccess;
+			cf_set = MethodAccess false;
 		} in
 		ctx.constructor_block <- true;
 		generate_field ctx false f;

genphp.ml

@@ -40,7 +40,6 @@ type context = {
 	ch : out_channel;
 	buf : Buffer.t;
 	path : path;
-	mutable get_sets : (string * bool,string) Hashtbl.t;
 	mutable curclass : tclass;
 	mutable tabs : string;
 	mutable in_value : string option;
@@ -247,7 +246,6 @@ let init com cwd path def_type =
 		inv_locals = PMap.empty;
 		local_types = [];
 		inits = [];
-		get_sets = Hashtbl.create 0;
 		constructor_block = false;
 		quotes = 0;
 		dynamic_methods = [];
@@ -1580,7 +1578,7 @@ let generate_field ctx static f =
 			| _ -> spr ctx "//"; ()
 		else if
 			(match f.cf_get, f.cf_set with
-			| MethodAccess m1, MethodAccess m2 ->
+			| CallAccess m1, CallAccess m2 ->
 				if not (is_method_defined ctx m1 static) then (
 					generate_self_method ctx rights m1 static false;
 					print ctx "%s $%s" rights (s_ident m1);
@@ -1592,11 +1590,11 @@ let generate_field ctx static f =
 				if (is_method_defined ctx m1 static) && (is_method_defined ctx m2 static) then
 					spr ctx "//";
 				true
-			| MethodAccess m, _ ->
+			| CallAccess m, _ ->
 				if not (is_method_defined ctx m static) then generate_self_method ctx rights m static false;
 				print ctx "%s $%s" rights (s_ident f.cf_name);
 				true
-			| _, MethodAccess m ->
+			| _, CallAccess m ->
 				if not (is_method_defined ctx m static) then generate_self_method ctx rights m static true;
 				print ctx "%s $%s" rights (s_ident f.cf_name);
 				true
@@ -1635,13 +1633,6 @@ let generate_static_field_assign ctx path f =
 				print ctx "%s::$%s = " (s_path ctx path false p) (s_ident f.cf_name);
 				gen_value ctx e)
 
-let define_getset ctx stat f =
-	let def name =
-		Hashtbl.add ctx.get_sets (name,stat) f.cf_name
-	in
-		(match f.cf_get with MethodAccess m -> def m | _ -> ());
-		(match f.cf_set with MethodAccess m -> def m | _ -> ())
-
 let rec super_has_dynamic c =
 	match c.cl_super with
 	| None -> false
@@ -1652,8 +1643,6 @@ let rec super_has_dynamic c =
 let generate_class ctx c =
 	let requires_constructor = ref true in
 	ctx.curclass <- c;
-	List.iter (define_getset ctx false) c.cl_ordered_fields;
-	List.iter (define_getset ctx true) c.cl_ordered_statics;
 	ctx.local_types <- List.map snd c.cl_types;
 
 	print ctx "%s %s " (if c.cl_interface then "interface" else "class") (s_path ctx c.cl_path c.cl_extern c.cl_pos);
@@ -1740,7 +1729,6 @@ let createmain com c =
 		inv_locals = PMap.empty;
 		local_types = [];
 		inits = [];
-		get_sets = Hashtbl.create 0;
 		constructor_block = false;
 		quotes = 0;
 		dynamic_methods = [];

genswf9.ml

@@ -1587,7 +1587,7 @@ let generate_construct ctx fdata c =
 	(* --- *)
 	PMap.iter (fun _ f ->
 		match f.cf_expr with
-		| Some { eexpr = TFunction fdata } when f.cf_set = MethodDynamicAccess  ->
+		| Some { eexpr = TFunction fdata } when f.cf_set = MethodAccess true ->
 			let id = ident f.cf_name in
 			write ctx (HFindProp id);
 			write ctx (HFunction (generate_method ctx fdata false));
@@ -1623,7 +1623,7 @@ let generate_class_init ctx c hc =
 	write ctx (HClassDef hc);
 	List.iter (fun f ->
 		match f.cf_expr with
-		| Some { eexpr = TFunction fdata } when f.cf_set = MethodDynamicAccess ->
+		| Some { eexpr = TFunction fdata } when f.cf_set = MethodAccess true ->
 			write ctx HDup;
 			write ctx (HFunction (generate_method ctx fdata true));
 			write ctx (HInitProp (ident f.cf_name));
@@ -1675,7 +1675,7 @@ let generate_field_kind ctx f c stat =
 			| Some (c,_) ->
 				PMap.exists f.cf_name c.cl_fields || loop c
 		in
-		if f.cf_set = NormalAccess || f.cf_set = MethodDynamicAccess then
+		if f.cf_set = NormalAccess || f.cf_set = MethodAccess true then
 			Some (HFVar {
 				hlv_type = Some (type_path ctx ([],"Function"));
 				hlv_value = HVNone;
@@ -1690,7 +1690,7 @@ let generate_field_kind ctx f c stat =
 			})
 	| _ when c.cl_interface && not stat ->
 		(match follow f.cf_type with
-		| TFun (args,tret) when f.cf_set = MethodCantAccess ->
+		| TFun (args,tret) when f.cf_set = MethodAccess false ->
 			Some (HFMethod {
 				hlm_type = end_fun ctx (List.map (fun (a,opt,t) -> a, (if opt then Some TNull else None), t) args) tret;
 				hlm_final = false;

genxml.ml

@@ -85,10 +85,9 @@ let gen_constr e =
 let gen_field att f =
 	let add_get_set acc name att =
 		match acc with
-		| NormalAccess | ResolveAccess | MethodDynamicAccess -> att
+		| NormalAccess | ResolveAccess | MethodAccess _  -> att
 		| NoAccess | NeverAccess -> (name, "null") :: att
-		| MethodAccess m -> (name, if m = name ^ "_" ^ f.cf_name then "dynamic" else m) :: att
-		| MethodCantAccess -> att
+		| CallAccess m -> (name, if m = name ^ "_" ^ f.cf_name then "dynamic" else m) :: att
 		| InlineAccess -> assert false
 	in
 	let att = (match f.cf_expr with None -> att | Some e -> ("line",string_of_int (Lexer.get_error_line e.epos)) :: att) in

type.ml

@@ -23,12 +23,11 @@ type path = string list * string
 type field_access =
 	| NormalAccess
 	| NoAccess
-	| ResolveAccess
-	| MethodAccess of string
-	| MethodCantAccess
-	| MethodDynamicAccess
-	| NeverAccess
-	| InlineAccess
+	| ResolveAccess (* call resolve("field") when accessed *)
+	| CallAccess of string (* perform a method call when accessed *)
+	| MethodAccess of bool (* true = the method is dynamic *)
+	| InlineAccess (* similar to Normal but inline when acccessed *)
+	| NeverAccess (* can't be accessed, even in subclasses *)
 
 type t =
 	| TMono of t option ref
@@ -291,11 +290,10 @@ let s_access = function
 	| NormalAccess -> "default"
 	| NoAccess -> "null"
 	| NeverAccess -> "never"
-	| MethodAccess m -> m
-	| MethodCantAccess -> "default"
+	| CallAccess m -> m
+	| MethodAccess b -> if b then "dynamic method" else "default method"
 	| ResolveAccess -> "resolve"
 	| InlineAccess -> "inline"
-	| MethodDynamicAccess -> "dynamic"
 
 let rec is_parent csup c =
 	if c == csup then
@@ -493,16 +491,24 @@ let has_no_field t n = Has_no_field (t,n)
 let has_extra_field t n = Has_extra_field (t,n)
 let error l = raise (Unify_error l)
 
+type simple_access =
+	| SAYes
+	| SANo
+	| SARuntime
+
+let simple_access = function	
+	| NormalAccess | InlineAccess | MethodAccess true -> SAYes
+	| NoAccess | NeverAccess | MethodAccess false -> SANo
+	| ResolveAccess | CallAccess _ -> SARuntime
+
+(*
+	we can restrict access as soon as both are runtime-compatible
+*)
 let unify_access a1 a2 =
-	a1 = a2 || match a1, a2 with
-	| NormalAccess, NoAccess
-	| NormalAccess, MethodCantAccess
-	| NormalAccess, NeverAccess
-	| MethodCantAccess, NoAccess
-	| NeverAccess, NoAccess
-	| MethodCantAccess, NeverAccess
-	| NoAccess, NeverAccess -> true
-	| _ -> false
+	a1 = a2 || match simple_access a1 , simple_access a2 with
+		| SAYes, SAYes
+		| _, SANo -> true
+		| _ -> false
 
 let eq_stack = ref []
 

typeload.ml

@@ -195,15 +195,15 @@ and load_type ctx p t =
 				| AFFun (tl,t) ->
 					let t = load_type ctx p t in
 					let args = List.map (fun (name,o,t) -> name , o, load_type ctx p t) tl in
-					TFun (args,t), NormalAccess, MethodCantAccess
+					TFun (args,t), NormalAccess, MethodAccess false
 				| AFProp (t,i1,i2) ->
 					let access m get =
 						match m with
 						| "null" -> NoAccess
 						| "never" -> NeverAccess
 						| "default" -> NormalAccess
-						| "dynamic" -> MethodAccess ((if get then "get_"  else "set_") ^ n)
-						| _ -> MethodAccess m
+						| "dynamic" -> CallAccess ((if get then "get_"  else "set_") ^ n)
+						| _ -> CallAccess m
 					in
 					load_type ctx p t, access i1 true, access i2 false
 			) in
@@ -616,7 +616,7 @@ let init_class ctx c p herits fields =
 			let stat = List.mem AStatic access in
 			let inline = List.mem AInline access in
 			let parent = (if not stat then get_parent c name else None) in
-			let dynamic = List.mem ADynamic access || (match parent with Some { cf_set = MethodDynamicAccess } -> true | _ -> false) in
+			let dynamic = List.mem ADynamic access || (match parent with Some { cf_set = MethodAccess true } -> true | _ -> false) in
 			let ctx = { ctx with
 				curclass = c;
 				curmethod = name;
@@ -641,7 +641,7 @@ let init_class ctx c p herits fields =
 				cf_doc = doc;
 				cf_type = t;
 				cf_get = if inline then InlineAccess else NormalAccess;
-				cf_set = (if inline then NeverAccess else if dynamic then MethodDynamicAccess else MethodCantAccess);
+				cf_set = (if inline then NeverAccess else MethodAccess dynamic);
 				cf_expr = None;
 				cf_public = is_public access parent;
 				cf_params = params;
@@ -682,12 +682,12 @@ let init_class ctx c p herits fields =
 			in
 			let get = (match get with
 				| "null" -> NoAccess
-				| "dynamic" -> MethodAccess ("get_" ^ name)
+				| "dynamic" -> CallAccess ("get_" ^ name)
 				| "never" -> NeverAccess
 				| "default" -> NormalAccess
 				| _ ->
 					check_get := check_method get (TFun ([],ret));
-					MethodAccess get
+					CallAccess get
 			) in
 			let set = (match set with
 				| "null" ->
@@ -697,13 +697,13 @@ let init_class ctx c p herits fields =
 					else
 						NoAccess
 				| "never" -> NeverAccess
-				| "dynamic" -> MethodAccess ("set_" ^ name)
+				| "dynamic" -> CallAccess ("set_" ^ name)
 				| "default" -> NormalAccess
 				| _ ->
 					check_set := check_method set (TFun (["",false,ret],ret));
-					MethodAccess set
+					CallAccess set
 			) in
-			if set = NormalAccess && (match get with MethodAccess _ -> true | _ -> false) then error "Unsupported property combination" p;
+			if set = NormalAccess && (match get with CallAccess _ -> true | _ -> false) then error "Unsupported property combination" p;
 			let cf = {
 				cf_name = name;
 				cf_doc = doc;

typer.ml

@@ -211,7 +211,7 @@ let type_type ctx tpath p =
 				cf_public = true;
 				cf_type = f.ef_type;
 				cf_get = NormalAccess;
-				cf_set = (match follow f.ef_type with TFun _ -> MethodCantAccess | _ -> NoAccess);
+				cf_set = (match follow f.ef_type with TFun _ -> MethodAccess false | _ -> NoAccess);
 				cf_doc = None;
 				cf_expr = None;
 				cf_params = [];
@@ -285,13 +285,13 @@ let field_access ctx mode f t e p =
 			| _ -> if ctx.untyped then normal else AccNo f.cf_name)
 		| _ ->
 			if ctx.untyped then normal else AccNo f.cf_name)
-	| MethodCantAccess when not ctx.untyped ->
+	| MethodAccess false when not ctx.untyped ->
 		error "Cannot rebind this method : please use 'dynamic' before method declaration" p
-	| NormalAccess | MethodCantAccess | MethodDynamicAccess ->
+	| NormalAccess | MethodAccess _ ->
 		(match mode, f.cf_set with
-		| MGet, MethodCantAccess | MGet, MethodDynamicAccess -> AccExpr (mk (TClosure (e,f.cf_name)) t p)
+		| MGet, MethodAccess _ -> AccExpr (mk (TClosure (e,f.cf_name)) t p)
 		| _ -> AccExpr (mk (TField (e,f.cf_name)) t p))	 
-	| MethodAccess m ->
+	| CallAccess m ->
 		if m = ctx.curmethod && (match e.eexpr with TConst TThis -> true | TTypeExpr (TClassDecl c) when c == ctx.curclass -> true | _ -> false) then
 			let prefix = if Common.defined ctx.com "as3" then "$" else "" in
 			AccExpr (mk (TField (e,prefix ^ f.cf_name)) t p)