Browse Source

Internal type parameter changes (#11436)

* use tclass equality instead of Type.t

* change type parameter handling

* fix gencommon a bit

* remove redundant name

* fix gencommon param cloning

* make sure lazies are resolved at some point
Simon Krajewski 1 năm trước cách đây
mục cha
commit
541259e4c3
39 tập tin đã thay đổi với 279 bổ sung341 xóa
  1. 7 2
      src/codegen/codegen.ml
  2. 1 1
      src/codegen/gencommon/castDetect.ml
  3. 4 11
      src/codegen/gencommon/closuresToClass.ml
  4. 4 4
      src/codegen/gencommon/dynamicFieldAccess.ml
  5. 2 2
      src/codegen/gencommon/enumToClass.ml
  6. 5 2
      src/codegen/gencommon/gencommon.ml
  7. 8 9
      src/codegen/gencommon/overloadingConstructor.ml
  8. 7 8
      src/codegen/gencommon/realTypeParams.ml
  9. 4 10
      src/codegen/gencommon/renameTypeParameters.ml
  10. 3 6
      src/codegen/overloads.ml
  11. 4 3
      src/context/abstractCast.ml
  12. 6 5
      src/context/display/displayFields.ml
  13. 2 4
      src/context/display/displayToplevel.ml
  14. 2 2
      src/context/typecore.ml
  15. 6 8
      src/core/display/completionItem.ml
  16. 5 9
      src/core/json/genjson.ml
  17. 22 12
      src/core/tFunctions.ml
  18. 13 15
      src/core/tPrinting.ml
  19. 3 1
      src/core/tType.ml
  20. 19 18
      src/core/tUnification.ml
  21. 2 5
      src/filters/filtersCommon.ml
  22. 5 6
      src/generators/gencs.ml
  23. 5 5
      src/generators/genhl.ml
  24. 2 11
      src/generators/genjava.ml
  25. 10 12
      src/generators/genjvm.ml
  26. 1 1
      src/generators/genlua.ml
  27. 1 3
      src/generators/genswf.ml
  28. 2 2
      src/generators/genswf9.ml
  29. 6 36
      src/macro/macroApi.ml
  30. 4 4
      src/optimization/dce.ml
  31. 1 1
      src/optimization/inline.ml
  32. 2 2
      src/typing/fields.ml
  33. 16 19
      src/typing/generic.ml
  34. 2 2
      src/typing/operators.ml
  35. 65 71
      src/typing/typeload.ml
  36. 21 22
      src/typing/typeloadCheck.ml
  37. 2 2
      src/typing/typer.ml
  38. 2 2
      src/typing/typerBase.ml
  39. 3 3
      src/typing/typerDisplay.ml

+ 7 - 2
src/codegen/codegen.ml

@@ -122,8 +122,13 @@ let fix_override com c f fd =
 					(* Flash generates type parameters with a single constraint as that constraint type, so we
 					   have to detect this case and change the variable (issue #2712). *)
 					begin match follow v.v_type with
-						| TInst({cl_kind = KTypeParameter [tc]} as cp,_) when com.platform = Flash ->
-							if List.exists (fun tp -> tp.ttp_name = (snd cp.cl_path)) c.cl_params then raise (Unify_error [])
+						| TInst({cl_kind = KTypeParameter ttp} as cp,_) when com.platform = Flash ->
+							begin match get_constraints ttp with
+							| [tc] ->
+								if List.exists (fun tp -> tp.ttp_name = (snd cp.cl_path)) c.cl_params then raise (Unify_error [])
+							| _ ->
+								()
+							end
 						| _ ->
 							()
 					end;

+ 1 - 1
src/codegen/gencommon/castDetect.ml

@@ -290,7 +290,7 @@ let do_unsafe_cast gen from_t to_t e	=
 			| _ -> raise Not_found
 	in
 	match gen.gfollow#run_f from_t, gen.gfollow#run_f to_t with
-	| TInst({ cl_kind = KTypeParameter tl },_), t2 when List.exists (fun t -> unifies t t2) tl ->
+	| TInst({ cl_kind = KTypeParameter ttp },_), t2 when List.exists (fun t -> unifies t t2) (get_constraints ttp) ->
 		mk_cast to_t (mk_cast t_dynamic e)
 	| from_t, to_t when gen.gspecial_needs_cast to_t from_t ->
 		mk_cast to_t e

+ 4 - 11
src/codegen/gencommon/closuresToClass.ml

@@ -289,10 +289,7 @@ let rec get_type_params acc t =
 				get_type_params acc ( Abstract.get_underlying_type a pl)
 		| TAnon a ->
 			PMap.fold (fun cf acc ->
-				let params = List.map (fun tp -> match follow tp.ttp_type with
-					| TInst(c,_) -> c
-					| _ -> die "" __LOC__) cf.cf_params
-				in
+				let params = List.map (fun tp -> tp.ttp_class) cf.cf_params in
 				List.filter (fun t -> not (List.memq t params)) (get_type_params acc cf.cf_type)
 			) a.a_fields acc
 		| TType(_, [])
@@ -396,7 +393,7 @@ let configure gen ft =
 		in
 
 		(*let cltypes = List.map (fun cl -> (snd cl.cl_path, TInst(map_param cl, []) )) tparams in*)
-		let cltypes = List.map (fun cl -> mk_type_param (snd cl.cl_path) (TInst(cl, [])) None) tparams in
+		let cltypes = List.map (fun cl -> mk_type_param cl None None) tparams in
 
 		(* create a new class that extends abstract function class, with a ctor implementation that will setup all captured variables *)
 		let cfield = match gen.gcurrent_classfield with
@@ -613,14 +610,10 @@ let configure gen ft =
 
 			let monos = List.map (fun t -> apply_params types (List.map (fun _ -> t_dynamic) types) t) monos in
 
-			let same_cl t1 t2 = match follow t1, follow t2 with
-				| TInst(c,_), TInst(c2,_) -> c == c2
-				| _ -> false
-			in
-			let passoc = List.map2 (fun tp m -> tp.ttp_type,m) types monos in
+			let passoc = List.map2 (fun tp m -> tp.ttp_class,m) types monos in
 			let cltparams = List.map (fun tp ->
 				try
-					snd (List.find (fun (t2,_) -> same_cl tp.ttp_type t2) passoc)
+					snd (List.find (fun (t2,_) -> tp.ttp_class == t2) passoc)
 				with | Not_found -> tp.ttp_type) cls.cl_params
 			in
 			{ e with eexpr = TNew(cls, cltparams, List.rev captured) }

+ 4 - 4
src/codegen/gencommon/dynamicFieldAccess.ml

@@ -58,8 +58,8 @@ let priority = solve_deps name [DAfter DynamicOperators.priority]
 *)
 let configure gen (is_dynamic:texpr->Type.tfield_access->bool) (change_expr:texpr->texpr->string->texpr option->bool->texpr) (call_expr:texpr->texpr->string->texpr list->texpr) =
 	let is_nondynamic_tparam fexpr f = match follow fexpr.etype with
-		| TInst({ cl_kind = KTypeParameter(tl) }, _) ->
-			List.exists (fun t -> not (is_dynamic { fexpr with etype = t } f)) tl
+		| TInst({ cl_kind = KTypeParameter(ttp) }, _) ->
+			List.exists (fun t -> not (is_dynamic { fexpr with etype = t } f)) (get_constraints ttp)
 		| _ -> false
 	in
 
@@ -68,8 +68,8 @@ let configure gen (is_dynamic:texpr->Type.tfield_access->bool) (change_expr:texp
 		(* class types *)
 		| TField(fexpr, f) when is_nondynamic_tparam fexpr f ->
 			(match follow fexpr.etype with
-				| TInst( ({ cl_kind = KTypeParameter(tl) } as tp_cl), tp_tl) ->
-					let t = apply_params tp_cl.cl_params tp_tl (List.find (fun t -> not (is_dynamic { fexpr with etype = t } f)) tl) in
+				| TInst( ({ cl_kind = KTypeParameter(ttp) } as tp_cl), tp_tl) ->
+					let t = apply_params tp_cl.cl_params tp_tl (List.find (fun t -> not (is_dynamic { fexpr with etype = t } f)) (get_constraints ttp)) in
 					{ e with eexpr = TField(mk_cast t (run fexpr), f) }
 				| _ -> Globals.die "" __LOC__)
 

+ 2 - 2
src/codegen/gencommon/enumToClass.ml

@@ -102,7 +102,7 @@ struct
 			| _ -> ());
 		let c_types =
 			if handle_type_params then
-				List.map (fun tp -> {tp with ttp_type=TInst (map_param (get_cl_t tp.ttp_type), [])}) en.e_params
+				List.map clone_param en.e_params
 			else
 				[]
 		in
@@ -120,7 +120,7 @@ struct
 				| TFun(params,ret) ->
 					let dup_types =
 						if handle_type_params then
-							List.map (fun tp -> {tp with ttp_type = TInst (map_param (get_cl_t tp.ttp_type), [])}) en.e_params
+							List.map clone_param en.e_params
 						else
 							[]
 					in

+ 5 - 2
src/codegen/gencommon/gencommon.ml

@@ -1137,11 +1137,14 @@ let mk_class_field ?(static = false) name t public pos kind params =
 (* this helper just duplicates the type parameter class, which is assumed that cl is. *)
 (* This is so we can use class parameters on function parameters, without running the risk of name clash *)
 (* between both *)
-let map_param cl =
+let clone_param ttp =
+	let cl = ttp.ttp_class in
 	let ret = mk_class cl.cl_module (fst cl.cl_path, snd cl.cl_path ^ "_c") cl.cl_pos null_pos in
 	ret.cl_implements <- cl.cl_implements;
 	ret.cl_kind <- cl.cl_kind;
-	ret
+	let ttp = mk_type_param ret ttp.ttp_default ttp.ttp_constraints in
+	ret.cl_kind <- KTypeParameter ttp;
+	ttp
 
 let get_cl_t t =
 	match follow t with | TInst (cl,_) -> cl | _ -> die "" __LOC__

+ 8 - 9
src/codegen/gencommon/overloadingConstructor.ml

@@ -113,16 +113,15 @@ let create_static_ctor com ~empty_ctor_expr cl ctor follow_type =
 	| false ->
 		let static_ctor_name = make_static_ctor_name cl in
 		(* create the static constructor *)
-		let ctor_types = List.map (fun tp -> {tp with ttp_type = TInst(map_param (get_cl_t tp.ttp_type), [])}) cl.cl_params in
+		let ctor_types = List.map clone_param cl.cl_params in
 		let ctor_type_params = extract_param_types ctor_types in
-		List.iter (function {ttp_type=TInst(c,[])} -> (
-			match c.cl_kind with
-			| KTypeParameter (hd :: tail) ->
-				let before = hd :: tail in
-				let after = List.map (apply_params cl.cl_params ctor_type_params) (before) in
-				c.cl_kind <- KTypeParameter(after)
-			| _ -> ())
-		| _ -> ()) ctor_types;
+		List.iter (fun ttp -> match get_constraints ttp with
+			| [] ->
+				()
+			| before ->
+				let after = List.map (apply_params cl.cl_params ctor_type_params) before in
+				ttp.ttp_constraints <- Some (lazy after)
+		) ctor_types;
 		let me = alloc_var "__hx_this" (TInst(cl, extract_param_types ctor_types)) in
 		add_var_flag me VCaptured;
 

+ 7 - 8
src/codegen/gencommon/realTypeParams.ml

@@ -308,10 +308,9 @@ let set_hxgeneric gen md =
 		if not ret then begin
 			match md with
 			| TClassDecl c ->
-				let set_hxgeneric tp = match follow tp.ttp_type with
-					| TInst(c,_) ->
-						c.cl_meta <- (Meta.NativeGeneric, [], c.cl_pos) :: c.cl_meta
-					| _ -> ()
+				let set_hxgeneric tp =
+					let c = tp.ttp_class in
+					c.cl_meta <- (Meta.NativeGeneric, [], c.cl_pos) :: c.cl_meta
 				in
 				List.iter set_hxgeneric c.cl_params;
 				let rec handle_field cf =
@@ -400,7 +399,7 @@ struct
 
 		let rec loop curcls params level reverse_params =
 			if (level <> 0 || (has_class_flag curcls CInterface) || (has_class_flag curcls CAbstract) ) && params <> [] && is_hxgeneric (TClassDecl curcls) then begin
-				let cparams = List.map (fun tp -> {tp with ttp_type=TInst (map_param (get_cl_t tp.ttp_type), [])}) curcls.cl_params in
+				let cparams = List.map clone_param curcls.cl_params in
 				let name = get_cast_name curcls in
 				if not (PMap.mem name cl.cl_fields) then begin
 					let reverse_params = List.map (apply_params curcls.cl_params params) reverse_params in
@@ -459,7 +458,7 @@ struct
 	let create_cast_cfield gen cl name =
 		reset_temps();
 		let basic = gen.gcon.basic in
-		let cparams = List.map (fun tp -> {tp with ttp_type = TInst (map_param (get_cl_t tp.ttp_type), [])}) cl.cl_params in
+		let cparams = List.map clone_param cl.cl_params in
 		let cfield = mk_class_field name (TFun([], t_dynamic)) false cl.cl_pos (Method MethNormal) cparams in
 		let params = extract_param_types cparams in
 
@@ -590,7 +589,7 @@ struct
 	let create_static_cast_cf gen iface cf =
 		let p = iface.cl_pos in
 		let basic = gen.gcon.basic in
-		let cparams = List.map (fun tp -> {tp with ttp_name = "To_" ^ tp.ttp_name;ttp_type = TInst (map_param (get_cl_t tp.ttp_type), [])}) cf.cf_params in
+		let cparams = List.map clone_param cf.cf_params in
 		let me_type = TInst(iface,[]) in
 		let cfield = mk_class_field ~static:true "__hx_cast" (TFun(["me",false,me_type], t_dynamic)) false iface.cl_pos (Method MethNormal) (cparams) in
 		let params = extract_param_types cparams in
@@ -637,7 +636,7 @@ struct
 		let implement_stub_cast cthis iface tl =
 			let name = get_cast_name iface in
 			if not (PMap.mem name cthis.cl_fields) then begin
-				let cparams = List.map (fun tp -> {tp with ttp_name = "To_" ^ tp.ttp_name;ttp_type = TInst(map_param (get_cl_t tp.ttp_type), [])}) iface.cl_params in
+				let cparams = List.map clone_param iface.cl_params in
 				let field = mk_class_field name (TFun([],t_dynamic)) false iface.cl_pos (Method MethNormal) cparams in
 				let this = { eexpr = TConst TThis; etype = TInst(cthis, extract_param_types cthis.cl_params); epos = cthis.cl_pos } in
 				field.cf_expr <- Some {

+ 4 - 10
src/codegen/gencommon/renameTypeParameters.ml

@@ -41,22 +41,16 @@ let run types =
 		end else found_types := PMap.add name true !found_types
 	in
 
-	let get_cls t =
-		match follow t with
-		| TInst(cl,_) -> cl
-		| _ -> Globals.die "" __LOC__
-	in
-
 	let iter_types tp =
-		let cls = get_cls tp.ttp_type in
+		let cls = tp.ttp_class in
 		let orig = cls.cl_path in
 		check_type (snd orig) (fun name -> cls.cl_path <- (fst orig, name))
 	in
 
 	let save_params save params =
 		List.fold_left (fun save tp ->
-			let cls = get_cls tp.ttp_type in
-			(cls.cl_path,tp.ttp_type) :: save) save params
+			let cls = tp.ttp_class in
+			(cls.cl_path,tp.ttp_class) :: save) save params
 	in
 
 	List.iter (function
@@ -82,7 +76,7 @@ let run types =
 				cl.cl_restore <- (fun () ->
 					res();
 					List.iter (fun (path,t) ->
-						let cls = get_cls t in
+						let cls = t in
 						cls.cl_path <- path) save
 				);
 			end

+ 3 - 6
src/codegen/overloads.ml

@@ -13,13 +13,10 @@ let same_overload_args ?(get_vmtype) t1 t2 f1 f2 =
 			| [],[] ->
 				true
 			| tp1 :: params1,tp2 :: params2 ->
-				let constraints_equal t1 t2 = match follow t1,follow t2 with
-					| TInst({cl_kind = KTypeParameter tl1},_),TInst({cl_kind = KTypeParameter tl2},_) ->
-						Ast.safe_for_all2 f_eq tl1 tl2
-					| _ ->
-						false
+				let constraints_equal ttp1 ttp2 = 
+					Ast.safe_for_all2 f_eq (get_constraints ttp2) (get_constraints ttp2)
 				in
-				tp1.ttp_name = tp2.ttp_name && constraints_equal tp1.ttp_type tp2.ttp_type && loop params1 params2
+				tp1.ttp_name = tp2.ttp_name && constraints_equal tp1 tp2 && loop params1 params2
 			| [],_
 			| _,[] ->
 				false

+ 4 - 3
src/context/abstractCast.ml

@@ -119,10 +119,11 @@ let prepare_array_access_field ctx a pl cf p =
 	let monos = List.map (fun _ -> spawn_monomorph ctx p) cf.cf_params in
 	let map t = apply_params a.a_params pl (apply_params cf.cf_params monos t) in
 	let check_constraints () =
-		List.iter2 (fun m tp -> match follow tp.ttp_type with
-			| TInst ({ cl_kind = KTypeParameter constr },_) when constr <> [] ->
+		List.iter2 (fun m ttp -> match get_constraints ttp with
+			| [] ->
+				()
+			| constr ->
 				List.iter (fun tc -> match follow m with TMono _ -> raise (Unify_error []) | _ -> Type.unify m (map tc) ) constr
-			| _ -> ()
 		) monos cf.cf_params;
 	in
 	let get_ta() =

+ 6 - 5
src/context/display/displayFields.ml

@@ -56,10 +56,11 @@ let collect_static_extensions ctx items e p =
 		| TFun((_,_,t) :: args, ret) ->
 			begin try
 				let e = TyperBase.unify_static_extension ctx {e with etype = dup e.etype} t p in
-				List.iter2 (fun m tp -> match follow tp.ttp_type with
-					| TInst ({ cl_kind = KTypeParameter constr },_) when constr <> [] ->
+				List.iter2 (fun m ttp -> match get_constraints ttp with
+					| [] ->
+						()
+					| constr ->
 						List.iter (fun tc -> unify_raise m (map tc) e.epos) constr
-					| _ -> ()
 				) monos f.cf_params;
 				if not (can_access ctx c f true) || follow e.etype == t_dynamic && follow t != t_dynamic then
 					acc
@@ -157,9 +158,9 @@ let collect ctx e_ast e dk with_type p =
 				List.fold_left fold_constraints items l
 			in
 			fold_constraints items (Monomorph.classify_down_constraints m)
-		| TInst ({cl_kind = KTypeParameter tl},_) ->
+		| TInst ({cl_kind = KTypeParameter ttp},_) ->
 			(* Type parameters can access the fields of their constraints *)
-			List.fold_left (fun acc t -> loop acc t) items tl
+			List.fold_left (fun acc t -> loop acc t) items (get_constraints ttp)
 		| TInst(c0,tl) ->
 			(* For classes, browse the hierarchy *)
 			let fields = TClass.get_all_fields c0 tl in

+ 2 - 4
src/context/display/displayToplevel.ml

@@ -449,10 +449,8 @@ let collect ctx tk with_type sort =
 	end;
 
 	(* type params *)
-	List.iter (fun tp -> match follow tp.ttp_type with
-		| TInst(c,_) ->
-			add (make_ci_type_param c (tpair tp.ttp_type)) (Some (snd c.cl_path))
-		| _ -> die "" __LOC__
+	List.iter (fun tp ->
+		add (make_ci_type_param tp.ttp_class (tpair tp.ttp_type)) (Some (snd tp.ttp_class.cl_path))
 	) ctx.type_params;
 
 	(* module types *)

+ 2 - 2
src/context/typecore.ml

@@ -616,8 +616,8 @@ let can_access ctx c cf stat =
 	loop c
 	(* access is also allowed of we access a type parameter which is constrained to our (base) class *)
 	|| (match c.cl_kind with
-		| KTypeParameter tl ->
-			List.exists (fun t -> match follow t with TInst(c,_) -> loop c | _ -> false) tl
+		| KTypeParameter ttp ->
+			List.exists (fun t -> match follow t with TInst(c,_) -> loop c | _ -> false) (get_constraints ttp)
 		| _ -> false)
 	|| (Meta.has Meta.PrivateAccess ctx.meta)
 

+ 6 - 8
src/core/display/completionItem.ml

@@ -223,16 +223,14 @@ module CompletionModuleType = struct
 		in
 		let is_extern,is_final,is_abstract,kind,ctor = ctor_info mt in
 		let infos = t_infos mt in
-		let convert_type_param tp = match follow tp.ttp_type with
-			| TInst(c,_) -> {
-				tp_name = tp.ttp_name,null_pos;
+		let convert_type_param ttp =
+			{
+				tp_name = ttp.ttp_name,null_pos;
 				tp_params = [];
 				tp_constraints = None; (* TODO? *)
 				tp_default = None; (* TODO? *)
-				tp_meta = c.cl_meta
+				tp_meta = ttp.ttp_class.cl_meta
 			}
-			| _ ->
-				die "" __LOC__
 		in
 		{
 			pack = fst infos.mt_path;
@@ -784,11 +782,11 @@ let to_json ctx index item =
 		| ITExpression e -> "Expression",generate_texpr ctx e
 		| ITTypeParameter c ->
 			begin match c.cl_kind with
-			| KTypeParameter tl ->
+			| KTypeParameter ttp ->
 				"TypeParameter",jobject [
 					"name",jstring (snd c.cl_path);
 					"meta",generate_metadata ctx c.cl_meta;
-					"constraints",jlist (generate_type ctx) tl;
+					"constraints",jlist (generate_type ctx) (get_constraints ttp);
 				]
 			| _ -> die "" __LOC__
 			end

+ 5 - 9
src/core/json/genjson.ml

@@ -276,15 +276,11 @@ and generate_type_path_with_params ctx mpath tpath tl meta =
 
 (* type parameter *)
 
-and generate_type_parameter ctx tp =
-	let generate_constraints () = match follow tp.ttp_type with
-		| TInst({cl_kind = KTypeParameter tl},_) -> generate_types ctx tl
-		| _ -> die "" __LOC__
-	in
+and generate_type_parameter ctx ttp =
 	jobject [
-		"name",jstring tp.ttp_name;
-		"constraints",generate_constraints ();
-		"defaultType",jopt (generate_type ctx) tp.ttp_default;
+		"name",jstring ttp.ttp_name;
+		"constraints",generate_types ctx (get_constraints ttp);
+		"defaultType",jopt (generate_type ctx) ttp.ttp_default;
 	]
 
 (* texpr *)
@@ -602,7 +598,7 @@ let generate_class ctx c =
 	let generate_class_kind ck =
 		let ctor,args = match ck with
 		| KNormal -> "KNormal",None
-		| KTypeParameter tl -> "KTypeParameter",Some (generate_types ctx tl)
+		| KTypeParameter ttp -> "KTypeParameter",Some (generate_types ctx (get_constraints ttp))
 		| KExpr e -> "KExpr",Some (generate_expr ctx e)
 		| KGeneric -> "KGeneric",None
 		| KGenericInstance(c,tl) -> "KGenericInstance",Some (generate_type_path_with_params ctx c.cl_module.m_path c.cl_path tl c.cl_meta)

+ 22 - 12
src/core/tFunctions.ml

@@ -373,15 +373,11 @@ let apply_params ?stack cparams params t =
 	let rec loop l1 l2 =
 		match l1, l2 with
 		| [] , [] -> []
-		| {ttp_type = TLazy f} as tp :: l1, _ -> loop ({tp with ttp_type = lazy_type f} :: l1) l2
-		| tp :: l1 , t2 :: l2 -> (tp.ttp_type,t2) :: loop l1 l2
+		| ttp :: l1 , t2 :: l2 -> (ttp.ttp_class,t2) :: loop l1 l2
 		| _ -> die "" __LOC__
 	in
 	let subst = loop cparams params in
 	let rec loop t =
-		try
-			List.assq t subst
-		with Not_found ->
 		match t with
 		| TMono r ->
 			(match r.tm_type with
@@ -444,6 +440,12 @@ let apply_params ?stack cparams params t =
 			(match tl with
 			| [] -> t
 			| _ -> TAbstract (a,List.map loop tl))
+		| TInst ({cl_kind = KTypeParameter _} as c,[]) ->
+			begin try
+				List.assq c subst
+			with Not_found ->
+				t
+			end
 		| TInst (c,tl) ->
 			(match tl with
 			| [] ->
@@ -653,9 +655,11 @@ let lookup_param n l =
 	in
 	loop l
 
-let mk_type_param n t def = {
-	ttp_name = n;
-	ttp_type = t;
+let mk_type_param c def constraints = {
+	ttp_name = snd c.cl_path;
+	ttp_type = TInst(c,[]);
+	ttp_class = c;
+	ttp_constraints = constraints;
 	ttp_default = def;
 }
 
@@ -687,13 +691,19 @@ let tconst_to_const = function
 	| TThis -> Ident "this"
 	| TSuper -> Ident "super"
 
+let get_constraints ttp = match ttp.ttp_constraints with
+	| None ->
+		[]
+	| Some r ->
+		Lazy.force r
+
 let has_ctor_constraint c = match c.cl_kind with
-	| KTypeParameter tl ->
+	| KTypeParameter ttp ->
 		List.exists (fun t -> match follow t with
 			| TAnon a when PMap.mem "new" a.a_fields -> true
 			| TAbstract({a_path=["haxe"],"Constructible"},_) -> true
 			| _ -> false
-		) tl;
+		) (get_constraints ttp);
 	| _ -> false
 
 (* ======= Field utility ======= *)
@@ -741,7 +751,7 @@ let rec raw_class_field build_type c tl i =
 			c2, apply_params c.cl_params tl t , f
 	with Not_found ->
 		match c.cl_kind with
-		| KTypeParameter tl ->
+		| KTypeParameter ttp ->
 			let rec loop = function
 				| [] ->
 					raise Not_found
@@ -762,7 +772,7 @@ let rec raw_class_field build_type c tl i =
 					| _ ->
 						loop ctl
 			in
-			loop tl
+			loop (get_constraints ttp)
 		| _ ->
 			if not (has_class_flag c CInterface) then raise Not_found;
 			(*

+ 13 - 15
src/core/tPrinting.ml

@@ -380,8 +380,8 @@ let s_types ?(sep = ", ") tl =
 let s_class_kind = function
 	| KNormal ->
 		"KNormal"
-	| KTypeParameter tl ->
-		Printf.sprintf "KTypeParameter [%s]" (s_types tl)
+	| KTypeParameter ttp ->
+		Printf.sprintf "KTypeParameter [%s]" (s_types (get_constraints ttp))
 	| KExpr _ ->
 		"KExpr"
 	| KGeneric ->
@@ -441,19 +441,17 @@ module Printer = struct
 	let s_metadata metadata =
 		s_list " " s_metadata_entry metadata
 
-	let s_type_param tp = match follow tp.ttp_type with
-		| TInst({cl_kind = KTypeParameter tl1},tl2) ->
-			let s = match tl1 with
-				| [] -> tp.ttp_name
-				| _ -> Printf.sprintf "%s:%s" tp.ttp_name (String.concat " & " (List.map s_type tl1))
-			in
-			begin match tp.ttp_default with
-			| None ->
-				s
-			| Some t ->
-				Printf.sprintf "%s = %s" s (s_type t)
-			end
-		| _ -> die "" __LOC__
+	let s_type_param ttp = 
+		let s = match (get_constraints ttp) with
+			| [] -> ttp.ttp_name
+			| tl1 -> Printf.sprintf "%s:%s" ttp.ttp_name (String.concat " & " (List.map s_type tl1))
+		in
+		begin match ttp.ttp_default with
+		| None ->
+			s
+		| Some t ->
+			Printf.sprintf "%s = %s" s (s_type t)
+		end
 
 	let s_type_params tl =
 		s_list ", " s_type_param tl

+ 3 - 1
src/core/tType.ml

@@ -93,6 +93,8 @@ and tparams = t list
 and typed_type_param = {
 	ttp_name : string;
 	ttp_type : t;
+	ttp_class : tclass;
+	mutable ttp_constraints : t list Lazy.t option;
 	ttp_default : t option;
 }
 
@@ -232,7 +234,7 @@ and tclass_field = {
 
 and tclass_kind =
 	| KNormal
-	| KTypeParameter of t list
+	| KTypeParameter of typed_type_param
 	| KExpr of Ast.expr
 	| KGeneric
 	| KGenericInstance of tclass * tparams

+ 19 - 18
src/core/tUnification.ml

@@ -260,13 +260,13 @@ module Monomorph = struct
 
 	let spawn_constrained_monos map params =
 		let checks = DynArray.create () in
-		let monos = List.map (fun tp ->
+		let monos = List.map (fun ttp ->
 			let mono = create () in
-			begin match follow tp.ttp_type with
-				| TInst ({ cl_kind = KTypeParameter constr; cl_path = path },_) when constr <> [] ->
-					DynArray.add checks (mono,constr,s_type_path path)
-				| _ ->
+			begin match get_constraints ttp with
+				| [] ->
 					()
+				| constr ->
+					DynArray.add checks (mono,constr,s_type_path ttp.ttp_class.cl_path)
 			end;
 			TMono mono
 		) params in
@@ -695,12 +695,13 @@ let rec unify (uctx : unification_context) a b =
 				loop cs (List.map (apply_params c.cl_params tl) tls)
 			) c.cl_implements
 			|| (match c.cl_kind with
-			| KTypeParameter pl -> List.exists (fun t ->
-				match follow t with
-				| TInst (cs,tls) -> loop cs (List.map (apply_params c.cl_params tl) tls)
-				| TAbstract(aa,tl) -> unifies_to uctx a b aa tl
-				| _ -> false
-			) pl
+			| KTypeParameter ttp ->
+				List.exists (fun t ->
+					match follow t with
+					| TInst (cs,tls) -> loop cs (List.map (apply_params c.cl_params tl) tls)
+					| TAbstract(aa,tl) -> unifies_to uctx a b aa tl
+					| _ -> false
+				) (get_constraints ttp)
 			| _ -> false)
 		in
 		if not (loop c1 tl1) then error [cannot_unify a b]
@@ -722,9 +723,9 @@ let rec unify (uctx : unification_context) a b =
 				error (cannot_unify a b :: msg :: l))
 	| TInst (c,tl) , TAnon an ->
 		if PMap.is_empty an.a_fields then (match c.cl_kind with
-			| KTypeParameter pl ->
+			| KTypeParameter ttp ->
 				(* one of the constraints must unify with { } *)
-				if not (List.exists (fun t -> match follow t with TInst _ | TAnon _ -> true | _ -> false) pl) then error [cannot_unify a b]
+				if not (List.exists (fun t -> match follow t with TInst _ | TAnon _ -> true | _ -> false) (get_constraints ttp)) then error [cannot_unify a b]
 			| _ -> ());
 		ignore(c.cl_build());
 		(try
@@ -824,9 +825,9 @@ let rec unify (uctx : unification_context) a b =
 	| TInst(c,tl),TAbstract({a_path = ["haxe"],"Constructible"},[t1]) ->
 		begin try
 			begin match c.cl_kind with
-				| KTypeParameter tl ->
+				| KTypeParameter ttp ->
 					(* type parameters require an equal Constructible constraint *)
-					if not (List.exists (fun t -> match follow t with TAbstract({a_path = ["haxe"],"Constructible"},[t2]) -> type_iseq uctx t1 t2 | _ -> false) tl) then error [cannot_unify a b]
+					if not (List.exists (fun t -> match follow t with TAbstract({a_path = ["haxe"],"Constructible"},[t2]) -> type_iseq uctx t1 t2 | _ -> false) (get_constraints ttp)) then error [cannot_unify a b]
 				| _ ->
 					let _,t,cf = class_field c tl "new" in
 					if not (has_class_field_flag cf CfPublic) then error [invalid_visibility "new"];
@@ -884,12 +885,12 @@ let rec unify (uctx : unification_context) a b =
 		end
 	| TAbstract (aa,tl), _  ->
 		unify_to uctx a b aa tl
-	| TInst ({ cl_kind = KTypeParameter ctl } as c,pl), TAbstract (bb,tl) ->
+	| TInst ({ cl_kind = KTypeParameter ttp } as c,pl), TAbstract (bb,tl) ->
 		(* one of the constraints must satisfy the abstract *)
 		if not (List.exists (fun t ->
 			let t = apply_params c.cl_params pl t in
 			try unify uctx t b; true with Unify_error _ -> false
-		) ctl) then unify_from uctx a b bb tl
+		) (get_constraints ttp)) then unify_from uctx a b bb tl
 	| _, TAbstract (bb,tl) ->
 		unify_from uctx a b bb tl
 	| _ , _ ->
@@ -1136,7 +1137,7 @@ module UnifyMinT = struct
 		let rec loop t = (match t with
 			| TInst(cl, params) ->
 				(match cl.cl_kind with
-				| KTypeParameter tl -> List.iter loop tl
+				| KTypeParameter ttp -> List.iter loop (get_constraints ttp)
 				| _ -> ());
 				List.iter (fun (ic, ip) ->
 					let t = apply_params cl.cl_params params (TInst (ic,ip)) in

+ 2 - 5
src/filters/filtersCommon.ml

@@ -27,11 +27,8 @@ let rec is_removable_class c =
 		(match c.cl_super with
 			| Some (c,_) -> is_removable_class c
 			| _ -> false) ||
-		List.exists (fun tp -> match follow tp.ttp_type with
-			| TInst(c,_) ->
-				has_ctor_constraint c || Meta.has Meta.Const c.cl_meta
-			| _ ->
-				false
+		List.exists (fun tp ->
+			has_ctor_constraint tp.ttp_class || Meta.has Meta.Const tp.ttp_class.cl_meta
 		) c.cl_params)
 	| KTypeParameter _ ->
 		(* this shouldn't happen, have to investigate (see #4092) *)

+ 5 - 6
src/generators/gencs.ml

@@ -2009,18 +2009,17 @@ let generate con =
 			let hxgen = is_hxgen (TClassDecl cl) in
 			match cl_params with
 				| (_ :: _) when not (erase_generics && is_hxgeneric (TClassDecl cl)) ->
-					let get_param_name t = match follow t with TInst(cl, _) -> snd cl.cl_path | _ -> die "" __LOC__ in
 					let combination_error c1 c2 =
 						gen.gcon.error ("The " ^ (get_constraint c1) ^ " constraint cannot be combined with the " ^ (get_constraint c2) ^ " constraint.") cl.cl_pos in
 
-					let params = sprintf "<%s>" (String.concat ", " (List.map (fun tp -> get_param_name tp.ttp_type) cl_params)) in
+					let params = sprintf "<%s>" (String.concat ", " (List.map (fun tp -> snd tp.ttp_class.cl_path) cl_params)) in
 					let params_extends =
 						if hxgen || not (Meta.has (Meta.NativeGen) cl.cl_meta) then
 							[""]
 						else
 							List.fold_left (fun acc {ttp_name=name;ttp_type=t} ->
-								match run_follow gen t with
-									| TInst({cl_kind = KTypeParameter constraints}, _) when constraints <> [] ->
+								match t with
+									| TInst({cl_kind = KTypeParameter ttp} as c,_) when get_constraints ttp <> [] ->
 										(* base class should come before interface constraints *)
 										let base_class_constraints = ref [] in
 										let other_constraints = List.fold_left (fun acc t ->
@@ -2069,7 +2068,7 @@ let generate con =
 												(* skip anything other *)
 												| _ ->
 													acc
-										) [] constraints in
+										) [] (get_constraints ttp ) in
 
 										let s_constraints = (List.sort
 											(* C# expects some ordering for built-in constraints: *)
@@ -2085,7 +2084,7 @@ let generate con =
 										) (!base_class_constraints @ other_constraints)) in
 
 										if s_constraints <> [] then
-											(sprintf " where %s : %s" (get_param_name t) (String.concat ", " (List.map get_constraint s_constraints)) :: acc)
+											(sprintf " where %s : %s" (snd c.cl_path) (String.concat ", " (List.map get_constraint s_constraints)) :: acc)
 										else
 											acc;
 									| _ -> acc

+ 5 - 5
src/generators/genhl.ml

@@ -361,7 +361,7 @@ let make_debug ctx arr =
 let fake_tnull =
 	{null_abstract with
 		a_path = [],"Null";
-		a_params = [{ttp_name = "T"; ttp_type = t_dynamic; ttp_default = None}];
+		a_params = [mk_type_param null_class None None];
 	}
 
 let get_rec_cache ctx t none_callback not_found_callback =
@@ -435,7 +435,7 @@ let rec to_type ?tref ctx t =
 		HAbstract (name, alloc_string ctx name)
 	| TInst (c,pl) ->
 		(match c.cl_kind with
-		| KTypeParameter tl ->
+		| KTypeParameter ttp ->
 			let rec loop = function
 				| [] -> HDyn
 				| t :: tl ->
@@ -443,7 +443,7 @@ let rec to_type ?tref ctx t =
 					| TInst (c,_) as t when not (has_class_flag c CInterface) -> to_type ?tref ctx t
 					| _ -> loop tl
 			in
-			loop tl
+			loop (get_constraints ttp)
 		| _ -> class_type ~tref ctx c pl false)
 	| TAbstract ({a_path = [],"Null"},[t1]) ->
 		let t = to_type ?tref ctx t1 in
@@ -2173,9 +2173,9 @@ and eval_expr ctx e =
 				match follow t with
 				| TFun (_,rt) ->
 					(match follow rt with
-					| TInst({ cl_kind = KTypeParameter tl },_) ->
+					| TInst({ cl_kind = KTypeParameter ttp },_) ->
 						(* don't allow if we have a constraint virtual, see hxbit.Serializer.getRef *)
-						not (List.exists (fun t -> match to_type ctx t with HVirtual _ -> true | _ -> false) tl)
+						not (List.exists (fun t -> match to_type ctx t with HVirtual _ -> true | _ -> false) (get_constraints ttp))
 					| _ -> false)
 				| _ ->
 					false

+ 2 - 11
src/generators/genjava.ml

@@ -1904,17 +1904,8 @@ let generate con =
 			| [] ->
 				("","")
 			| _ ->
-				let params = sprintf "<%s>" (String.concat ", " (List.map (fun tp -> match follow tp.ttp_type with | TInst(cl, _) -> snd cl.cl_path | _ -> die "" __LOC__) cl_params)) in
-				let params_extends = List.fold_left (fun acc {ttp_name=name;ttp_type=t} ->
-					match run_follow gen t with
-						| TInst (cl, p) ->
-							(match cl.cl_implements with
-								| [] -> acc
-								| _ -> acc) (* TODO
-								| _ -> (sprintf " where %s : %s" name (String.concat ", " (List.map (fun (cl,p) -> path_param_s (TClassDecl cl) cl.cl_path p) cl.cl_implements))) :: acc ) *)
-						| _ -> trace (t_s null_pos t); die "" __LOC__ (* FIXME it seems that a cl_params will never be anything other than cl.cl_params. I'll take the risk and fail if not, just to see if that confirms *)
-				) [] cl_params in
-				(params, String.concat " " params_extends)
+				let params = sprintf "<%s>" (String.concat ", " (List.map (fun tp -> snd tp.ttp_class.cl_path) cl_params)) in
+				(params, "")
 	in
 
 	let write_parts w parts =

+ 10 - 12
src/generators/genjvm.ml

@@ -202,8 +202,11 @@ let rec jsignature_of_type gctx stack t =
 		TObject((["haxe";"root"],"Array"),[TType(WNone,t)])
 	| TInst({cl_path = (["java"],"NativeArray")},[t]) ->
 		TArray(jsignature_of_type t,None)
-	| TInst({cl_kind = KTypeParameter [t]},_) when t != t_dynamic -> jsignature_of_type t
-	| TInst({cl_kind = KTypeParameter _; cl_path = (_,name)},_) -> TTypeParameter name
+	| TInst({cl_kind = KTypeParameter ttp; cl_path = (_,name)},_) ->
+		begin match get_constraints ttp with
+			| [t] when t != t_dynamic -> jsignature_of_type t
+			| _ -> TTypeParameter name
+		end
 	| TInst({cl_path = ["_Class"],"Class_Impl_"},_) -> java_class_sig
 	| TInst({cl_path = ["_Enum"],"Enum_Impl_"},_) -> java_class_sig
 	| TInst(c,tl) -> TObject(c.cl_path,List.map jtype_argument_of_type tl)
@@ -2640,16 +2643,11 @@ class tclass_to_jvm gctx c = object(self)
 		end
 
 	method private generate_signature =
-		jc#set_type_parameters (List.map (fun tp ->
-			let jsigs = match follow tp.ttp_type with
-			| TInst({cl_kind = KTypeParameter tl},_) ->
-				List.map (fun t ->
-					get_boxed_type (jsignature_of_type gctx t)
-				 ) tl
-			| _ ->
-				[]
-			in
-			(tp.ttp_name,jsigs)
+		jc#set_type_parameters (List.map (fun ttp ->
+			let jsigs = List.map (fun t ->
+				get_boxed_type (jsignature_of_type gctx t)
+			) (get_constraints ttp) in
+			(ttp.ttp_name,jsigs)
 		) c.cl_params);
 		match c.cl_super with
 			| Some(c,tl) -> jc#set_super_parameters (List.map (jtype_argument_of_type gctx []) tl)

+ 1 - 1
src/generators/genlua.ml

@@ -281,7 +281,7 @@ let mk_mr_select com e ecall name =
 (* from genphp *)
 let rec is_string_type t =
     match follow t with
-    | TInst ({cl_kind = KTypeParameter constraints}, _) -> List.exists is_string_type constraints
+    | TInst ({cl_kind = KTypeParameter ttp}, _) -> List.exists is_string_type (get_constraints ttp)
     | TInst ({cl_path = ([], "String")}, _) -> true
     | TAnon a ->
         (match !(a.a_status) with

+ 1 - 3
src/generators/genswf.ml

@@ -149,9 +149,7 @@ let build_dependencies t =
 		| Some x -> add_inherit x);
 		List.iter (fun tp ->
 			(* add type-parameters constraints dependencies *)
-			match follow tp.ttp_type with
-			| TInst (c,_) -> List.iter add_inherit c.cl_implements
-			| _ -> ()
+			List.iter add_inherit tp.ttp_class.cl_implements
 		) c.cl_params;
 		List.iter add_inherit c.cl_implements;
 	| TEnumDecl e when not e.e_extern ->

+ 2 - 2
src/generators/genswf9.ml

@@ -238,8 +238,8 @@ let rec type_id ctx t =
 		| _ -> def())
 	| TInst (c,_) ->
 		(match c.cl_kind with
-		| KTypeParameter l ->
-			(match l with
+		| KTypeParameter ttp ->
+			(match get_constraints ttp with
 			| [t] -> type_id ctx t
 			| _ -> type_path ctx ([],"Object"))
 		| _ ->

+ 6 - 36
src/macro/macroApi.ml

@@ -1143,7 +1143,7 @@ and encode_method_kind m =
 and encode_class_kind k =
 	let tag, pl = (match k with
 		| KNormal -> 0, []
-		| KTypeParameter pl -> 1, [encode_tparams pl]
+		| KTypeParameter ttp -> 1, [encode_tparams (get_constraints ttp)] (* TTPTODO *)
 		| KModuleFields m -> 2, [encode_string (s_type_path m.m_path)]
 		| KExpr e -> 3, [encode_expr e]
 		| KGeneric -> 4, []
@@ -1443,14 +1443,6 @@ let decode_tconst c =
 	| 6, [] -> TSuper
 	| _ -> raise Invalid_expr
 
-let decode_type_params v =
-	List.map (fun v ->
-		let name = decode_string (field v "name") in
-		let t = decode_type (field v "t") in
-		let default = opt decode_type (field v "defaultType") in
-		mk_type_param name t default
-	) (decode_array v)
-
 let decode_tvar v =
 	(Obj.obj (decode_unsafe (field v "$")) : tvar)
 
@@ -1479,31 +1471,6 @@ let decode_field_kind v =
 	| 1, [m] -> Method (decode_method_kind m)
 	| _ -> raise Invalid_expr
 
-let decode_cfield v =
-	let public = decode_bool (field v "isPublic") in
-	let extern = decode_bool (field v "isExtern") in
-	let final = decode_bool (field v "isFinal") in
-	let abstract = decode_bool (field v "isAbstract") in
-	let cf = {
-		cf_name = decode_string (field v "name");
-		cf_type = decode_type (field v "type");
-		cf_pos = decode_pos (field v "pos");
-		cf_name_pos = decode_pos (field v "namePos");
-		cf_doc = decode_doc (field v "doc");
-		cf_meta = []; (* TODO *)
-		cf_kind = decode_field_kind (field v "kind");
-		cf_params = decode_type_params (field v "params");
-		cf_expr = None;
-		cf_expr_unoptimized = None;
-		cf_overloads = decode_ref (field v "overloads");
-		cf_flags = 0;
-	} in
-	if public then add_class_field_flag cf CfPublic;
-	if extern then add_class_field_flag cf CfExtern;
-	if final then add_class_field_flag cf CfFinal;
-	if abstract then add_class_field_flag cf CfAbstract;
-	cf
-
 let decode_efield v =
 	let rec get_enum t =
 		match follow t with
@@ -2304,10 +2271,13 @@ let macro_api ccom get_api =
 		"apply_params", vfun3 (fun tpl tl t ->
 			let tl = List.map decode_type (decode_array tl) in
 			let tpl = List.map (fun v ->
-				let name = decode_string (field v "name") in
 				let t = decode_type (field v "t") in
 				let default = None in (* we don't care here *)
-				mk_type_param  name t default
+				let c = match t with
+					| TInst(c,_) -> c
+					| _ -> die "" __LOC__
+				in				
+				mk_type_param c default None
 			) (decode_array tpl) in
 			let rec map t = match t with
 				| TInst({cl_kind = KTypeParameter _},_) ->

+ 4 - 4
src/optimization/dce.ml

@@ -247,10 +247,10 @@ and mark_t dce p t =
 	if not (List.exists (fun t2 -> Type.fast_eq t t2) dce.t_stack) then begin
 		dce.t_stack <- t :: dce.t_stack;
 		begin match follow t with
-		| TInst({cl_kind = KTypeParameter tl} as c,pl) ->
+		| TInst({cl_kind = KTypeParameter ttp} as c,pl) ->
 			if not (Meta.has Meta.Used c.cl_meta) then begin
 				c.cl_meta <- (mk_used_meta c.cl_pos) :: c.cl_meta;
-				List.iter (mark_t dce p) tl;
+				List.iter (mark_t dce p) (get_constraints ttp);
 			end;
 			List.iter (mark_t dce p) pl
 		| TInst(c,pl) ->
@@ -358,7 +358,7 @@ and field dce c n kind =
 		end else match c.cl_super with Some (csup,_) -> field dce csup n kind | None -> raise Not_found
 	with Not_found -> try
 		match c.cl_kind with
-		| KTypeParameter tl ->
+		| KTypeParameter ttp ->
 			let rec loop tl = match tl with
 				| [] -> raise Not_found
 				| TInst(c,_) :: cl ->
@@ -366,7 +366,7 @@ and field dce c n kind =
 				| t :: tl ->
 					loop tl
 			in
-			loop tl
+			loop (get_constraints ttp)
 		| _ -> raise Not_found
 	with Not_found ->
 		if dce.debug then prerr_endline ("[DCE] Field " ^ n ^ " not found on " ^ (s_type_path c.cl_path)) else ())

+ 1 - 1
src/optimization/inline.ml

@@ -234,7 +234,7 @@ let inline_default_config cf t =
 			c.cl_params @ ct, pl @ cpl
 	in
 	let rec loop t = match follow t with
-		| TInst({cl_kind = KTypeParameter tl},_) -> List.fold_left (fun (params',tl') (params,tl) -> (params @ params',tl @ tl')) ([],[]) (List.map loop tl)
+		| TInst({cl_kind = KTypeParameter ttp},_) -> List.fold_left (fun (params',tl') (params,tl) -> (params @ params',tl @ tl')) ([],[]) (List.map loop (get_constraints ttp))
 		| TInst (c,pl) -> get_params c pl
 		| _ -> ([],[])
 	in

+ 2 - 2
src/typing/fields.ml

@@ -319,11 +319,11 @@ let type_field cfg ctx e i p mode (with_type : WithType.t) =
 				snd (class_field_with_access e c tl)
 			with Not_found -> try
 				match c.cl_kind with
-				| KTypeParameter tl ->
+				| KTypeParameter ttp ->
 					type_field_by_list (fun t -> match follow t with
 						| TAbstract _ -> type_field_by_e type_field_by_type (mk_cast e t p);
 						| _ -> raise Not_found
-					) tl
+					) (get_constraints ttp)
 				| _ -> raise Not_found
 			with Not_found ->
 				type_field_by_interfaces e c

+ 16 - 19
src/typing/generic.ml

@@ -62,7 +62,7 @@ let make_generic ctx ps pt debug p =
 	let rec loop acc_name acc_subst ttpl tl = match ttpl,tl with
 		| ttp :: ttpl,t :: tl ->
 			let name,t = try process t with Exit -> raise_typing_error ("Could not determine type for parameter " ^ ttp.ttp_name) p in
-			loop (name :: acc_name) ((follow ttp.ttp_type,t) :: acc_subst) ttpl tl
+			loop (name :: acc_name) ((ttp.ttp_type,t) :: acc_subst) ttpl tl
 		| [],[] ->
 			let name = String.concat "_" (List.rev acc_name) in
 			name,acc_subst
@@ -239,8 +239,9 @@ let build_generic_class ctx c p tl =
 		| TInst (c2,tl) ->
 			(match c2.cl_kind with
 			| KTypeParameter tl ->
-				if not (TypeloadCheck.is_generic_parameter ctx c2) && has_ctor_constraint c2 then
-					raise_typing_error "Type parameters with a constructor cannot be used non-generically" p;
+				(* TPTODO *)
+				(* if not (TypeloadCheck.is_generic_parameter ctx c2) && has_ctor_constraint c2 then
+					raise_typing_error "Type parameters with a constructor cannot be used non-generically" p; *)
 				recurse := true
 			| _ -> ());
 			List.iter check_recursive tl;
@@ -306,24 +307,20 @@ let build_generic_class ctx c p tl =
 		add_dependency ctx.m.curmod mg;
 		set_type_parameter_dependencies mg tl;
 		let build_field cf_old =
-			(* We have to clone the type parameters (issue #4672). We cannot substitute the constraints immediately because
-			   we need the full substitution list first. *)
-			let param_subst,params = List.fold_left (fun (subst,params) tp -> match follow tp.ttp_type with
-				| TInst(c,tl) as t ->
-					let t2 = TInst({c with cl_module = mg;},tl) in
-					(t,(t2,None)) :: subst,({tp with ttp_type=t2}) :: params
-				| _ -> die "" __LOC__
-			) ([],[]) cf_old.cf_params in
+			let params = List.map (fun ttp ->
+				let c = {ttp.ttp_class with cl_module = mg} in
+				let def = Option.map (generic_substitute_type gctx) ttp.ttp_default in
+				let constraints = match ttp.ttp_constraints with
+					| None -> None
+					| Some constraints -> Some (lazy (List.map (generic_substitute_type gctx) (Lazy.force constraints)))
+				in
+				let ttp' = mk_type_param c def constraints in
+				(ttp.ttp_type,ttp')
+			) cf_old.cf_params in
+			let param_subst = List.map (fun (t,ttp) -> t,(ttp.ttp_type,None)) params in
 			let gctx = {gctx with subst = param_subst @ gctx.subst} in
 			let cf_new = {cf_old with cf_pos = cf_old.cf_pos; cf_expr_unoptimized = None} in (* copy *)
-			(* Type parameter constraints are substituted here. *)
-			cf_new.cf_params <- List.rev_map (fun tp -> match follow tp.ttp_type with
-				| TInst({cl_kind = KTypeParameter tl1} as c,_) ->
-					let tl1 = List.map (generic_substitute_type gctx) tl1 in
-					c.cl_kind <- KTypeParameter tl1;
-					tp (* TPTODO: weird mapping *)
-				| _ -> die "" __LOC__
-			) params;
+			cf_new.cf_params <- List.map (fun (_,ttp) -> ttp) params;
 			let f () =
 				ignore(follow cf_old.cf_type);
 				(* We update here because the follow could resolve some TLazy things that end up modifying flags, such as

+ 2 - 2
src/typing/operators.ml

@@ -118,9 +118,9 @@ let rec classify t =
 	| TAbstract ({ a_path = [],"Int" },[]) -> KInt
 	| TAbstract ({ a_path = [],"Float" },[]) -> KFloat
 	| TAbstract (a,[]) when List.exists (fun t -> match classify t with KInt | KFloat -> true | _ -> false) a.a_to -> KNumParam t
-	| TInst ({ cl_kind = KTypeParameter ctl },_) when List.exists (fun t -> match classify t with KInt | KFloat -> true | _ -> false) ctl -> KNumParam t
+	| TInst ({ cl_kind = KTypeParameter ttp },_) when List.exists (fun t -> match classify t with KInt | KFloat -> true | _ -> false) (get_constraints ttp) -> KNumParam t
 	| TAbstract (a,[]) when List.exists (fun t -> match classify t with KString -> true | _ -> false) a.a_to -> KStrParam t
-	| TInst ({ cl_kind = KTypeParameter ctl },_) when List.exists (fun t -> match classify t with KString -> true | _ -> false) ctl -> KStrParam t
+	| TInst ({ cl_kind = KTypeParameter ttp },_) when List.exists (fun t -> match classify t with KString -> true | _ -> false) (get_constraints ttp) -> KStrParam t
 	| TMono r when r.tm_type = None -> KUnk
 	| TDynamic _ -> KDyn
 	| _ -> KOther

+ 65 - 71
src/typing/typeload.ml

@@ -286,28 +286,24 @@ let make_extension_type ctx tl =
 	let ta = mk_anon ~fields (ref (Extend tl)) in
 	ta
 
-let check_param_constraints ctx t map c p =
-	match follow t with
-	| TMono _ -> ()
-	| _ ->
-		let ctl = (match c.cl_kind with KTypeParameter l -> l | _ -> []) in
-		List.iter (fun ti ->
-			let ti = map ti in
-			try
-				unify_raise t ti p
-			with Error ({ err_message = Unify l } as err) ->
-				let fail() =
-					if not ctx.untyped then display_error_ext ctx.com { err with err_message = (Unify (Constraint_failure (s_type_path c.cl_path) :: l)) }
-				in
-				match follow t with
-				| TInst({cl_kind = KExpr e},_) ->
-					let e = type_expr {ctx with locals = PMap.empty} e (WithType.with_type ti) in
-					begin try unify_raise e.etype ti p
-					with Error { err_message = Unify _ } -> fail() end
-				| _ ->
-					fail()
+let check_param_constraints ctx t map ttp p =
+	List.iter (fun ti ->
+		let ti = map ti in
+		try
+			unify_raise t ti p
+		with Error ({ err_message = Unify l } as err) ->
+			let fail() =
+				if not ctx.untyped then display_error_ext ctx.com { err with err_message = (Unify (Constraint_failure (s_type_path ttp.ttp_class.cl_path) :: l)) }
+			in
+			match follow t with
+			| TInst({cl_kind = KExpr e},_) ->
+				let e = type_expr {ctx with locals = PMap.empty} e (WithType.with_type ti) in
+				begin try unify_raise e.etype ti p
+				with Error { err_message = Unify _ } -> fail() end
+			| _ ->
+				fail()
 
-		) ctl
+	) (get_constraints ttp)
 
 type load_instance_param_mode =
 	| ParamNormal
@@ -357,7 +353,8 @@ let rec load_params ctx info params p =
 	in
 	let checks = DynArray.create () in
 	let rec loop tl1 tl2 is_rest = match tl1,tl2 with
-		| t :: tl1,({ttp_name=name;ttp_type=t2}) :: tl2 ->
+		| t :: tl1,ttp:: tl2 ->
+			let name = ttp.ttp_name in
 			let t,pt = load_param t in
 			let check_const c =
 				let is_expression = (match t with TInst ({ cl_kind = KExpr _ },_) -> true | _ -> false) in
@@ -370,15 +367,14 @@ let rec load_params ctx info params p =
 					raise_typing_error "Type parameter is expected to be a constant value" p
 			in
 			let is_rest = is_rest || name = "Rest" && info.build_kind = BuildGenericBuild in
-			let t = match follow t2 with
-				| TInst ({ cl_kind = KTypeParameter [] } as c, []) when (match info.build_kind with BuildGeneric _ -> false | _ -> true) ->
-					check_const c;
+			let t = match ttp.ttp_constraints with
+				| None when (match info.build_kind with BuildGeneric _ -> false | _ -> true) ->
+					check_const ttp.ttp_class;
 					t
-				| TInst (c,[]) ->
-					check_const c;
-					DynArray.add checks (t,c,pt);
+				| _ ->
+					check_const ttp.ttp_class;
+					DynArray.add checks (t,ttp,pt);
 					t
-				| _ -> die "" __LOC__
 			in
 			t :: loop tl1 tl2 is_rest
 		| [],[] ->
@@ -753,7 +749,6 @@ let rec type_type_param ctx host path get_params p tp =
 	let n = fst tp.tp_name in
 	let c = mk_class ctx.m.curmod (fst path @ [snd path],n) (pos tp.tp_name) (pos tp.tp_name) in
 	c.cl_params <- type_type_params ctx host c.cl_path get_params p tp.tp_params;
-	c.cl_kind <- KTypeParameter [];
 	c.cl_meta <- tp.Ast.tp_meta;
 	if host = TPHEnumConstructor then c.cl_meta <- (Meta.EnumConstructorParam,[],null_pos) :: c.cl_meta;
 	let t = TInst (c,extract_param_types c.cl_params) in
@@ -777,32 +772,36 @@ let rec type_type_param ctx host path get_params p tp =
 			) "default" in
 			Some (TLazy r)
 	in
-	match tp.tp_constraints with
-	| None ->
-		mk_type_param n t default
-	| Some th ->
-		let r = make_lazy ctx t (fun r ->
-			let ctx = { ctx with type_params = ctx.type_params @ get_params() } in
-			let rec loop th = match fst th with
-				| CTIntersection tl -> List.map (load_complex_type ctx true) tl
-				| CTParent ct -> loop ct
-				| _ -> [load_complex_type ctx true th]
-			in
-			let constr = loop th in
-			(* check against direct recursion *)
-			let rec loop t =
-				match follow t with
-				| TInst (c2,_) when c == c2 -> raise_typing_error "Recursive constraint parameter is not allowed" p
-				| TInst ({ cl_kind = KTypeParameter cl },_) ->
-					List.iter loop cl
-				| _ ->
-					()
-			in
-			List.iter loop constr;
-			c.cl_kind <- KTypeParameter constr;
-			t
-		) "constraint" in
-		mk_type_param n (TLazy r) default
+	let ttp = match tp.tp_constraints with
+		| None ->
+			mk_type_param c default None
+		| Some th ->
+			let constraints = lazy (
+				let ctx = { ctx with type_params = ctx.type_params @ get_params() } in
+				let rec loop th = match fst th with
+					| CTIntersection tl -> List.map (load_complex_type ctx true) tl
+					| CTParent ct -> loop ct
+					| _ -> [load_complex_type ctx true th]
+				in
+				let constr = loop th in
+				(* check against direct recursion *)
+				let rec loop t =
+					match follow t with
+					| TInst (c2,_) when c == c2 ->
+						raise_typing_error "Recursive constraint parameter is not allowed" p
+					| TInst ({ cl_kind = KTypeParameter ttp },_) ->
+						List.iter loop (get_constraints ttp)
+					| _ ->
+						()
+				in
+				List.iter loop constr;
+				constr
+			) in
+			delay ctx PConnectField (fun () -> ignore (Lazy.force constraints));
+			mk_type_param c default (Some constraints)
+	in
+	c.cl_kind <- KTypeParameter ttp;
+	ttp
 
 and type_type_params ctx host path get_params p tpl =
 	let names = ref [] in
@@ -845,21 +844,16 @@ let load_core_class ctx c =
 let init_core_api ctx c =
 	let ccore = load_core_class ctx c in
 	begin try
-		List.iter2 (fun tp1 tp2 -> match follow tp1.ttp_type, follow tp2.ttp_type with
-			| TInst({cl_kind = KTypeParameter l1},_),TInst({cl_kind = KTypeParameter l2},_) ->
-				begin try
-					List.iter2 (fun t1 t2 -> type_eq EqCoreType t2 t1) l1 l2
-				with
-					| Invalid_argument _ ->
-						raise_typing_error "Type parameters must have the same number of constraints as core type" c.cl_pos
-					| Unify_error l ->
-						(* TODO send as one call with sub errors *)
-						display_error ctx.com ("Type parameter " ^ tp2.ttp_name ^ " has different constraint than in core type") c.cl_pos;
-						display_error ctx.com (error_msg (Unify l)) c.cl_pos;
-				end
-			| t1,t2 ->
-				Printf.printf "%s %s" (s_type (print_context()) t1) (s_type (print_context()) t2);
-				die "" __LOC__
+		List.iter2 (fun ttp1 ttp2 ->
+			try
+				List.iter2 (fun t1 t2 -> type_eq EqCoreType t2 t1) (get_constraints ttp1) (get_constraints ttp2)
+			with
+				| Invalid_argument _ ->
+					raise_typing_error "Type parameters must have the same number of constraints as core type" c.cl_pos
+				| Unify_error l ->
+					(* TODO send as one call with sub errors *)
+					display_error ctx.com ("Type parameter " ^ ttp2.ttp_name ^ " has different constraint than in core type") c.cl_pos;
+					display_error ctx.com (error_msg (Unify l)) c.cl_pos;
 		) ccore.cl_params c.cl_params;
 	with Invalid_argument _ ->
 		raise_typing_error "Class must have the same number of type parameters as core type" c.cl_pos

+ 21 - 22
src/typing/typeloadCheck.ml

@@ -62,28 +62,27 @@ let valid_redefinition ctx map1 map2 f1 t1 f2 t2 = (* child, parent *)
 		| l1, l2 when List.length l1 = List.length l2 ->
 			let to_check = ref [] in
 			(* TPTODO: defaults *)
-			let monos = List.map2 (fun tp1 tp2 ->
-				(match follow tp1.ttp_type, follow tp2.ttp_type with
-				| TInst ({ cl_kind = KTypeParameter ct1 } as c1,pl1), TInst ({ cl_kind = KTypeParameter ct2 } as c2,pl2) ->
-					(match ct1, ct2 with
-					| [], [] -> ()
-					| _, _ when List.length ct1 = List.length ct2 ->
-						(* if same constraints, they are the same type *)
-						let check monos =
-							List.iter2 (fun t1 t2  ->
-								try
-									let t1 = apply_params l1 monos (apply_params c1.cl_params pl1 (map2 t1)) in
-									let t2 = apply_params l2 monos (apply_params c2.cl_params pl2 (map1 t2)) in
-									type_eq EqStrict t1 t2
-								with Unify_error l ->
-									raise (Unify_error (Unify_custom "Constraints differ" :: l))
-							) ct1 ct2
-						in
-						to_check := check :: !to_check;
-					| _ ->
-						raise (Unify_error [Unify_custom "Different number of constraints"]))
-				| _ -> ());
-				TInst (mk_class null_module ([],tp1.ttp_name) null_pos null_pos,[])
+			let monos = List.map2 (fun ttp1 ttp2 ->
+				let ct1 = get_constraints ttp1 in
+				let ct2 = get_constraints ttp2 in
+				(match ct1, ct2 with
+				| [], [] -> ()
+				| _, _ when List.length ct1 = List.length ct2 ->
+					(* if same constraints, they are the same type *)
+					let check monos =
+						List.iter2 (fun t1 t2  ->
+							try
+								let t1 = apply_params l1 monos (map2 t1) in
+								let t2 = apply_params l2 monos (map1 t2) in
+								type_eq EqStrict t1 t2
+							with Unify_error l ->
+								raise (Unify_error (Unify_custom "Constraints differ" :: l))
+						) ct1 ct2
+					in
+					to_check := check :: !to_check;
+				| _ ->
+					raise (Unify_error [Unify_custom "Different number of constraints"]));
+				TInst (mk_class null_module ([],ttp1.ttp_name) null_pos null_pos,[])
 			) l1 l2 in
 			List.iter (fun f -> f monos) !to_check;
 			apply_params l1 monos t1, apply_params l2 monos t2

+ 2 - 2
src/typing/typer.ml

@@ -1046,9 +1046,9 @@ and type_new ctx ptp el with_type force_inline p =
 		unify_constructor_call c fa
 	in
 	try begin match Abstract.follow_with_forward_ctor t with
-	| TInst ({cl_kind = KTypeParameter tl} as c,params) ->
+	| TInst ({cl_kind = KTypeParameter ttp} as c,params) ->
 		if not (TypeloadCheck.is_generic_parameter ctx c) then raise_typing_error "Only generic type parameters can be constructed" p;
- 		begin match get_constructible_constraint ctx tl p with
+ 		begin match get_constructible_constraint ctx (get_constraints ttp) p with
 		| None ->
 			raise_typing_error_ext (make_error (No_constructor (TClassDecl c)) p)
 		| Some(tl,tr) ->

+ 2 - 2
src/typing/typerBase.ml

@@ -309,8 +309,8 @@ let get_constructible_constraint ctx tl p =
 				end;
 			| TAbstract({a_path = ["haxe"],"Constructible"},[t1]) ->
 				Some (extract_function t1)
-			| TInst({cl_kind = KTypeParameter tl1},_) ->
-				begin match loop tl1 with
+			| TInst({cl_kind = KTypeParameter ttp},_) ->
+				begin match loop (get_constraints ttp) with
 				| None -> loop tl
 				| Some _ as t -> t
 				end

+ 3 - 3
src/typing/typerDisplay.ml

@@ -251,14 +251,14 @@ let rec handle_signature_display ctx e_ast with_type =
 		l
 	in
 	let find_constructor_types t = match follow t with
-		| TInst ({cl_kind = KTypeParameter tl} as c,_) ->
+		| TInst ({cl_kind = KTypeParameter ttp} as c,_) ->
 			let rec loop tl = match tl with
 				| [] -> raise_typing_error_ext (make_error (No_constructor (TClassDecl c)) p)
 				| t :: tl -> match follow t with
 					| TAbstract({a_path = ["haxe"],"Constructible"},[t]) -> t
 					| _ -> loop tl
 			in
-			[loop tl,None,PMap.empty]
+			[loop (get_constraints ttp),None,PMap.empty]
 		| TInst (c,tl) | TAbstract({a_impl = Some c},tl) ->
 			Display.merge_core_doc ctx (TClassDecl c);
 			let fa = get_constructor_access c tl p in
@@ -628,7 +628,7 @@ let handle_display ctx e_ast dk mode with_type =
 						false
 					end
 				end
-			| ITTypeParameter {cl_kind = KTypeParameter tl} when get_constructible_constraint ctx tl null_pos <> None ->
+			| ITTypeParameter {cl_kind = KTypeParameter ttp} when get_constructible_constraint ctx (get_constraints ttp) null_pos <> None ->
 				true
 			| _ -> false
 		) r.fitems in