force {new} constraint on generic type parameters to be explicit (fixed issue #1169)

codegen.ml

@@ -263,13 +263,36 @@ let generic_substitute_expr gctx e =
 	let rec build_expr e = map_expr_type build_expr (generic_substitute_type gctx) build_var 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);
+		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 rec build_generic ctx c p tl =
 	let pack = fst c.cl_path in
 	let recurse = ref false in
 	let rec check_recursive t =
 		match follow t with
-		| TInst (c,tl) ->
-			(match c.cl_kind with KTypeParameter _ -> recurse := true | _ -> ());
+		| TInst (c2,tl) ->
+			(match c2.cl_kind with
+			| KTypeParameter tl ->
+				List.iter (fun t -> match follow t with
+					| TAnon a when PMap.mem "new" a.a_fields ->
+						error "Type parameters with a constructor cannot be used non-generically" p
+					| _ -> ()
+				) tl;
+				if not (is_generic_parameter ctx c2) && not (has_meta ":?keepGenericBase" c.cl_meta) then begin
+					print_endline ("Keep " ^ (s_type_path c.cl_path));
+					c.cl_meta <- (":?keepGenericBase",[],p) :: c.cl_meta;
+				end;
+				recurse := true
+			| _ -> ());
 			List.iter check_recursive tl;
 		| _ ->
 			()
@@ -578,19 +601,8 @@ let check_private_path ctx t = match t with
 
 (* Removes generic base classes *)
 let remove_generic_base ctx t = match t with
-	| TClassDecl c when c.cl_kind = KGeneric && has_meta ":?genericT" c.cl_meta ->
-		(* TODO: we have to get the detection right eventually *)
+	| TClassDecl c when c.cl_kind = KGeneric && not (has_meta ":?keepGenericBase" c.cl_meta) ->
 		c.cl_extern <- true
-(* 		(try
-			let (_,_,prec) = get_meta ":?genericRec" c.cl_meta in
-			(try
-				let (_,_,pnew) = get_meta ":?genericT" c.cl_meta in
-				display_error ctx ("Class " ^ (s_type_path c.cl_path) ^ " was used recursively and cannot use its type parameter") prec;
-				error "Type parameter usage was here" pnew
-			with Not_found ->
-				());
-		with Not_found ->
-			c.cl_extern <- true); *)
 	| _ ->
 		()
 

type.ml

@@ -273,11 +273,6 @@ and module_kind =
 	| MMacro
 	| MFake
 
-type generic_parameter_kind =
-	| GPNone
-	| GPField of tclass_field
-	| GPClass of tclass
-
 let alloc_var =
 	let uid = ref 0 in
 	(fun n t -> incr uid; { v_name = n; v_type = t; v_id = !uid; v_capture = false; v_extra = None })

typeload.ml

@@ -234,17 +234,6 @@ let check_param_constraints ctx types t pl c p =
 			unify ctx t ti p
 		) ctl
 
-let get_generic_parameter_kind ctx c =
-	(* first check field parameters, then class parameters *)
-	try
-		ignore (List.assoc (snd c.cl_path) ctx.curfield.cf_params);
-		if has_meta ":generic" ctx.curfield.cf_meta then GPField ctx.curfield else GPNone;
-	with Not_found -> try
-		ignore(List.assoc (snd c.cl_path) ctx.type_params);
-		(match ctx.curclass.cl_kind with | KGeneric -> GPClass ctx.curclass | _ -> GPNone);
-	with Not_found ->
-		GPNone
-
 (* build an instance from a full type *)
 let rec load_instance ctx t p allow_no_params =
 	try
@@ -254,8 +243,7 @@ let rec load_instance ctx t p allow_no_params =
 		pt
 	with Not_found ->
 		let mt = load_type_def ctx p t in
-		let cg = match mt with TClassDecl ({cl_kind = KGeneric} as c) -> Some c | _ -> None in
-		let is_generic = cg <> None in
+		let is_generic = match mt with TClassDecl {cl_kind = KGeneric} -> true | _ -> false in
 		let types , path , f = ctx.g.do_build_instance ctx mt p in
 		if allow_no_params && t.tparams = [] then begin
 			let pl = ref [] in
@@ -296,12 +284,6 @@ let rec load_instance ctx t p allow_no_params =
 				| TInst ({ cl_kind = KTypeParameter [] }, []) when not is_generic ->
 					t
 				| TInst (c,[]) ->
-					(* mark a generic class as recursively used if it is used with an "unresolved" non-generic type parameter *)
-					(match get_generic_parameter_kind ctx c,cg with
-					| (GPField _ | GPNone), Some c ->
-						if not (has_meta ":?genericRec" c.cl_meta) then c.cl_meta <- (":?genericRec",[],p) :: c.cl_meta
-					| _ ->
-						());
 					let r = exc_protect ctx (fun r ->
 						r := (fun() -> t);
 						delay ctx PCheckConstraint (fun() -> check_param_constraints ctx types t tparams c p);

typer.ml

@@ -2120,27 +2120,17 @@ and type_expr ctx ?(need_val=true) (e,p) =
 		let t = Typeload.load_instance ctx t p true in
 		let el, c , params = (match follow t with
 		| TInst ({cl_kind = KTypeParameter tl} as c,params) ->
-			(match Typeload.get_generic_parameter_kind ctx c with
-			| GPClass c ->
-				if not (has_meta ":?genericT" c.cl_meta) then c.cl_meta <- (":?genericT",[],p) :: c.cl_meta;
-			| GPField cf ->
-				()
-			| GPNone ->
-				error "Only generic type parameters can be constructed" p);
+			if not (Codegen.is_generic_parameter ctx c) then error "Only generic type parameters can be constructed" p;
 			let el = List.map (type_expr ctx) el in
-			let ctor = mk_field "new" (tfun (List.map (fun e -> e.etype) el) ctx.t.tvoid) p in
-			ctor.cf_public <- false;
-  			(match c.cl_constructor with
- 				| Some ctor2 ->
- 					unify ctx ctor.cf_type ctor2.cf_type p
- 				| None ->
-					ctor.cf_kind <- Method MethNormal;
- 					c.cl_constructor <- Some ctor;
-					List.iter (fun t -> match follow t with
-						| TAnon a -> (try unify ctx (PMap.find "new" a.a_fields).cf_type ctor.cf_type p; with Not_found -> ())
-						| _ -> ()
-					) tl;
-					c.cl_kind <- KTypeParameter ((mk_anon (PMap.add "new" ctor PMap.empty)) :: tl));
+			let ct = (tfun (List.map (fun e -> e.etype) el) ctx.t.tvoid) in
+			List.iter (fun t -> match follow t with
+				| TAnon a ->
+					(try
+						unify ctx (PMap.find "new" a.a_fields).cf_type ct p;
+					with Not_found ->
+						())
+				| _ -> ()
+			) tl;
 			el,c,params
 		| TInst (c,params) ->
 			let name = (match c.cl_path with [], name -> name | x :: _ , _ -> x) in