Merge branch 'generic_fix' into development

codegen.ml

@@ -271,17 +271,6 @@ let generic_substitute_expr gctx e =
 	in
 	build_expr e
 
-let is_generic_parameter ctx c =
-	(* first check field parameters, then class parameters *)
-	try
-		ignore (List.assoc (snd c.cl_path) ctx.curfield.cf_params);
-		Meta.has Meta.Generic ctx.curfield.cf_meta
-	with Not_found -> try
-		ignore(List.assoc (snd c.cl_path) ctx.type_params);
-		(match ctx.curclass.cl_kind with | KGeneric -> true | _ -> false);
-	with Not_found ->
-		false
-
 let has_ctor_constraint c = match c.cl_kind with
 	| KTypeParameter tl ->
 		List.exists (fun t -> match follow t with
@@ -298,7 +287,7 @@ let rec build_generic ctx c p tl =
 		| TInst (c2,tl) ->
 			(match c2.cl_kind with
 			| KTypeParameter tl ->
-				if not (is_generic_parameter ctx c2) && has_ctor_constraint c2 then
+				if not (Typeload.is_generic_parameter ctx c2) && has_ctor_constraint c2 then
 					error "Type parameters with a constructor cannot be used non-generically" p;
 				recurse := true
 			| _ -> ());
@@ -373,19 +362,36 @@ let rec build_generic ctx c p tl =
 		cg.cl_super <- (match c.cl_super with
 			| None -> None
 			| Some (cs,pl) ->
-				(match apply_params c.cl_types tl (TInst (cs,pl)) with
-				| TInst (cs,pl) when cs.cl_kind = KGeneric ->
+				let find_class subst =
+					let rec loop subst = match subst with
+						| (TInst(c,[]),t) :: subst when c == cs -> t
+						| _ :: subst -> loop subst
+						| [] -> raise Not_found
+					in
+					try
+						if pl <> [] then raise Not_found;
+						let t = loop subst in
+						(match c.cl_constructor with None -> () | Some cf -> error "Generics extending type parameters cannot have constructors" cf.cf_pos);
+						t
+					with Not_found ->
+						apply_params c.cl_types tl (TInst(cs,pl))
+				in
+				let ts = follow (find_class gctx.subst) in
+				let cs,pl = Typeload.check_extends ctx c ts p in
+				match cs.cl_kind with
+				| KGeneric ->
 					(match build_generic ctx cs p pl with
 					| TInst (cs,pl) -> Some (cs,pl)
 					| _ -> assert false)
-				| TInst (cs,pl) -> Some (cs,pl)
-				| _ -> assert false)
+				| _ -> Some(cs,pl)
 		);
+		Typeload.add_constructor ctx cg p;
 		cg.cl_kind <- KGenericInstance (c,tl);
 		cg.cl_interface <- c.cl_interface;
-		cg.cl_constructor <- (match c.cl_constructor, c.cl_super with
-			| None, None -> None
-			| Some c, _ -> Some (build_field c)
+		cg.cl_constructor <- (match cg.cl_constructor, c.cl_constructor, c.cl_super with
+			| Some ctor, _, _ -> Some ctor
+			| None, None, None -> None
+			| None, Some c, _ -> Some (build_field c)
 			| _ -> error "Please define a constructor for this class in order to use it as generic" c.cl_pos
 		);
 		cg.cl_implements <- List.map (fun (i,tl) ->

genneko.ml

@@ -706,7 +706,7 @@ let gen_name ctx acc t =
 		in
 		setname :: setconstrs :: meta @ acc
 	| TClassDecl c ->
-		if c.cl_extern then
+		if c.cl_extern || (match c.cl_kind with KTypeParameter _ -> true | _ -> false) then
 			acc
 		else
 			let p = pos ctx c.cl_pos in

tests/unit/Test.hx

@@ -238,6 +238,7 @@ class Test #if swf_mark implements mt.Protect #end {
 			new TestType(),
 			new TestOrder(),
 			new TestGADT(),
+			new TestGeneric(),
 			#if !no_pattern_matching
 			new TestMatch(),
 			#end

tests/unit/TestGeneric.hx

@@ -0,0 +1,44 @@
+package unit;
+
+@:generic
+class MyGeneric<T> {
+	public var t:T;
+	public function new(t:T) {
+		this.t = t;
+	}
+}
+
+@:generic
+class MyGeneric2<T> extends T {
+	//public function new() { } // not allowed
+}
+
+class MyRandomClass {
+	public var s:String;
+	public function new(s:String) {
+		this.s = s;
+	}
+}
+
+class TestGeneric extends Test {
+	function testBasic() {
+		var mg = new MyGeneric<Int>(12);
+		eq(mg.t, 12);
+		t(Std.is(mg.t, Int));
+		
+		var mg = new MyGeneric<String>("12");
+		eq(mg.t,"12");
+		t(Std.is(mg.t, String));
+	}
+	
+	function testExtends() {
+		t(unit.TestType.typeError(new MyGeneric2<String>()));
+		t(unit.TestType.typeError(new MyGeneric2<Int>()));
+		
+		var mg = new MyGeneric2<MyRandomClass>("foo");
+		eq("foo", mg.s);
+		
+		var mg = new MyGeneric2<MyGeneric<MyRandomClass>>(new MyRandomClass("foo"));
+		eq("foo", mg.t.s);
+	}
+}

typeload.ml

@@ -918,6 +918,89 @@ let rec return_flow ctx e =
 (* ---------------------------------------------------------------------- *)
 (* PASS 1 & 2 : Module and Class Structure *)
 
+let is_generic_parameter ctx c =
+	(* first check field parameters, then class parameters *)
+	try
+		ignore (List.assoc (snd c.cl_path) ctx.curfield.cf_params);
+		Meta.has Meta.Generic ctx.curfield.cf_meta
+	with Not_found -> try
+		ignore(List.assoc (snd c.cl_path) ctx.type_params);
+		(match ctx.curclass.cl_kind with | KGeneric -> true | _ -> false);
+	with Not_found ->
+		false
+
+let check_extends ctx c t p = match follow t with
+	| TInst ({ cl_path = [],"Array" },_)
+	| TInst ({ cl_path = [],"String" },_)
+	| TInst ({ cl_path = [],"Date" },_)
+	| TInst ({ cl_path = [],"Xml" },_) when ((not (platform ctx.com Cpp)) && (match c.cl_path with ("mt" | "flash") :: _ , _ -> false | _ -> true)) ->
+		error "Cannot extend basic class" p;
+	| TInst (csup,params) ->
+		if is_parent c csup then error "Recursive class" p;
+		begin match csup.cl_kind with
+			| KTypeParameter _ when not (is_generic_parameter ctx csup) -> error "Cannot extend non-generic type parameters" p
+			| _ -> csup,params
+		end
+	| _ -> error "Should extend by using a class" p
+
+let rec add_constructor ctx c p =
+	match c.cl_constructor, c.cl_super with
+	| None, Some ({ cl_constructor = Some cfsup } as csup,cparams) when not c.cl_extern ->
+		let cf = {
+			cfsup with
+			cf_pos = p;
+			cf_meta = [];
+			cf_doc = None;
+			cf_expr = None;
+		} in
+		let r = exc_protect ctx (fun r ->
+			let t = mk_mono() in
+			r := (fun() -> t);
+			let ctx = { ctx with
+				curfield = cf;
+				pass = PTypeField;
+			} in
+			ignore (follow cfsup.cf_type); (* make sure it's typed *)
+			(if ctx.com.config.pf_overload then List.iter (fun cf -> ignore (follow cf.cf_type)) cf.cf_overloads);
+			let args = (match cfsup.cf_expr with
+				| Some { eexpr = TFunction f } ->
+					List.map (fun (v,def) ->
+						(*
+							let's optimize a bit the output by not always copying the default value
+							into the inherited constructor when it's not necessary for the platform
+						*)
+						match ctx.com.platform, def with
+						| _, Some _ when not ctx.com.config.pf_static -> v, (Some TNull)
+						| Flash, Some (TString _) -> v, (Some TNull)
+						| Cpp, Some (TString _) -> v, def
+						| Cpp, Some _ -> { v with v_type = ctx.t.tnull v.v_type }, (Some TNull)
+						| _ -> v, def
+					) f.tf_args
+				| _ ->
+					match follow cfsup.cf_type with
+					| TFun (args,_) -> List.map (fun (n,o,t) -> alloc_var n (if o then ctx.t.tnull t else t), if o then Some TNull else None) args
+					| _ -> assert false
+			) in
+			let p = c.cl_pos in
+			let vars = List.map (fun (v,def) -> alloc_var v.v_name (apply_params csup.cl_types cparams v.v_type), def) args in
+			let super_call = mk (TCall (mk (TConst TSuper) (TInst (csup,cparams)) p,List.map (fun (v,_) -> mk (TLocal v) v.v_type p) vars)) ctx.t.tvoid p in
+			let constr = mk (TFunction {
+				tf_args = vars;
+				tf_type = ctx.t.tvoid;
+				tf_expr = super_call;
+			}) (TFun (List.map (fun (v,c) -> v.v_name, c <> None, v.v_type) vars,ctx.t.tvoid)) p in
+			cf.cf_expr <- Some constr;
+			cf.cf_type <- t;
+			unify ctx t constr.etype p;
+			t
+		) "add_constructor" in
+		cf.cf_type <- TLazy r;
+		c.cl_constructor <- Some cf;
+		delay ctx PForce (fun() -> ignore((!r)()));
+	| _ ->
+		(* nothing to do *)
+		()
+
 let set_heritance ctx c herits p =
 	let ctx = { ctx with curclass = c; type_params = c.cl_types; } in
 	let process_meta csup =
@@ -935,25 +1018,16 @@ let set_heritance ctx c herits p =
 		| HExtends t ->
 			if c.cl_super <> None then error "Cannot extend several classes" p;
 			let t = load_instance ctx t p false in
-			(match follow t with
-			| TInst ({ cl_path = [],"Array" },_)
-			| TInst ({ cl_path = [],"String" },_)
-			| TInst ({ cl_path = [],"Date" },_)
-			| TInst ({ cl_path = [],"Xml" },_) when ((not (platform ctx.com Cpp)) && (match c.cl_path with ("mt" | "flash") :: _ , _ -> false | _ -> true)) ->
-				error "Cannot extend basic class" p;
-			| TInst (csup,params) ->
-				csup.cl_build();
-				if is_parent c csup then error "Recursive class" p;
-				process_meta csup;
-				(* interface extends are listed in cl_implements ! *)
-				if c.cl_interface then begin
-					if not csup.cl_interface then error "Cannot extend by using a class" p;
-					c.cl_implements <- (csup,params) :: c.cl_implements
-				end else begin
-					if csup.cl_interface then error "Cannot extend by using an interface" p;
-					c.cl_super <- Some (csup,params)
-				end
-			| _ -> error "Should extend by using a class" p)
+			let csup,params = check_extends ctx c t p in
+			csup.cl_build();
+			process_meta csup;
+			if c.cl_interface then begin
+				if not csup.cl_interface then error "Cannot extend by using a class" p;
+				c.cl_implements <- (csup,params) :: c.cl_implements
+			end else begin
+				if csup.cl_interface then error "Cannot extend by using an interface" p;
+				c.cl_super <- Some (csup,params)
+			end
 		| HImplements t ->
 			let t = load_instance ctx t p false in
 			(match follow t with
@@ -1831,67 +1905,10 @@ let init_class ctx c p context_init herits fields =
 	(*
 		make sure a default contructor with same access as super one will be added to the class structure at some point.
 	*)
-	let rec add_constructor c =
-		match c.cl_constructor, c.cl_super with
-		| None, Some ({ cl_constructor = Some cfsup } as csup,cparams) when not c.cl_extern ->
-			let cf = {
-				cfsup with
-				cf_pos = p;
-				cf_meta = [];
-				cf_doc = None;
-				cf_expr = None;
-			} in
-			let r = exc_protect ctx (fun r ->
-				let t = mk_mono() in
-				r := (fun() -> t);
-				let ctx = { ctx with
-					curfield = cf;
-					pass = PTypeField;
-				} in
-				ignore (follow cfsup.cf_type); (* make sure it's typed *)
-				(if ctx.com.config.pf_overload then List.iter (fun cf -> ignore (follow cf.cf_type)) cf.cf_overloads);
-				let args = (match cfsup.cf_expr with
-					| Some { eexpr = TFunction f } ->
-						List.map (fun (v,def) ->
-							(*
-								let's optimize a bit the output by not always copying the default value
-								into the inherited constructor when it's not necessary for the platform
-							*)
-							match ctx.com.platform, def with
-							| _, Some _ when not ctx.com.config.pf_static -> v, (Some TNull)
-							| Flash, Some (TString _) -> v, (Some TNull)
-							| Cpp, Some (TString _) -> v, def
-							| Cpp, Some _ -> { v with v_type = ctx.t.tnull v.v_type }, (Some TNull)
-							| _ -> v, def
-						) f.tf_args
-					| _ ->
-						match follow cfsup.cf_type with
-						| TFun (args,_) -> List.map (fun (n,o,t) -> alloc_var n (if o then ctx.t.tnull t else t), if o then Some TNull else None) args
-						| _ -> assert false
-				) in
-				let p = c.cl_pos in
-				let vars = List.map (fun (v,def) -> alloc_var v.v_name (apply_params csup.cl_types cparams v.v_type), def) args in
-				let super_call = mk (TCall (mk (TConst TSuper) (TInst (csup,cparams)) p,List.map (fun (v,_) -> mk (TLocal v) v.v_type p) vars)) ctx.t.tvoid p in
-				let constr = mk (TFunction {
-					tf_args = vars;
-					tf_type = ctx.t.tvoid;
-					tf_expr = super_call;
-				}) (TFun (List.map (fun (v,c) -> v.v_name, c <> None, v.v_type) vars,ctx.t.tvoid)) p in
-				cf.cf_expr <- Some constr;
-				cf.cf_type <- t;
-				unify ctx t constr.etype p;
-				t
-			) "add_constructor" in
-			cf.cf_type <- TLazy r;
-			c.cl_constructor <- Some cf;
-			delay ctx PForce (fun() -> ignore((!r)()));
-		| _ ->
-			(* nothing to do *)
-			()
-	in
+
   (* add_constructor does not deal with overloads correctly *)
   if not ctx.com.config.pf_overload then
-  	add_constructor c;
+  	add_constructor ctx c p;
 	(* check overloaded constructors *)
 	(if ctx.com.config.pf_overload then match c.cl_constructor with
 	| Some ctor ->

typer.ml

@@ -2685,7 +2685,7 @@ and type_expr ctx (e,p) (with_type:with_type) =
 		) 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;
+			if not (Typeload.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
 			let ct = (tfun (List.map (fun e -> e.etype) el) ctx.t.tvoid) in
 			if not (List.exists (fun t -> match follow t with