let's try this again

src/context/typecore.ml

@@ -132,6 +132,7 @@ and typer = {
 	mutable opened : anon_status ref list;
 	mutable vthis : tvar option;
 	mutable in_call_args : bool;
+	mutable monomorphs : tmono list;
 	(* events *)
 	mutable on_error : typer -> string -> pos -> unit;
 	memory_marker : float array;
@@ -513,6 +514,45 @@ let merge_core_doc ctx mt =
 		end
 	| _ -> ())
 
+let check_constraints map params tl p =
+	List.iter2 (fun (_,t) tm ->
+		begin match follow t with
+		| TInst ({ cl_kind = KTypeParameter constr; cl_path = path; cl_name_pos = p; },_) ->
+			if constr <> [] then begin match tm with
+			| TMono mono ->
+				List.iter (fun t -> Monomorph.constrain_to_type mono (s_type_path path) p (map t)) constr
+			| _ ->
+				let tm = map tm in
+				check_constraint (s_type_path path) (fun () ->
+					List.iter (fun t ->
+						Type.unify tm (map t)
+					) constr
+				)
+			end
+		| _ ->
+			assert false
+		end;
+	) params tl
+
+let spawn_constrained_monos ctx p map params =
+	let monos = List.map (fun (s,_) ->
+		let mono = Monomorph.create() in
+		(* if ctx.curclass.cl_path = ([],"Main") then Monomorph.add_constraint mono "debug" p (MDebug s); *)
+		ctx.monomorphs <- mono :: ctx.monomorphs;
+		TMono mono
+	) params in
+	let map t = map (apply_params params monos t) in
+	check_constraints map params monos p;
+	monos
+
+let with_contextual_monos ctx f =
+	let old_monos = ctx.monomorphs in
+	ctx.monomorphs <- [];
+	let r = f() in
+	List.iter (fun m -> ignore(Monomorph.close m)) ctx.monomorphs;
+	ctx.monomorphs <- old_monos @ ctx.monomorphs;
+	r
+
 (* -------------- debug functions to activate when debugging typer passes ------------------------------- *)
 (*/*
 

src/core/tType.ml

@@ -45,6 +45,19 @@ type t =
 
 and tmono = {
 	mutable tm_type : t option;
+	mutable tm_constraints : tmono_constraint list;
+}
+
+and tmono_constraint_kind =
+	| MMono of tmono
+	| MField of tclass_field
+	| MType of t
+	| MDebug of string
+
+and tmono_constraint = {
+	mc_kind : tmono_constraint_kind;
+	mc_pos : pos;
+	mc_name : string;
 }
 
 and tlazy =

src/core/tUnification.ml

@@ -3,17 +3,174 @@ open TType
 open TFunctions
 open TPrinting
 
+type unify_error =
+	| Cannot_unify of t * t
+	| Invalid_field_type of string
+	| Has_no_field of t * string
+	| Has_no_runtime_field of t * string
+	| Has_extra_field of t * string
+	| Invalid_kind of string * field_kind * field_kind
+	| Invalid_visibility of string
+	| Not_matching_optional of string
+	| Cant_force_optional
+	| Invariant_parameter of int
+	| Constraint_failure of string
+	| Missing_overload of tclass_field * t
+	| FinalInvariance (* nice band name *)
+	| Invalid_function_argument of int (* index *) * int (* total *)
+	| Invalid_return_type
+	| Unify_custom of string
+
+exception Unify_error of unify_error list
+
+type eq_kind =
+	| EqStrict
+	| EqCoreType
+	| EqRightDynamic
+	| EqBothDynamic
+	| EqDoNotFollowNull (* like EqStrict, but does not follow Null<T> *)
+
+type unification_context = {
+	allow_transitive_cast : bool;
+	equality_kind         : eq_kind;
+}
+
+let error l = raise (Unify_error l)
+
+let check_constraint name f =
+	try
+		f()
+	with Unify_error l ->
+		raise (Unify_error ((Constraint_failure name) :: l))
+
+let unify_ref : (unification_context -> t -> t -> unit) ref = ref (fun _ _ _ -> ())
+
+let default_unification_context = {
+	allow_transitive_cast = true;
+	equality_kind         = EqStrict;
+}
+
 module Monomorph = struct
 	let create () = {
 		tm_type = None;
+		tm_constraints = [];
 	}
 
+	(* constraining *)
+
+	let extract_name m =
+		let rec loop l = match l with
+			| [] -> "?"
+			| {mc_kind = MDebug s} :: _ -> s
+			| _ :: l -> loop l
+		in
+		loop m.tm_constraints
+
+	let s_constraint = function
+		| MMono m -> Printf.sprintf "MMono %s" (extract_name m)
+		| MField cf -> Printf.sprintf "MField %s" cf.cf_name
+		| MType t -> Printf.sprintf "MType %s" (s_type_kind t)
+		| MDebug _ -> "MDebug"
+
+	let make_constraint name p kind =
+		{mc_kind = kind; mc_name = name; mc_pos = p}
+
+	let add_constraint m name p kind =
+		m.tm_constraints <- (make_constraint name p kind) :: m.tm_constraints
+
+	let constraint_of_type t = match follow t with
+		| TMono m2 ->
+			[MMono m2]
+		| TAnon an when not (PMap.is_empty an.a_fields) ->
+			PMap.fold (fun cf l ->
+				(MField cf) :: l
+			) an.a_fields []
+		| _ ->
+			[MType t]
+
+	let constrain_to_type m name p t =
+		List.iter (add_constraint m name p) (constraint_of_type t)
+
+	let check_constraints m t =
+		let fields = DynArray.create () in
+		let rec check constr = match constr.mc_kind with
+			| MMono m2 ->
+				begin match m2.tm_type with
+				| None ->
+					()
+				| Some t ->
+					List.iter (fun kind -> check (make_constraint constr.mc_name constr.mc_pos kind)) (constraint_of_type t)
+				end;
+			| MField cf ->
+				DynArray.add fields cf
+			| MType t2 ->
+				check_constraint constr.mc_name (fun () -> (!unify_ref) default_unification_context t t2);
+			| MDebug name ->
+				let s_constr = String.concat "" (List.map (fun constr -> Printf.sprintf "\n\t%s" (s_constraint constr.mc_kind)) m.tm_constraints) in
+				print_endline (Printf.sprintf "Checking constraints of %s against %s%s" name (s_type_kind t) s_constr);
+		in
+		List.iter check m.tm_constraints;
+		if DynArray.length fields > 0 then begin
+			let fields = List.fold_left (fun m cf -> PMap.add cf.cf_name cf m) PMap.empty (DynArray.to_list fields) in
+			let t2 = mk_anon ~fields (ref Opened) in
+			check_constraint "" (fun () -> (!unify_ref) default_unification_context t t2);
+		end
+
+	(* binding *)
+
 	let do_bind m t =
 		(* assert(m.tm_type = None); *) (* TODO: should be here, but matcher.ml does some weird bind handling at the moment. *)
 		m.tm_type <- Some t
 
 	let rec bind m t =
-		m.tm_type <- Some t
+		begin match t with
+		| TMono m2 ->
+			begin match m2.tm_type with
+			| None ->
+				do_bind m t;
+				List.iter (fun constr -> m2.tm_constraints <- constr :: m2.tm_constraints) m.tm_constraints
+			| Some t ->
+				bind m t
+			end
+		| _ ->
+			check_constraints m t;
+			do_bind m t
+		end
+
+	let close m = match m.tm_type with
+		| Some _ ->
+			false
+		| None ->
+			let rec loop fields l = match l with
+			(* If we have a monomorph that has a type now, expand to the constraints of that type *)
+			| ({mc_kind = MMono {tm_type = Some t}} as constr) :: l ->
+				let l2 = List.map (fun kind -> make_constraint constr.mc_name constr.mc_pos kind) (constraint_of_type t) in
+				loop fields (l2 @ l)
+			(* If we have a concrete type, bind to that *)
+			| {mc_kind = MType t} :: l ->
+				do_bind m t;
+				true
+			(* Collect fields *)
+			| {mc_kind = MField cf} :: l ->
+				loop (cf :: fields) l
+			| {mc_kind = MDebug name} :: l ->
+				let s_constr = String.concat "" (List.map (fun constr -> Printf.sprintf "\n\t%s" (s_constraint constr.mc_kind)) m.tm_constraints) in
+				print_endline (Printf.sprintf "Closing %s%s" name s_constr);
+				loop fields l
+			| _ :: l ->
+				loop fields l
+			| [] ->
+				begin match fields with
+				| [] ->
+					false
+				| fields ->
+					(* We found a bunch of fields but no type, create a merged structure type and bind to that *)
+					let fields = List.fold_left (fun m cf -> PMap.add cf.cf_name cf m) PMap.empty fields in
+					do_bind m (mk_anon ~fields (ref Closed));
+					true
+				end;
+			in
+			loop [] m.tm_constraints
 
 	let unbind m =
 		m.tm_type <- None
@@ -149,33 +306,12 @@ let rec shallow_eq a b =
    it's also the one that is pointed by the position.
    It's actually a typecheck of  A :> B where some mutations can happen *)
 
-type unify_error =
-	| Cannot_unify of t * t
-	| Invalid_field_type of string
-	| Has_no_field of t * string
-	| Has_no_runtime_field of t * string
-	| Has_extra_field of t * string
-	| Invalid_kind of string * field_kind * field_kind
-	| Invalid_visibility of string
-	| Not_matching_optional of string
-	| Cant_force_optional
-	| Invariant_parameter of int
-	| Constraint_failure of string
-	| Missing_overload of tclass_field * t
-	| FinalInvariance (* nice band name *)
-	| Invalid_function_argument of int (* index *) * int (* total *)
-	| Invalid_return_type
-	| Unify_custom of string
-
-exception Unify_error of unify_error list
-
 let cannot_unify a b = Cannot_unify (a,b)
 let invalid_field n = Invalid_field_type n
 let invalid_kind n a b = Invalid_kind (n,a,b)
 let invalid_visibility n = Invalid_visibility n
 let has_no_field t n = Has_no_field (t,n)
 let has_extra_field t n = Has_extra_field (t,n)
-let error l = raise (Unify_error l)
 
 (*
 	we can restrict access as soon as both are runtime-compatible
@@ -266,23 +402,6 @@ let rec_stack_bool stack value fcheck frun =
 				raise e
 	end
 
-type eq_kind =
-	| EqStrict
-	| EqCoreType
-	| EqRightDynamic
-	| EqBothDynamic
-	| EqDoNotFollowNull (* like EqStrict, but does not follow Null<T> *)
-
-type unification_context = {
-	allow_transitive_cast : bool;
-	equality_kind         : eq_kind;
-}
-
-let default_unification_context = {
-	allow_transitive_cast = true;
-	equality_kind         = EqStrict;
-}
-
 let rec type_eq uctx a b =
 	let param = uctx.equality_kind in
 	let can_follow t = match param with
@@ -871,4 +990,7 @@ let unify_custom = unify
 let unify = unify default_unification_context
 
 let type_eq_custom = type_eq
-let type_eq param = type_eq {default_unification_context with equality_kind = param}
+let type_eq param = type_eq {default_unification_context with equality_kind = param}
+
+;;
+unify_ref := unify_custom;;

src/typing/calls.ml

@@ -354,7 +354,8 @@ let type_generic_function ctx (e,fa) el ?(using_param=None) with_type p =
 		| _ -> die "" __LOC__
 	in
 	if cf.cf_params = [] then error "Function has no type parameters and cannot be generic" p;
-	let monos = List.map (fun _ -> mk_mono()) cf.cf_params in
+	let map = if stat then (fun t -> t) else apply_params c.cl_params tl in
+	let monos = spawn_constrained_monos ctx p map cf.cf_params in
 	let map_monos t = apply_params cf.cf_params monos t in
 	let map t = if stat then map_monos t else apply_params c.cl_params tl (map_monos t) in
 	let t = map cf.cf_type in
@@ -373,12 +374,9 @@ let type_generic_function ctx (e,fa) el ?(using_param=None) with_type p =
 		| WithType.WithType(t,_) -> unify ctx ret t p
 		| _ -> ()
 	end;
-	let el,_ = unify_call_args ctx el args ret p false false in
-	begin try
-		check_constraints ctx cf.cf_name cf.cf_params monos map false p
-	with Unify_error l ->
-		display_error ctx (error_msg (Unify l)) p
-	end;
+	let el,_ = with_contextual_monos ctx (fun () ->
+		unify_call_args ctx el args ret p false false
+	) in
 	let el = match using_param with None -> el | Some e -> e :: el in
 	(try
 		let gctx = Generic.make_generic ctx cf.cf_params monos p in

src/typing/fields.ml

@@ -57,65 +57,18 @@ let remove_constant_flag t callb =
 		restore();
 		raise e
 
-let check_constraints ctx tname tpl tl map delayed p =
-	List.iter2 (fun m (name,t) ->
-		match follow t with
-		| TInst ({ cl_kind = KTypeParameter constr },_) when constr <> [] ->
-			let f = (fun() ->
-				List.iter (fun ct ->
-					try
-						Type.unify (map m) (map ct)
-					with Unify_error l ->
-						let l = Constraint_failure (tname ^ "." ^ name) :: l in
-						raise (Unify_error l)
-				) constr
-			) in
-			if delayed then
-				delay ctx PCheckConstraint (fun () -> try f() with Unify_error l -> display_error ctx (error_msg (Unify l)) p)
-			else
-				f()
-		| _ ->
-			()
-	) tl tpl
-
-let enum_field_type ctx en ef tl_en tl_ef p =
-	let map t = apply_params en.e_params tl_en (apply_params ef.ef_params tl_ef t) in
-	begin try
-		check_constraints ctx (s_type_path en.e_path) en.e_params tl_en map true p;
-		check_constraints ctx ef.ef_name ef.ef_params tl_ef map true p;
-	with Unify_error l ->
-		display_error ctx (error_msg (Unify l)) p
-	end;
+let enum_field_type ctx en ef p =
+	let tl_en = spawn_constrained_monos ctx p (fun t -> t) en.e_params in
+	let map = apply_params en.e_params tl_en in
+	let tl_ef = spawn_constrained_monos ctx p map ef.ef_params in
+	let map t = map (apply_params ef.ef_params tl_ef t) in
 	map ef.ef_type
 
-let add_constraint_checks ctx ctypes pl f tl p =
-	List.iter2 (fun m (name,t) ->
-		match follow t with
-		| TInst ({ cl_kind = KTypeParameter constr },_) when constr <> [] ->
-			let constr = List.map (fun t ->
-				let t = apply_params f.cf_params tl t in
-				(* only apply params if not static : in that case no param is passed *)
-				let t = (if pl = [] then t else apply_params ctypes pl t) in
-				t
-			) constr in
-			delay ctx PCheckConstraint (fun() ->
-				List.iter (fun ct ->
-					try
-						(* if has_mono m then raise (Unify_error [Unify_custom "Could not resolve full type for constraint checks"; Unify_custom ("Type was " ^ (s_type (print_context()) m))]); *)
-						Type.unify m ct
-					with Unify_error l ->
-						display_error ctx (error_msg (Unify (Constraint_failure (f.cf_name ^ "." ^ name) :: l))) p;
-				) constr
-			);
-		| _ -> ()
-	) tl f.cf_params
-
 let field_type ctx c pl f p =
 	match f.cf_params with
 	| [] -> f.cf_type
 	| l ->
-		let monos = List.map (fun _ -> mk_mono()) l in
-		if not (Meta.has Meta.Generic f.cf_meta) then add_constraint_checks ctx c.cl_params pl f monos p;
+		let monos = spawn_constrained_monos ctx p (if pl = [] then (fun t -> t) else apply_params c.cl_params pl) f.cf_params in
 		apply_params l monos f.cf_type
 
 let get_constructor ctx c params p =
@@ -488,18 +441,16 @@ let rec type_field cfg ctx e i p mode =
 				| Statics c -> FStatic (c,f), field_type ctx c [] f p
 				| EnumStatics e ->
 					let ef = try PMap.find f.cf_name e.e_constrs with Not_found -> die "" __LOC__ in
-					let monos = List.map (fun _ -> mk_mono()) e.e_params in
-					let monos2 = List.map (fun _ -> mk_mono()) ef.ef_params in
-					FEnum (e,ef), enum_field_type ctx e ef monos monos2 p
+					let t = enum_field_type ctx e ef p in
+					FEnum (e,ef),t
 				| _ ->
 					match f.cf_params with
 					| [] ->
 						FAnon f, Type.field_type f
 					| l ->
 						(* handle possible constraints *)
-						let monos = List.map (fun _ -> mk_mono()) l in
+						let monos = spawn_constrained_monos ctx p (fun t -> t) f.cf_params in
 						let t = apply_params f.cf_params monos f.cf_type in
-						add_constraint_checks ctx [] [] f monos p;
 						FAnon f, t
 			) in
 			field_access ctx mode f fmode ft e p

src/typing/generic.ml

@@ -49,7 +49,9 @@ let make_generic ctx ps pt p =
 				| TAbstract(a,tl) -> (s_type_path_underscore a.a_path) ^ (loop_tl top tl)
 				| _ when not top ->
 					follow_or t top (fun() -> "_") (* allow unknown/incompatible types as type parameters to retain old behavior *)
-				| TMono { tm_type = None } -> raise (Generic_Exception (("Could not determine type for parameter " ^ s), p))
+				| TMono ({ tm_type = None } as m) ->
+					if Monomorph.close m then loop top t
+					else raise (Generic_Exception (("Could not determine type for parameter " ^ s), p))
 				| TDynamic _ -> "Dynamic"
 				| t ->
 					follow_or t top (fun() -> raise (Generic_Exception (("Unsupported type parameter: " ^ (s_type (print_context()) t) ^ ")"), p)))

src/typing/typeload.ml

@@ -239,36 +239,6 @@ let resolve_position_by_path ctx path p =
 	let p = (t_infos mt).mt_pos in
 	raise_positions [p]
 
-let check_param_constraints ctx types t pl c p =
-	match follow t with
-	| TMono _ -> ()
-	| _ ->
-		let ctl = (match c.cl_kind with KTypeParameter l -> l | _ -> []) in
-		List.iter (fun ti ->
-			let ti = apply_params types pl ti in
-			let ti = (match follow ti with
-				| TInst ({ cl_kind = KGeneric } as c,pl) ->
-					(* if we solve a generic contraint, let's substitute with the actual generic instance before unifying *)
-					let _,_, f = ctx.g.do_build_instance ctx (TClassDecl c) p in
-					f pl
-				| _ -> ti
-			) in
-			try
-				unify_raise ctx t ti p
-			with Error(Unify l,p) ->
-				let fail() =
-					if not ctx.untyped then display_error ctx (error_msg (Unify (Constraint_failure (s_type_path c.cl_path) :: l))) p;
-				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 ctx e.etype ti p
-					with Error (Unify _,_) -> fail() end
-				| _ ->
-					fail()
-
-		) ctl
-
 let generate_args_meta com cls_opt add_meta args =
 	let values = List.fold_left (fun acc ((name,p),_,_,_,eo) -> match eo with Some e -> ((name,p,NoQuotes),e) :: acc | _ -> acc) [] args in
 	(match values with
@@ -337,16 +307,8 @@ let rec load_instance' ctx (t,p) allow_no_params =
 		let types , path , f = ctx.g.do_build_instance ctx mt p in
 		let is_rest = is_generic_build && (match types with ["Rest",_] -> true | _ -> false) in
 		if allow_no_params && t.tparams = [] && not is_rest then begin
-			let pl = ref [] in
-			pl := List.map (fun (name,t) ->
-				match follow t with
-				| TInst (c,_) ->
-					let t = mk_mono() in
-					if c.cl_kind <> KTypeParameter [] || is_generic then delay ctx PCheckConstraint (fun() -> check_param_constraints ctx types t (!pl) c p);
-					t;
-				| _ -> die "" __LOC__
-			) types;
-			f (!pl)
+			let monos = spawn_constrained_monos ctx p (fun t -> t) types in
+			f (monos)
 		end else if path = ([],"Dynamic") then
 			match t.tparams with
 			| [] -> t_dynamic
@@ -392,12 +354,24 @@ let rec load_instance' ctx (t,p) allow_no_params =
 							t
 						| TInst (c,[]) ->
 							check_const c;
-							let r = exc_protect ctx (fun r ->
-								r := lazy_available t;
-								delay ctx PCheckConstraint (fun() -> check_param_constraints ctx types t tparams c p);
+							let map t =
+								let t = apply_params types tparams t in
+								let t = (match follow t with
+									| TInst ({ cl_kind = KGeneric } as c,pl) ->
+										(* if we solve a generic contraint, let's substitute with the actual generic instance before unifying *)
+										let _,_, f = ctx.g.do_build_instance ctx (TClassDecl c) p in
+										f pl
+									| _ -> t
+								) in
 								t
-							) "constraint" in
-							TLazy r
+							in
+							delay ctx PCheckConstraint (fun () ->
+								try
+									check_constraints map types tparams p;
+								with Unify_error l ->
+									raise_error (Unify l) p
+							);
+							t
 						| _ -> die "" __LOC__
 					in
 					t :: loop tl1 tl2 is_rest

src/typing/typeloadModule.ml

@@ -971,6 +971,7 @@ let type_types_into_module ctx m tdecls p =
 		in_loop = false;
 		opened = [];
 		in_call_args = false;
+		monomorphs = [];
 		vthis = None;
 		memory_marker = Typecore.memory_marker;
 	} in

src/typing/typer.ml

@@ -417,10 +417,8 @@ let rec type_ident_raise ctx i p mode =
 					try
 						let ef = PMap.find i e.e_constrs in
 						let et = type_module_type ctx t None p in
-						let monos = List.map (fun _ -> mk_mono()) e.e_params in
-						let monos2 = List.map (fun _ -> mk_mono()) ef.ef_params in
 						ImportHandling.mark_import_position ctx pt;
-						wrap (mk (TField (et,FEnum (e,ef))) (enum_field_type ctx e ef monos monos2 p) p)
+						wrap (mk (TField (et,FEnum (e,ef))) (enum_field_type ctx e ef p) p)
 					with
 						Not_found -> loop l
 		in
@@ -1012,7 +1010,7 @@ and type_binop2 ?(abstract_overload_only=false) ctx op (e1 : texpr) (e2 : Ast.ex
 					| TFun([(_,_,t1);(_,_,t2)],tret) ->
 						let check e1 e2 swapped =
 							let map_arguments () =
-								let monos = List.map (fun _ -> mk_mono()) cf.cf_params in
+								let monos = spawn_constrained_monos ctx p (fun t -> t) cf.cf_params in
 								let map t = map (apply_params cf.cf_params monos t) in
 								let t1 = map t1 in
 								let t2 = map t2 in
@@ -1029,7 +1027,6 @@ and type_binop2 ?(abstract_overload_only=false) ctx op (e1 : texpr) (e2 : Ast.ex
 								Type.type_eq EqStrict e2.etype t2;
 								AbstractCast.cast_or_unify_raise ctx t1 e1 p,e2
 							end in
-							check_constraints ctx "" cf.cf_params monos (apply_params a.a_params tl) false cf.cf_pos;
 							let check_null e t = if is_eq_op then match e.eexpr with
 								| TConst TNull when not (is_explicit_null t) -> raise (Unify_error [])
 								| _ -> ()
@@ -1794,14 +1791,11 @@ and type_new ctx path el with_type force_inline p =
 		(* Try to infer generic parameters from the argument list (issue #2044) *)
 		begin match resolve_typedef (Typeload.load_type_def ctx p (fst path)) with
 		| TClassDecl ({cl_constructor = Some cf} as c) ->
-			let monos = List.map (fun _ -> mk_mono()) c.cl_params in
+			let monos = spawn_constrained_monos ctx p (fun t -> t) c.cl_params in
 			let ct, f = get_constructor ctx c monos p in
 			ignore (unify_constructor_call c monos f ct);
 			begin try
-				let t = Generic.build_generic ctx c p monos in
-				let map = apply_params c.cl_params monos in
-				check_constraints ctx (s_type_path c.cl_path) c.cl_params monos map true p;
-				t
+				Generic.build_generic ctx c p monos
 			with Generic.Generic_Exception _ as exc ->
 				(* If we have an expected type, just use that (issue #3804) *)
 				begin match with_type with
@@ -2403,8 +2397,10 @@ and type_call_target ctx e with_type inline p =
 
 and type_call ?(mode=MGet) ctx e el (with_type:WithType.t) inline p =
 	let def () =
-		let e = type_call_target ctx e with_type inline p in
-		build_call ~mode ctx e el with_type p
+		with_contextual_monos ctx (fun () ->
+			let e = type_call_target ctx e with_type inline p in
+			build_call ~mode ctx e el with_type p;
+		)
 	in
 	match e, el with
 	| (EConst (Ident "trace"),p) , e :: el ->
@@ -2695,6 +2691,7 @@ let rec create com =
 		opened = [];
 		vthis = None;
 		in_call_args = false;
+		monomorphs = [];
 		on_error = (fun ctx msg p -> ctx.com.error msg p);
 		memory_marker = Typecore.memory_marker;
 	} in

src/typing/typerBase.ml

@@ -119,7 +119,7 @@ let rec type_module_type ctx t tparams p =
 		let t_tmp = class_module_type c in
 		mk (TTypeExpr (TClassDecl c)) (TType (t_tmp,[])) p
 	| TEnumDecl e ->
-		let types = (match tparams with None -> List.map (fun _ -> mk_mono()) e.e_params | Some l -> l) in
+		let types = (match tparams with None -> spawn_constrained_monos ctx p (fun t -> t) e.e_params | Some l -> l) in
 		mk (TTypeExpr (TEnumDecl e)) (TType (e.e_type,types)) p
 	| TTypeDecl s ->
 		let t = apply_params s.t_params (List.map (fun _ -> mk_mono()) s.t_params) s.t_type in

tests/misc/projects/Issue3781/compile-fail.hxml.stderr

@@ -1,2 +1,3 @@
-Main.hx:12: characters 9-11 : Constraint check failure for E1.T
-Main.hx:12: characters 9-11 : Main.T should be String
+Main.hx:12: characters 12-13 : Constraint check failure for E1.T
+Main.hx:12: characters 12-13 : Main.T should be String
+Main.hx:12: characters 12-13 : For function argument 'v'

tests/misc/projects/Issue4775/compile1-fail.hxml.stderr

@@ -1,2 +1,2 @@
-Main1.hx:7: characters 3-27 : Constraint check failure for Contain.T
-Main1.hx:7: characters 3-27 : Main1 should be String
+Main1.hx:7: characters 15-26 : Main1 should be String
+Main1.hx:7: characters 15-26 : For function argument 't'