Browse Source

[typer] also use CfConstructor on class constructors

Simon Krajewski 5 năm trước cách đây
mục cha
commit
dca1d12698

+ 1 - 0
src/codegen/dotnet.ml

@@ -412,6 +412,7 @@ let convert_ilmethod ctx p is_interface m is_explicit_impl =
 		| _ -> acc, is_final
 		| _ -> acc, is_final
 	) ([acc],None) m.mflags.mf_contract in
 	) ([acc],None) m.mflags.mf_contract in
 	let acc = (AOverload,p) :: acc in
 	let acc = (AOverload,p) :: acc in
+	let acc = if cff_name = "new" then (AConstructor,null_pos) :: acc else acc in
 	if PMap.mem "net_loader_debug" ctx.ncom.defines.Define.values then
 	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);
 		Printf.printf "\t%smethod %s : %s\n" (if !is_static then "static " else "") cff_name (IlMetaDebug.ilsig_s m.msig.ssig);
 
 

+ 3 - 1
src/codegen/java.ml

@@ -244,7 +244,9 @@ let convert_java_enum ctx p pe =
 		let cff_meta = ref [] in
 		let cff_meta = ref [] in
 		let cff_access = ref [] in
 		let cff_access = ref [] in
 		let cff_name = match field.jf_name with
 		let cff_name = match field.jf_name with
-			| "<init>" -> "new"
+			| "<init>" ->
+				cff_access := (AConstructor,null_pos) :: !cff_access;
+				"new"
 			| "<clinit>"-> raise Exit (* __init__ field *)
 			| "<clinit>"-> raise Exit (* __init__ field *)
 			| name when String.length name > 5 ->
 			| name when String.length name > 5 ->
 					(match String.sub name 0 5 with
 					(match String.sub name 0 5 with

+ 1 - 0
src/codegen/javaModern.ml

@@ -785,6 +785,7 @@ module Converter = struct
 		in
 		in
 		let name = match String.nsplit jf.jf_name "$" with
 		let name = match String.nsplit jf.jf_name "$" with
 			| ["<init>"] ->
 			| ["<init>"] ->
+				add_access (AConstructor,null_pos);
 				"new"
 				"new"
 			| [name] ->
 			| [name] ->
 				if is_haxe_keyword name then begin
 				if is_haxe_keyword name then begin

+ 1 - 0
src/codegen/swfLoader.ml

@@ -327,6 +327,7 @@ let build_class com c file =
 		let t = if name = "endian" then Some (HMPath (["flash";"utils"],"Endian")) else t in
 		let t = if name = "endian" then Some (HMPath (["flash";"utils"],"Endian")) else t in
 		let flags, accessor_flags = [APublic,null_pos], [APrivate,null_pos] 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 flags, accessor_flags = if stat then (AStatic,null_pos) :: flags, (AStatic,null_pos) :: accessor_flags else flags, accessor_flags in
+		let flags = if name = "new" then (AConstructor,null_pos) :: flags else flags in
 		let property_typehint = Some (make_dyn_type t,null_pos) in
 		let property_typehint = Some (make_dyn_type t,null_pos) in
 		let fields = [] in
 		let fields = [] in
 		let read_access, fields =
 		let read_access, fields =

+ 1 - 1
src/context/display/documentSymbols.ml

@@ -55,7 +55,7 @@ let collect_module_symbols mname with_locals (pack,decls) =
 			if with_locals then expr_opt field_parent eo
 			if with_locals then expr_opt field_parent eo
 		| FFun f ->
 		| FFun f ->
 			add_field (
 			add_field (
-				if fst cff_name = "new" then Constructor
+				if List.mem_assoc AConstructor cff_access then Constructor
 				else if ((parent_kind = EnumAbstract or parent_kind = Abstract) && Meta.has_one_of [Meta.Op; Meta.ArrayAccess; Meta.Resolve] cff_meta) then Operator
 				else if ((parent_kind = EnumAbstract or parent_kind = Abstract) && Meta.has_one_of [Meta.Op; Meta.ArrayAccess; Meta.Resolve] cff_meta) then Operator
 				else Method
 				else Method
 			);
 			);

+ 2 - 2
src/core/display/completionItem.ml

@@ -79,7 +79,7 @@ module CompletionModuleType = struct
 		| EClass d ->
 		| EClass d ->
 			let ctor =
 			let ctor =
 				try
 				try
-					let cff = List.find (fun cff -> fst cff.cff_name = "new") d.d_data in
+					let cff = List.find (fun cff -> List.mem_assoc AConstructor cff.cff_access) d.d_data in
 					if List.mem HExtern d.d_flags || List.exists (fun (acc,_) -> acc = APublic) cff.cff_access then Yes
 					if List.mem HExtern d.d_flags || List.exists (fun (acc,_) -> acc = APublic) cff.cff_access then Yes
 					else YesButPrivate
 					else YesButPrivate
 				with Not_found ->
 				with Not_found ->
@@ -136,7 +136,7 @@ module CompletionModuleType = struct
 		| EAbstract d ->
 		| EAbstract d ->
 			let ctor =
 			let ctor =
 				try
 				try
-					let cff = List.find (fun cff -> fst cff.cff_name = "new") d.d_data in
+					let cff = List.find (fun cff -> List.mem_assoc AConstructor cff.cff_access) d.d_data in
 					if List.exists (fun (acc,_) -> acc = APublic) cff.cff_access then Yes else YesButPrivate
 					if List.exists (fun (acc,_) -> acc = APublic) cff.cff_access then Yes else YesButPrivate
 				with Not_found ->
 				with Not_found ->
 					No
 					No

+ 1 - 1
src/filters/defaultArguments.ml

@@ -64,7 +64,7 @@ let rec change_func com cl cf =
 	| Var _, _ | Method MethDynamic, _ ->
 	| Var _, _ | Method MethDynamic, _ ->
 		()
 		()
 	| _, TFun(args, ret) ->
 	| _, TFun(args, ret) ->
-		let is_ctor = cf.cf_name = "new" in
+		let is_ctor = has_class_field_flag cf CfConstructor in
 		let basic = com.basic in
 		let basic = com.basic in
 
 
 		let found = ref false in
 		let found = ref false in

+ 1 - 0
src/filters/filters.ml

@@ -476,6 +476,7 @@ let add_field_inits locals ctx t =
 					tf_expr = mk (TBlock el) ctx.com.basic.tvoid c.cl_pos;
 					tf_expr = mk (TBlock el) ctx.com.basic.tvoid c.cl_pos;
 				}) ct c.cl_pos in
 				}) ct c.cl_pos in
 				let ctor = mk_field "new" ct c.cl_pos null_pos in
 				let ctor = mk_field "new" ct c.cl_pos null_pos in
+				add_class_field_flag ctor CfConstructor;
 				ctor.cf_kind <- Method MethNormal;
 				ctor.cf_kind <- Method MethNormal;
 				{ ctor with cf_expr = Some ce }
 				{ ctor with cf_expr = Some ce }
 			| Some cf ->
 			| Some cf ->

+ 5 - 2
src/macro/macroApi.ml

@@ -695,12 +695,15 @@ and decode_class_field_kind v =
 and decode_field v =
 and decode_field v =
 	let fkind = decode_class_field_kind (field v "kind") in
 	let fkind = decode_class_field_kind (field v "kind") in
 	let pos = decode_pos (field v "pos") in
 	let pos = decode_pos (field v "pos") in
+	let name = decode_string (field v "name"),decode_pos_default (field v "name_pos") pos in
+	let access = List.map decode_access (opt_list decode_array (field v "access")) in
+	let access = if fst name = "new" && not (List.mem_assoc AConstructor access) then (AConstructor,Globals.null_pos) :: access else access in
 	{
 	{
-		cff_name = (decode_string (field v "name"),decode_pos_default (field v "name_pos") pos);
+		cff_name = name;
 		cff_doc = decode_doc (field v "doc");
 		cff_doc = decode_doc (field v "doc");
 		cff_pos = pos;
 		cff_pos = pos;
 		cff_kind = fkind;
 		cff_kind = fkind;
-		cff_access = List.map decode_access (opt_list decode_array (field v "access"));
+		cff_access = access;
 		cff_meta = opt_list decode_meta_content (field v "meta");
 		cff_meta = opt_list decode_meta_content (field v "meta");
 	}
 	}
 
 

+ 2 - 2
src/optimization/dce.ml

@@ -114,7 +114,7 @@ let rec keep_field dce cf c is_static =
 	|| has_class_field_flag cf CfExtern
 	|| has_class_field_flag cf CfExtern
 	|| (not is_static && overrides_extern_field cf c)
 	|| (not is_static && overrides_extern_field cf c)
 	|| (
 	|| (
-		cf.cf_name = "new"
+		has_class_field_flag cf CfConstructor
 		&& match c.cl_super with (* parent class kept constructor *)
 		&& 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 false
 			| _ -> false
 			| _ -> false
@@ -160,7 +160,7 @@ and mark_field dce c cf stat =
 			check_feature dce (Printf.sprintf "%s.%s" (s_type_path c.cl_path) cf.cf_name);
 			check_feature dce (Printf.sprintf "%s.%s" (s_type_path c.cl_path) cf.cf_name);
 		end
 		end
 	in
 	in
-	if cf.cf_name = "new" then begin
+	if has_class_field_flag cf CfConstructor then begin
 		let rec loop c =
 		let rec loop c =
 			begin match c.cl_constructor with
 			begin match c.cl_constructor with
 				| Some cf -> add cf
 				| Some cf -> add cf

+ 4 - 3
src/syntax/grammar.mly

@@ -864,7 +864,7 @@ and parse_enum_param = parser
 	| [< name, _ = ident; t = parse_type_hint >] -> (name,false,t)
 	| [< name, _ = ident; t = parse_type_hint >] -> (name,false,t)
 
 
 and parse_function_field doc meta al = parser
 and parse_function_field doc meta al = parser
-	| [< '(Kwd Function,p1); name = parse_fun_name; pl = parse_constraint_params; '(POpen,_); args = psep Comma parse_fun_param; '(PClose,_); t = popt parse_type_hint; s >] ->
+	| [< '(Kwd Function,p1); name,is_ctor = parse_fun_name; pl = parse_constraint_params; '(POpen,_); args = psep Comma parse_fun_param; '(PClose,_); t = popt parse_type_hint; s >] ->
 		let e, p2 = (match s with parser
 		let e, p2 = (match s with parser
 			| [< e = expr; s >] ->
 			| [< e = expr; s >] ->
 				ignore(semicolon s);
 				ignore(semicolon s);
@@ -878,6 +878,7 @@ and parse_function_field doc meta al = parser
 			f_type = t;
 			f_type = t;
 			f_expr = e;
 			f_expr = e;
 		} in
 		} in
+		let al = if is_ctor then (AConstructor,null_pos) :: al else al in
 		name,punion p1 p2,FFun f,al,meta
 		name,punion p1 p2,FFun f,al,meta
 
 
 and parse_var_field_assignment = parser
 and parse_var_field_assignment = parser
@@ -982,8 +983,8 @@ and parse_cf_rights = parser
 	| [< '(Kwd Overload,p) >] -> AOverload,p
 	| [< '(Kwd Overload,p) >] -> AOverload,p
 
 
 and parse_fun_name = parser
 and parse_fun_name = parser
-	| [< name,p = dollar_ident >] -> name,p
-	| [< '(Kwd New,p) >] -> "new",p
+	| [< name,p = dollar_ident >] -> (name,p),false
+	| [< '(Kwd New,p) >] -> ("new",p),true
 
 
 and parse_fun_param s =
 and parse_fun_param s =
 	let meta = parse_meta s in
 	let meta = parse_meta s in

+ 1 - 1
src/typing/calls.ml

@@ -211,7 +211,7 @@ let unify_field_call ctx fa el_typed el p inline =
 			expand_overloads fa.fa_field,None,false,(fun t -> t),(fun t -> t)
 			expand_overloads fa.fa_field,None,false,(fun t -> t),(fun t -> t)
 		| FHInstance(c,tl) ->
 		| FHInstance(c,tl) ->
 			let cf = fa.fa_field in
 			let cf = fa.fa_field in
-			let cfl = if cf.cf_name = "new" || not (has_class_field_flag cf CfOverload) then
+			let cfl = if has_class_field_flag cf CfConstructor || not (has_class_field_flag cf CfOverload) then
 				cf :: cf.cf_overloads
 				cf :: cf.cf_overloads
 			else
 			else
 				List.map (fun (t,cf) ->
 				List.map (fun (t,cf) ->

+ 2 - 2
src/typing/magicTypes.ml

@@ -33,11 +33,11 @@ let extend_remoting ctx c t p async prot =
 	ctx.com.package_rules <- rules;
 	ctx.com.package_rules <- rules;
 	let base_fields = [
 	let base_fields = [
 		{ cff_name = "__cnx",null_pos; cff_pos = p; cff_doc = None; cff_meta = []; cff_access = []; cff_kind = FVar (Some (CTPath (mk_type_path (["haxe";"remoting"],if async then "AsyncConnection" else "Connection")),null_pos),None) };
 		{ cff_name = "__cnx",null_pos; cff_pos = p; cff_doc = None; cff_meta = []; cff_access = []; cff_kind = FVar (Some (CTPath (mk_type_path (["haxe";"remoting"],if async then "AsyncConnection" else "Connection")),null_pos),None) };
-		{ cff_name = "new",null_pos; cff_pos = p; cff_doc = None; cff_meta = []; cff_access = [APublic,null_pos]; cff_kind = FFun { f_args = [("c",null_pos),false,[],None,None]; f_type = None; f_expr = Some (EBinop (OpAssign,(EConst (Ident "__cnx"),p),(EConst (Ident "c"),p)),p); f_params = [] } };
+		{ cff_name = "new",null_pos; cff_pos = p; cff_doc = None; cff_meta = []; cff_access = [(APublic,null_pos);(AConstructor,null_pos)]; cff_kind = FFun { f_args = [("c",null_pos),false,[],None,None]; f_type = None; f_expr = Some (EBinop (OpAssign,(EConst (Ident "__cnx"),p),(EConst (Ident "c"),p)),p); f_params = [] } };
 	] in
 	] in
 	let tvoid = CTPath (mk_type_path ([],"Void")) in
 	let tvoid = CTPath (mk_type_path ([],"Void")) in
 	let build_field is_public acc f =
 	let build_field is_public acc f =
-		if fst f.cff_name = "new" then
+		if List.mem_assoc AConstructor f.cff_access then
 			acc
 			acc
 		else match f.cff_kind with
 		else match f.cff_kind with
 		| FFun fd when (is_public || List.mem_assoc APublic f.cff_access) && not (List.mem_assoc AStatic f.cff_access) ->
 		| FFun fd when (is_public || List.mem_assoc APublic f.cff_access) && not (List.mem_assoc AStatic f.cff_access) ->

+ 1 - 1
src/typing/typeload.ml

@@ -524,7 +524,7 @@ and load_complex_type' ctx allow_display (t,p) =
 				| None -> error ("Explicit type required for field " ^ n) p
 				| None -> error ("Explicit type required for field " ^ n) p
 				| Some t -> load_complex_type ctx allow_display t
 				| Some t -> load_complex_type ctx allow_display t
 			in
 			in
-			if n = "new" then ctx.com.warning "Structures with new are deprecated, use haxe.Constraints.Constructible instead" p;
+			if List.mem_assoc AConstructor f.cff_access then ctx.com.warning "Structures with new are deprecated, use haxe.Constraints.Constructible instead" p;
 			let no_expr = function
 			let no_expr = function
 				| None -> ()
 				| None -> ()
 				| Some (_,p) -> error "Expression not allowed here" p
 				| Some (_,p) -> error "Expression not allowed here" p

+ 11 - 7
src/typing/typeloadFields.ml

@@ -216,6 +216,7 @@ let ensure_struct_init_constructor ctx c ast_fields p =
 		} in
 		} in
 		let e = mk (TFunction tf) (TFun(tl @ super_tl,ctx.t.tvoid)) p in
 		let e = mk (TFunction tf) (TFun(tl @ super_tl,ctx.t.tvoid)) p in
 		let cf = mk_field "new" e.etype p null_pos in
 		let cf = mk_field "new" e.etype p null_pos in
+		add_class_field_flag cf CfConstructor;
 		cf.cf_expr <- Some e;
 		cf.cf_expr <- Some e;
 		cf.cf_type <- e.etype;
 		cf.cf_type <- e.etype;
 		cf.cf_meta <- [Meta.CompilerGenerated,[],null_pos];
 		cf.cf_meta <- [Meta.CompilerGenerated,[],null_pos];
@@ -230,7 +231,7 @@ let transform_abstract_field com this_t a_t a f =
 		f
 		f
 	| FProp _ when not stat && not (Meta.has Meta.Enum f.cff_meta) ->
 	| FProp _ when not stat && not (Meta.has Meta.Enum f.cff_meta) ->
 		error "Member property accessors must be get/set or never" p;
 		error "Member property accessors must be get/set or never" p;
-	| FFun fu when fst f.cff_name = "new" && not stat ->
+	| FFun fu when List.mem_assoc AConstructor f.cff_access && not stat ->
 		let init p = (EVars [mk_evar ~t:this_t ("this",null_pos)],p) in
 		let init p = (EVars [mk_evar ~t:this_t ("this",null_pos)],p) in
 		let cast e = (ECast(e,None)),pos e in
 		let cast e = (ECast(e,None)),pos e in
 		let ret p = (EReturn (Some (cast (EConst (Ident "this"),p))),p) in
 		let ret p = (EReturn (Some (cast (EConst (Ident "this"),p))),p) in
@@ -594,14 +595,16 @@ let create_field_context (ctx,cctx) c cff =
 	let override = try Some (List.assoc AOverride cff.cff_access) with Not_found -> None in
 	let override = try Some (List.assoc AOverride cff.cff_access) with Not_found -> None in
 	let overload = try Some (List.assoc AOverload cff.cff_access) with Not_found -> None in
 	let overload = try Some (List.assoc AOverload cff.cff_access) with Not_found -> None in
 	let is_macro = List.mem_assoc AMacro cff.cff_access in
 	let is_macro = List.mem_assoc AMacro cff.cff_access in
-	let field_kind = match fst cff.cff_name with
-		| "new" -> FKConstructor
-		| "__init__" when is_static -> FKInit
-		| _ ->
-			if List.mem_assoc AConstructor cff.cff_access && cctx.abstract <> None then
+	let field_kind =
+		if List.mem_assoc AConstructor cff.cff_access then begin
+			if cctx.abstract <> None then
 				FKAbstractConstructor
 				FKAbstractConstructor
 			else
 			else
-				FKNormal
+				FKConstructor
+		end else if fst cff.cff_name = "__init__" && is_static then
+			FKInit
+		else
+			FKNormal
 	in
 	in
 	let fctx = {
 	let fctx = {
 		is_inline = is_inline;
 		is_inline = is_inline;
@@ -1163,6 +1166,7 @@ let create_method (ctx,cctx,fctx) c f fd p =
 		cf_kind = Method (if fctx.is_macro then MethMacro else if fctx.is_inline then MethInline else if dynamic then MethDynamic else MethNormal);
 		cf_kind = Method (if fctx.is_macro then MethMacro else if fctx.is_inline then MethInline else if dynamic then MethDynamic else MethNormal);
 		cf_params = params;
 		cf_params = params;
 	} in
 	} in
+	if fctx.field_kind = FKConstructor then add_class_field_flag cf CfConstructor;
 	if fctx.is_final then add_class_field_flag cf CfFinal;
 	if fctx.is_final then add_class_field_flag cf CfFinal;
 	if fctx.is_extern then add_class_field_flag cf CfExtern;
 	if fctx.is_extern then add_class_field_flag cf CfExtern;
 	if fctx.is_abstract then add_class_field_flag cf CfAbstract;
 	if fctx.is_abstract then add_class_field_flag cf CfAbstract;

+ 1 - 0
src/typing/typeloadFunction.ml

@@ -321,6 +321,7 @@ let add_constructor ctx c force_constructor p =
 			tf_expr = mk (TBlock []) ctx.t.tvoid p;
 			tf_expr = mk (TBlock []) ctx.t.tvoid p;
 		}) (tfun [] ctx.t.tvoid) p in
 		}) (tfun [] ctx.t.tvoid) p in
 		let cf = mk_field "new" constr.etype p null_pos in
 		let cf = mk_field "new" constr.etype p null_pos in
+		add_class_field_flag cf CfConstructor;
 		cf.cf_expr <- Some constr;
 		cf.cf_expr <- Some constr;
 		cf.cf_type <- constr.etype;
 		cf.cf_type <- constr.etype;
 		cf.cf_meta <- [Meta.CompilerGenerated,[],null_pos];
 		cf.cf_meta <- [Meta.CompilerGenerated,[],null_pos];

+ 6 - 0
std/haxe/macro/Expr.hx

@@ -862,6 +862,11 @@ enum Access {
 		Abstract access modifier.
 		Abstract access modifier.
 	**/
 	**/
 	AAbstract;
 	AAbstract;
+
+	/**
+		Field is a constructor.
+	**/
+	AConstructor;
 }
 }
 
 
 /**
 /**
@@ -968,6 +973,7 @@ enum TypeDefKind {
 		Represents a module-level field.
 		Represents a module-level field.
 	**/
 	**/
 	TDField(kind:FieldType, ?access:Array<Access>); // ignore TypeDefinition.fields
 	TDField(kind:FieldType, ?access:Array<Access>); // ignore TypeDefinition.fields
+
 }
 }
 
 
 /**
 /**

+ 1 - 0
std/haxe/macro/Printer.hx

@@ -160,6 +160,7 @@ class Printer {
 			case AFinal: "final";
 			case AFinal: "final";
 			case AExtern: "extern";
 			case AExtern: "extern";
 			case AAbstract: "abstract";
 			case AAbstract: "abstract";
+			case AConstructor: "constructor";
 		}
 		}
 
 
 	public function printField(field:Field) {
 	public function printField(field:Field) {