add CfAbstractConstructor

Author: Simn

src/core/tType.ml

@@ -511,10 +511,11 @@ type flag_tclass_field =
 	| CfUsed (* Marker for DCE *)
 	| CfMaybeUsed (* Marker for DCE *)
 	| CfNoLookup (* Field cannot be accessed by-name. *)
+	| CfAbstractConstructor
 
 (* Order has to match declaration for printing*)
 let flag_tclass_field_names = [
-	"CfPublic";"CfStatic";"CfExtern";"CfFinal";"CfModifiesThis";"CfOverride";"CfAbstract";"CfOverload";"CfImpl";"CfEnum";"CfGeneric";"CfDefault";"CfPostProcessed";"CfUsed";"CfMaybeUsed";"CfNoLookup"
+	"CfPublic";"CfStatic";"CfExtern";"CfFinal";"CfModifiesThis";"CfOverride";"CfAbstract";"CfOverload";"CfImpl";"CfEnum";"CfGeneric";"CfDefault";"CfPostProcessed";"CfUsed";"CfMaybeUsed";"CfNoLookup";"CfAbstractConstructor"
 ]
 
 type flag_tenum =

src/optimization/inline.ml

@@ -232,7 +232,7 @@ let inline_default_config cf t =
 let inline_config cls_opt cf call_args return_type =
 	match cls_opt with
 	| Some ({cl_kind = KAbstractImpl _}) when has_class_field_flag cf CfImpl ->
-		let t = if cf.cf_name = "_hx_new" then
+		let t = if has_class_field_flag cf CfAbstractConstructor then
 			return_type
 		else if call_args = [] then
 			raise_typing_error "Invalid abstract implementation function" cf.cf_pos
@@ -580,7 +580,7 @@ class inline_state ctx ethis params cf f p = object(self)
 			(match follow ethis.etype with
 			| TAnon a -> (match !(a.a_status) with
 				| ClassStatics {cl_kind = KAbstractImpl a } when has_class_field_flag cf CfImpl ->
-					if cf.cf_name <> "_hx_new" then begin
+					if not (has_class_field_flag cf CfAbstractConstructor) then begin
 						(* the first argument must unify with a_this for abstract implementation functions *)
 						let tb = (TFun(("",false,map_type a.a_this) :: (List.tl tl),tret)) in
 						unify_raise mt tb p

src/typing/callUnification.ml

@@ -232,7 +232,7 @@ let unify_field_call ctx fa el_typed el p inline =
 			cfl,Some c,false,TClass.get_map_function c tl,(fun t -> t)
 		| FHAbstract(a,tl,c) ->
 			let map = apply_params a.a_params tl in
-			let tmap = if fa.fa_field.cf_name = "_hx_new" (* TODO: BAD BAD BAD BAD *) then (fun t -> t) else (fun t -> map a.a_this) in
+			let tmap = if has_class_field_flag fa.fa_field CfAbstractConstructor then (fun t -> t) else (fun t -> map a.a_this) in
 			expand_overloads fa.fa_field,Some c,true,map,tmap
 	in
 	let is_forced_inline = is_forced_inline co fa.fa_field in

src/typing/calls.ml

@@ -54,7 +54,7 @@ let make_call ctx e params t ?(force_inline=false) p =
 		(match cl, ctx.c.curclass.cl_kind, params with
 			| Some c, KAbstractImpl _, { eexpr = TLocal { v_meta = v_meta } } :: _ when c == ctx.c.curclass ->
 				if
-					f.cf_name <> "_hx_new"
+					not (has_class_field_flag f CfAbstractConstructor)
 					&& has_meta Meta.This v_meta
 					&& has_class_field_flag f CfModifiesThis
 				then

src/typing/typeloadFields.ml

@@ -54,6 +54,7 @@ type field_init_ctx = {
 	is_abstract : bool;
 	is_macro : bool;
 	is_abstract_member : bool;
+	is_abstract_constructor : bool;
 	is_display_field : bool;
 	is_field_debug : bool;
 	is_generic : bool;
@@ -529,6 +530,7 @@ let create_field_context ctx cctx cff is_display_file display_modifier =
 		is_field_debug = cctx.is_class_debug || Meta.has (Meta.Custom ":debug.typeload") cff.cff_meta;
 		display_modifier = display_modifier;
 		is_abstract_member = is_abstract_member;
+		is_abstract_constructor = is_abstract_member && fst cff.cff_name = "_hx_new";
 		is_generic = Meta.has Meta.Generic cff.cff_meta;
 		field_kind = field_kind;
 		do_bind = (((not ((has_class_flag c CExtern) || !is_extern) || is_inline) && not is_abstract && not (has_class_flag c CInterface)) || field_kind = CfrInit);
@@ -631,7 +633,7 @@ let check_field_display ctx fctx c cf =
 		let scope, cf = match c.cl_kind with
 			| KAbstractImpl _ ->
 				if has_class_field_flag cf CfImpl then
-					(if cf.cf_name = "_hx_new" then
+					(if fctx.is_abstract_constructor then
 						CFSConstructor, {cf with cf_name = "new"}
 					else
 						CFSMember, cf)
@@ -1087,7 +1089,7 @@ let check_abstract (ctx,cctx,fctx) a c cf fd t ret p =
 		| _ -> ();
 	in
 	List.iter check_meta cf.cf_meta;
-	if cf.cf_name = "_hx_new" && Meta.has Meta.MultiType a.a_meta then fctx.do_bind <- false;
+	if fctx.is_abstract_constructor && Meta.has Meta.MultiType a.a_meta then fctx.do_bind <- false;
 	if fd.f_expr = None then begin
 		if fctx.is_inline then missing_expression ctx.com fctx "Inline functions must have an expression" cf.cf_pos;
 		if fd.f_type = None then raise_typing_error ("Functions without expressions must have an explicit return type") cf.cf_pos;
@@ -1160,7 +1162,7 @@ let setup_args_ret ctx cctx fctx name fd p =
 		maybe_use_property_type fd.f_type (fun () -> match Lazy.force mk with MKGetter | MKSetter -> true | _ -> false) def
 	end in
 	let abstract_this = match cctx.abstract with
-		| Some a when fctx.is_abstract_member && name <> "_hx_new" (* TODO: this sucks *) && not fctx.is_macro ->
+		| Some a when fctx.is_abstract_member && not fctx.is_abstract_constructor && not fctx.is_macro ->
 			Some a.a_this
 		| _ ->
 			None
@@ -1271,6 +1273,7 @@ let create_method (ctx,cctx,fctx) c f cf fd p =
 		add_class_field_flag cf CfAbstract;
 	end;
 	if fctx.is_abstract_member then add_class_field_flag cf CfImpl;
+	if fctx.is_abstract_constructor then add_class_field_flag cf CfAbstractConstructor;
 	if fctx.is_generic then add_class_field_flag cf CfGeneric;
 	begin match fctx.default with
 	| Some p ->

src/typing/typer.ml

@@ -1479,7 +1479,7 @@ and type_array_comprehension ctx e with_type p =
 	]) v.v_type p
 
 and type_return ?(implicit=false) ctx e with_type p =
-	let is_abstract_ctor = ctx.e.curfun = FunMemberAbstract && ctx.f.curfield.cf_name = "_hx_new" in
+	let is_abstract_ctor = ctx.e.curfun = FunMemberAbstract && has_class_field_flag ctx.f.curfield CfAbstractConstructor in
 	match e with
 	| None when is_abstract_ctor ->
 		let e_cast = mk (TCast(get_this ctx p,None)) ctx.e.ret p in

src/typing/typerBase.ml

@@ -188,7 +188,7 @@ let assign_to_this_is_allowed ctx =
 		| KAbstractImpl _ ->
 			(match ctx.f.curfield.cf_kind with
 				| Method MethInline -> true
-				| Method _ when ctx.f.curfield.cf_name = "_hx_new" -> true
+				| Method _ when has_class_field_flag ctx.f.curfield CfAbstractConstructor -> true
 				| _ -> false
 			)
 		| _ -> false