initial abstract-class support (fixed issue #1298)

ast.ml

@@ -247,6 +247,7 @@ type abstract_flag =
 	| APrivAbstract
 	| ASubType of complex_type
 	| ASuperType of complex_type
+	| AIsType of complex_type
 
 type enum_constructor = {
 	ec_name : string;
@@ -276,7 +277,7 @@ type type_def =
 	| EClass of (class_flag, class_field list) definition
 	| EEnum of (enum_flag, enum_constructor list) definition
 	| ETypedef of (enum_flag, complex_type) definition
-	| EAbstract of (abstract_flag, unit) definition
+	| EAbstract of (abstract_flag, class_field list) definition
 	| EImport of (string * pos) list * import_mode
 	| EUsing of type_path
 

codegen.ml

@@ -1182,6 +1182,7 @@ let rename_local_vars com e =
 		| _ ->
 			Type.iter loop e
 	in
+	declare (alloc_var "this" t_dynamic) Ast.null_pos; (* force renaming of 'this' vars in abstract *)
 	loop e;
 	e
 

genas3.ml

@@ -235,7 +235,7 @@ let rec type_str ctx t p =
 		| _ -> "Vector.<" ^ type_str ctx pt p ^ ">")
 	| TInst (c,_) ->
 		(match c.cl_kind with
-		| KNormal | KGeneric | KGenericInstance _ -> s_path ctx false c.cl_path p
+		| KNormal | KGeneric | KGenericInstance _ | KAbstractImpl _ -> s_path ctx false c.cl_path p
 		| KTypeParameter _ | KExtension _ | KExpr _ | KMacroType -> "*")
 	| TFun _ ->
 		"Function"

gencpp.ml

@@ -420,6 +420,8 @@ and type_string_suff suffix haxe_type =
       *)
 	| TDynamic haxe_type -> "Dynamic" ^ suffix
 	| TLazy func -> type_string_suff suffix ((!func)())
+	| TAbstract (abs,pl) when abs.a_impl <> None ->
+		type_string_suff suffix (apply_params abs.a_types pl abs.a_this)
 	| TAbstract (abs,pl) ->
 		"::" ^ (join_class_path abs.a_path "::") ^ suffix
 	)

genswf9.ml

@@ -200,6 +200,8 @@ let rec follow_basic t =
 		t
 	| TType (t,tl) ->
 		follow_basic (apply_params t.t_types tl t.t_type)
+	| TAbstract (a,pl) when a.a_impl <> None ->
+		follow_basic (apply_params a.a_types pl a.a_this)
 	| _ -> t
 
 let rec type_id ctx t =

interp.ml

@@ -4110,6 +4110,7 @@ and encode_class_kind k =
 		| KGeneric -> 4, []
 		| KGenericInstance (cl, params) -> 5, [encode_clref cl; encode_tparams params]
 		| KMacroType -> 6, []
+		| KAbstractImpl a -> 7, [encode_ref a encode_tabstract (fun() -> s_type_path a.a_path)]
 	) in
 	enc_enum IClassKind tag pl
 

optimizer.ml

@@ -315,13 +315,27 @@ let rec type_inline ctx cf f ethis params tret p force =
 		in
 		try loop e; true with Exit -> false
 	in
+	let is_writable e =
+		match e.eexpr with
+		| TField _ | TLocal _ | TArray _ -> true
+		| _  -> false
+	in
+	let force = ref force in
 	let vars = List.fold_left (fun acc (i,e) ->
 		let flag = (match e.eexpr with
+			| TLocal { v_name = "this" } -> true
 			| TLocal _ | TConst _ -> not i.i_write
 			| TFunction _ -> if i.i_write then error "Cannot modify a closure parameter inside inline method" p; true
 			| _ -> not i.i_write && i.i_read <= 1
 		) in
 		let flag = flag && (not i.i_captured || is_constant e) in
+		(* force inlining if we modify 'this' *)
+		if i.i_write && i.i_var.v_name = "this" then force := true;
+		(* force inlining of 'this' variable if the expression is writable *)
+		let flag = if not flag && i.i_var.v_name = "this" then begin			
+			if i.i_write && not (is_writable e) then error "Cannot modify the abstract value, store it into a local first" p;
+			true
+		end else flag in
 		if flag then begin
 			subst := PMap.add i.i_subst.v_id e !subst;
 			acc
@@ -342,7 +356,7 @@ let rec type_inline ctx cf f ethis params tret p force =
 
 		This could be fixed with better post process code cleanup (planed)
 	*)
-	if !cancel_inlining || (Common.platform ctx.com Js && not force && (init <> None || !has_vars)) then
+	if !cancel_inlining || (Common.platform ctx.com Js && not !force && (init <> None || !has_vars)) then
 		None
 	else
 		let wrap e =

parser.ml

@@ -247,7 +247,7 @@ and parse_type_decl s =
 				d_flags = List.map snd c;
 				d_data = t;
 			}, punion p1 p2)
-		| [< '(Kwd Abstract,p1); doc = get_doc; name = type_name; tl = parse_constraint_params; sl = psep Comma parse_abstract_relations; '(BrOpen,_); '(BrClose,p2) >] ->
+		| [< '(Kwd Abstract,p1); doc = get_doc; name = type_name; tl = parse_constraint_params; sl = psep Comma parse_abstract_relations; '(BrOpen,_); fl, p2 = parse_class_fields false p1 >] ->
 			let flags = List.map (fun (_,c) -> match c with EPrivate -> APrivAbstract | EExtern -> error (Custom "extern abstract not allowed") p1) c in
 			(EAbstract {
 				d_name = name;
@@ -255,7 +255,7 @@ and parse_type_decl s =
 				d_meta = meta;
 				d_params = tl;
 				d_flags = flags @ sl;
-				d_data = ();
+				d_data = fl;
 			},punion p1 p2)
 
 and parse_import s p1 =
@@ -291,6 +291,7 @@ and parse_abstract_relations s =
 	match s with parser
 	| [< '(Binop OpLte,_); t = parse_complex_type >] -> ASuperType t
 	| [< '(Binop OpAssign,p1); '(Binop OpGt,p2) when p1.pmax = p2.pmin; t = parse_complex_type >] -> ASubType t
+	| [< '(POpen, _); t = parse_complex_type; '(PClose,_) >] -> AIsType t
 
 and parse_package s = psep Dot lower_ident_or_macro s
 

std/haxe/macro/Type.hx

@@ -76,6 +76,7 @@ enum ClassKind {
 	KGeneric;
 	KGenericInstance(cl:Ref<ClassType>, params:Array<Type>);
 	KMacroType;
+	KAbstractImpl(a:Ref<AbstractType>);
 }
 
 typedef ClassType = {> BaseType,

tests/unit/MyAbstract.hx

@@ -0,0 +1,18 @@
+package unit;
+
+abstract MyAbstract(Int) {
+
+    public /*inline*/ function new(x) {
+        this = x;
+    }
+
+    public inline function incr() {
+        return ++this;
+    }
+
+    public inline function toInt() : Int {
+        return this;
+    }
+
+}
+

tests/unit/TestBasetypes.hx

@@ -272,5 +272,15 @@ class TestBasetypes extends Test {
 		eq('a${x}b', "a5b");
 		eq('${x}${y}', "5[]");
 	}
+	
+	function testAbstract() {
+		var a = new MyAbstract(33);
+		t( Std.is(a, Int) );
+		eq( a.toInt(), 33 );
+		var b = a;
+		a.incr();
+		eq( a.toInt(), 34 );
+		eq( b.toInt(), 33 );
+	}
 
 }

type.ml

@@ -158,6 +158,7 @@ and tclass_kind =
 	| KGeneric
 	| KGenericInstance of tclass * tparams
 	| KMacroType
+	| KAbstractImpl of tabstract
 
 and metadata = Ast.metadata
 
@@ -244,6 +245,8 @@ and tabstract = {
 	mutable a_meta : metadata;
 	mutable a_types : type_params;
 
+	mutable a_impl : tclass option;
+	mutable a_this : t;	
 	mutable a_sub : t list;
 	mutable a_super : t list;
 }

typecore.ml

@@ -35,6 +35,7 @@ type current_fun =
 	| FunStatic
 	| FunConstructor
 	| FunMemberLocal
+	| FunMemberAbstract
 
 type macro_mode =
 	| MExpr

typeload.ml

@@ -37,16 +37,16 @@ let make_module ctx mpath file tdecls loadp =
 		m_extra = module_extra (Common.unique_full_path file) (Common.get_signature ctx.com) (file_time file) (if ctx.in_macro then MMacro else MCode);
 	} in
 	let pt = ref None in
-	List.iter (fun decl ->
+	let rec make_decl acc decl =
 		let p = snd decl in
-		match fst decl with
+		let acc = (match fst decl with
 		| EImport _ | EUsing _ when Common.defined ctx.com Define.Haxe3 ->
 			(match !pt with
-			| None -> ()
+			| None -> acc
 			| Some pt ->
 				display_error ctx "import and using may not appear after a type declaration" p;
 				error "Previous type declaration found here" pt)
-		| EImport _ | EUsing _ -> ()
+		| EImport _ | EUsing _ -> acc
 		| EClass d ->
 			pt := Some p;
 			let priv = List.mem HPrivate d.d_flags in
@@ -56,7 +56,8 @@ let make_module ctx mpath file tdecls loadp =
 			c.cl_private <- priv;
 			c.cl_doc <- d.d_doc;
 			c.cl_meta <- d.d_meta;
-			decls := (TClassDecl c, decl) :: !decls
+			decls := (TClassDecl c, decl) :: !decls;
+			acc
 		| EEnum d ->
 			pt := Some p;
 			let priv = List.mem EPrivate d.d_flags in
@@ -73,7 +74,8 @@ let make_module ctx mpath file tdecls loadp =
 				e_constrs = PMap.empty;
 				e_names = [];
 			} in
-			decls := (TEnumDecl e, decl) :: !decls
+			decls := (TEnumDecl e, decl) :: !decls;
+			acc
 		| ETypedef d ->
 			pt := Some p;
 			let priv = List.mem EPrivate d.d_flags in
@@ -88,7 +90,8 @@ let make_module ctx mpath file tdecls loadp =
 				t_type = mk_mono();
 				t_meta = d.d_meta;
 			} in
-			decls := (TTypeDecl t, decl) :: !decls
+			decls := (TTypeDecl t, decl) :: !decls;
+			acc
 	   | EAbstract d ->
 			let priv = List.mem APrivAbstract d.d_flags in
 			let path = make_path d.d_name priv in
@@ -102,12 +105,60 @@ let make_module ctx mpath file tdecls loadp =
 				a_meta = d.d_meta;
 				a_sub = [];
 				a_super = [];
+				a_impl = None;
+				a_this = mk_mono();
 			} in
-			decls := (TAbstractDecl a, decl) :: !decls
-	) tdecls;
+			decls := (TAbstractDecl a, decl) :: !decls;
+			match d.d_data with
+			| [] -> acc
+			| fields ->
+				let rec loop = function
+					| [] ->
+						let params = List.map (fun t -> TPType (CTPath { tname = t.tp_name; tparams = []; tsub = None; tpackage = [] })) d.d_params in
+						CTPath { tpackage = []; tname = d.d_name; tparams = params; tsub = None }
+					| AIsType t :: _ -> t
+					| _ :: l -> loop l
+				in
+				let this_t = loop d.d_flags in
+				let fields = List.map (fun f ->
+					let stat = List.mem AStatic f.cff_access in
+					let p = f.cff_pos in
+					match f.cff_kind with
+					| FVar _ | FProp _ when not stat ->
+						display_error ctx "Cannot declare member variable or property in abstract" p;
+						f
+					| FFun fu when f.cff_name = "new" && not stat ->
+						let init p = (EVars ["this",Some this_t,None],p) in
+						let ret p = (EReturn (Some (EConst (Ident "this"),p)),p) in
+						let fu = {
+							fu with
+							f_expr = (match fu.f_expr with
+							| None -> None
+							| Some (EBlock el,p) -> Some (EBlock (init p :: el @ [ret p]),p)
+							| Some e -> Some (EBlock [init p;e;ret p],p)
+							)
+						} in
+						{ f with cff_name = "_new"; cff_access = AStatic :: f.cff_access; cff_kind = FFun fu }
+					| FFun fu when not stat ->
+						let fu = { fu with f_args = ("this",false,Some this_t,None) :: fu.f_args } in
+						{ f with cff_kind = FFun fu; cff_access = AStatic :: f.cff_access }
+					| _ ->
+						f
+				) fields in
+				let acc = make_decl acc (EClass { d_name = d.d_name ^ "Impl"; d_flags = [HPrivate]; d_data = fields; d_doc = None; d_params = d.d_params; d_meta = [] },p) in
+				(match !decls with
+				| (TClassDecl c,_) :: _ ->
+					a.a_impl <- Some c;
+					c.cl_kind <- KAbstractImpl a
+				| _ -> assert false);
+				acc
+		) in
+		decl :: acc
+	in
+	let tdecls = List.fold_left make_decl [] tdecls in
 	let decls = List.rev !decls in
 	m.m_types <- List.map fst decls;
-	m, decls
+	m, decls, List.rev tdecls
 
 let parse_file com file p =
 	let ch = (try open_in_bin file with _ -> error ("Could not open " ^ file) p) in
@@ -992,7 +1043,12 @@ let init_class ctx c p context_init herits fields =
 		curclass = c;
 		type_params = c.cl_types;
 		pass = PBuildClass;
-		tthis = TInst (c,List.map snd c.cl_types);
+		tthis = (match c.cl_kind with
+			| KAbstractImpl a ->
+				(match a.a_this with
+				| TMono r when !r = None -> TAbstract (a,List.map snd c.cl_types)
+				| t -> t)
+			| _ -> TInst (c,List.map snd c.cl_types));
 		on_error = (fun ctx msg ep ->
 			ctx.com.error msg ep;
 			(* macros expressions might reference other code, let's recall which class we are actually compiling *)
@@ -1146,7 +1202,13 @@ let init_class ctx c p context_init herits fields =
 		let p = f.cff_pos in
 		let stat = List.mem AStatic f.cff_access in
 		let extern = has_meta ":extern" f.cff_meta || c.cl_extern in
-		let inline = List.mem AInline f.cff_access && (match f.cff_kind with FFun _ -> not ctx.com.display && (ctx.g.doinline || extern) | _ -> true) in
+		let allow_inline() =
+			match c.cl_kind, f.cff_kind with
+			| KAbstractImpl _, _ -> true
+			|_, FFun _ -> ctx.g.doinline || extern
+			| _ -> true
+		in
+		let inline = List.mem AInline f.cff_access && allow_inline() in
 		let override = List.mem AOverride f.cff_access in
 		let is_macro = has_meta ":macro" f.cff_meta in
 		if is_macro && Common.defined ctx.com Define.Haxe3 then ctx.com.warning "@:macro should now be 'macro' accessor'" p;
@@ -1271,7 +1333,16 @@ let init_class ctx c p context_init herits fields =
 					context_init();
 					incr stats.s_methods_typed;
 					if ctx.com.verbose then Common.log ctx.com ("Typing " ^ (if ctx.in_macro then "macro " else "") ^ s_type_path c.cl_path ^ "." ^ name);
-					let e , fargs = type_function ctx args ret (if constr then FunConstructor else if stat then FunStatic else FunMember) fd p in
+					let fmode = (match c.cl_kind with
+						| KAbstractImpl _ ->
+							(match args with
+							| ("this",_,_) :: _ -> FunMemberAbstract
+							| _ when name = "_new" -> FunMemberAbstract
+							| _ -> FunStatic)
+						| _ ->
+							if constr then FunConstructor else if stat then FunStatic else FunMember
+					) in
+					let e , fargs = type_function ctx args ret fmode fd p in
 					let f = {
 						tf_args = fargs;
 						tf_type = ret;
@@ -1495,7 +1566,7 @@ let add_module ctx m p =
 	since they have not been setup. We also build a context_init list that will be evaluated the first time we evaluate
 	an expression into the context
 *)
-let init_module_type ctx context_init do_init (decl,p) =
+let rec init_module_type ctx context_init do_init (decl,p) =
 	let get_type name =
 		try List.find (fun t -> snd (t_infos t).mt_path = name) ctx.m.curmod.m_types with Not_found -> assert false
 	in
@@ -1784,10 +1855,14 @@ let init_module_type ctx context_init do_init (decl,p) =
 			| APrivAbstract -> ()
 			| ASubType t -> a.a_sub <- load_complex_type ctx p t :: a.a_sub
 			| ASuperType t -> a.a_super <- load_complex_type ctx p t :: a.a_super
+			| AIsType t ->
+				(match a.a_this with
+				| TMono _ -> a.a_this <- load_complex_type ctx p t
+				| _ -> error "Duplicate This-type definition" p)
 		) d.d_flags
 
 let type_module ctx m file tdecls p =
-	let m, decls = make_module ctx m file tdecls p in
+	let m, decls, tdecls = make_module ctx m file tdecls p in
 	add_module ctx m p;
 	(* define the per-module context for the next pass *)
 	let ctx = {

typer.ml

@@ -521,6 +521,8 @@ let rec type_module_type ctx t tparams p =
 			type_module_type ctx (TAbstractDecl a) (Some params) p
 		| _ ->
 			error (s_type_path s.t_path ^ " is not a value") p)
+	| TAbstractDecl { a_impl = Some c } ->
+		type_module_type ctx (TClassDecl c) tparams p
 	| TAbstractDecl a ->
 		if not (has_meta ":runtimeValue" a.a_meta) then error (s_type_path a.a_path ^ " is not a value") p;
 		let t_tmp = {
@@ -542,8 +544,14 @@ let type_type ctx tpath p =
 	type_module_type ctx (Typeload.load_type_def ctx p { tpackage = fst tpath; tname = snd tpath; tparams = []; tsub = None }) None p
 
 let get_constructor ctx c params p =
-	let ct, f = (try Type.get_constructor (fun f -> field_type ctx c params f p) c with Not_found -> error (s_type_path c.cl_path ^ " does not have a constructor") p) in
-	apply_params c.cl_types params ct, f
+	match c.cl_kind with
+	| KAbstractImpl a ->
+		let f = (try PMap.find "_new" c.cl_statics with Not_found -> error (s_type_path a.a_path ^ " does not have a constructor") p) in
+		let ct = field_type ctx c params f p in
+		apply_params c.cl_types params ct, f
+	| _ ->
+		let ct, f = (try Type.get_constructor (fun f -> field_type ctx c params f p) c with Not_found -> error (s_type_path c.cl_path ^ " does not have a constructor") p) in
+		apply_params c.cl_types params ct, f
 
 let make_call ctx e params t p =
 	try
@@ -556,6 +564,7 @@ let make_call ctx e params t p =
 		if f.cf_kind <> Method MethInline then raise Exit;
 		let is_extern = (match cl with
 			| Some { cl_extern = true } -> true
+			| Some { cl_kind = KAbstractImpl _ } -> true
 			| _ when has_meta ":extern" f.cf_meta -> true
 			| _ -> false
 		) in
@@ -755,7 +764,6 @@ let get_this ctx p =
 	| FunStatic ->
 		error "Cannot access this from a static function" p
 	| FunMemberLocal ->
-		if ctx.untyped then display_error ctx "Cannot access this in 'untyped' mode : use either '__this__' or var 'me = this' (transitional)" p;
 		let v = (match ctx.vthis with
 			| None ->
 				let v = gen_local ctx ctx.tthis in
@@ -766,6 +774,9 @@ let get_this ctx p =
 				v
 		) in
 		mk (TLocal v) ctx.tthis p
+	| FunMemberAbstract ->
+		let v = (try PMap.find "this" ctx.locals with Not_found -> assert false) in
+		mk (TLocal v) v.v_type p
 	| FunConstructor | FunMember ->
 		mk (TConst TThis) ctx.tthis p
 
@@ -782,10 +793,18 @@ let rec type_ident_raise ?(imported_enums=true) ctx i p mode =
 		else
 			AKNo i
 	| "this" ->
+		(match mode, ctx.curclass.cl_kind with
+		| MSet, KAbstractImpl _ ->
+			(match ctx.curfield.cf_kind with
+			| Method MethInline -> ()
+			| Method _ when ctx.curfield.cf_name = "_new" -> ()
+			| _ -> error "You can only modify 'this' inside an inline function" p);
+			AKExpr (get_this ctx p)
+		| _ ->
 		if mode = MGet then
 			AKExpr (get_this ctx p)
 		else
-			AKNo i
+			AKNo i)
 	| "super" ->
 		let t = (match ctx.curclass.cl_super with
 			| None -> error "Current class does not have a superclass" p
@@ -793,6 +812,7 @@ let rec type_ident_raise ?(imported_enums=true) ctx i p mode =
 		) in
 		(match ctx.curfun with
 		| FunMember | FunConstructor -> ()
+		| FunMemberAbstract -> error "Cannot access super inside an abstract function" p
 		| FunStatic -> error "Cannot access super inside a static function" p;
 		| FunMemberLocal -> error "Cannot access super inside a local function" p);
 		if mode <> MSet && ctx.in_super_call then ctx.in_super_call <- false;
@@ -986,6 +1006,17 @@ and type_field ctx e i p mode =
 		ctx.opened <- x :: ctx.opened;
 		r := Some t;
 		field_access ctx mode f (FAnon f) (Type.field_type f) e p
+	| TAbstract (a,pl) ->
+		(try
+			let c = (match a.a_impl with None -> raise Not_found | Some c -> c) in
+			let f = PMap.find i c.cl_statics in
+			let t = field_type ctx c [] f p in
+			let et = type_module_type ctx (TClassDecl c) None p in
+			AKUsing ((mk (TField (et,FStatic (c,f))) t p),c,f,e)
+		with Not_found -> try
+			using_field ctx mode e i p
+		with Not_found ->
+			no_field())
 	| _ ->
 		try using_field ctx mode e i p with Not_found -> no_field()
 
@@ -2259,7 +2290,14 @@ and type_expr ctx (e,p) (with_type:with_type) =
 		type_call ctx e el with_type p
 	| ENew (t,el) ->
 		let t = Typeload.load_instance ctx t p true in
-		let el, c , params = (match follow t with
+		let ct = (match follow t with
+			| TAbstract (a,pl) ->
+				(match a.a_impl with
+				| None -> t
+				| Some c -> TInst (c,pl))
+			| _ -> t
+		) in
+		(match follow ct with
 		| TInst ({cl_kind = KTypeParameter tl} as c,params) ->
 			if not (Codegen.is_generic_parameter ctx c) then error "Only generic type parameters can be constructed" p;
 			let el = List.map (fun e -> type_expr ctx e Value) el in
@@ -2272,10 +2310,8 @@ and type_expr ctx (e,p) (with_type:with_type) =
 						())
 				| _ -> ()
 			) tl;
-			el,c,params
+			mk (TNew (c,params,el)) t p
 		| TInst (c,params) ->
-			let name = (match c.cl_path with [], name -> name | x :: _ , _ -> x) in
-			if PMap.mem name ctx.locals then error ("Local variable " ^ name ^ " is preventing usage of this class here") p;
 			let ct, f = get_constructor ctx c params p in
 			if not (can_access ctx c f true || is_parent c ctx.curclass) && not ctx.untyped then display_error ctx "Cannot access private constructor" p;
 			(match f.cf_kind with
@@ -2291,11 +2327,16 @@ and type_expr ctx (e,p) (with_type:with_type) =
 			| _ ->
 				error "Constructor is not a function" p
 			) in
-			el , c , params
+			(match c.cl_kind with
+			| KAbstractImpl _ ->
+				let ta = TAnon { a_fields = c.cl_statics; a_status = ref (Statics c) } in
+				let e = mk (TTypeExpr (TClassDecl c)) ta p in
+				let e = mk (TField (e,(FStatic (c,f)))) ct p in
+				make_call ctx e el t p
+			| _ ->
+				mk (TNew (c,params,el)) t p)
 		| _ ->
-			error (s_type (print_context()) t ^ " cannot be constructed") p
-		) in
-		mk (TNew (c,params,el)) t p
+			error (s_type (print_context()) t ^ " cannot be constructed") p)
 	| EUnop (op,flag,e) ->
 		type_unop ctx op flag e p
 	| EFunction (name,f) ->