try a different approach

src/context/typecore.ml

@@ -129,6 +129,7 @@ and typer = {
 	mutable ret : t;
 	mutable locals : (string, tvar) PMap.t;
 	mutable opened : anon_status ref list;
+	mutable monomorphs : (Type.t * tmono) list;
 	mutable vthis : tvar option;
 	mutable in_call_args : bool;
 	(* events *)
@@ -506,15 +507,34 @@ let merge_core_doc ctx mt =
 		end
 	| _ -> ())
 
+let rec instantiate_monomorph ctx tmono mono =
+	match mono.tm_type,mono.tm_constraint with
+	| Some t,_ ->
+		begin match follow t with
+		| TMono mono as tmono -> instantiate_monomorph ctx tmono mono
+		| _ -> Some t
+		end
+	| None,None ->
+		None
+	| None,Some (CStructure(t,anon),_,p) ->
+		anon.a_status := Closed;
+		unify ctx t tmono p;
+		mono.tm_constraint <- None;
+		Some t
+	| None,Some (CTypes [t],_,p) ->
+		unify ctx t tmono p;
+		mono.tm_constraint <- None;
+		Some t
+	| _ ->
+		None
+
 let check_constraints map params tl =
 	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.add_constraint mono (s_type_path path) p (map t)
-				) constr
+				Monomorph.constrain_to_object mono (s_type_path path) p (List.map map constr)
 			| _ ->
 				let tm = map tm in
 				check_constraint (s_type_path path) (fun () ->

src/core/type.ml

@@ -62,9 +62,13 @@ type t =
 	| TLazy of tlazy ref
 	| TAbstract of tabstract * tparams
 
+and tmono_constraint =
+	| CStructure of t * tanon
+	| CTypes of t list
+
 and tmono = {
 	mutable tm_type : t option;
-	mutable tm_constraints : (t * string * pos) list;
+	mutable tm_constraint : (tmono_constraint * string * pos) option;
 }
 
 and tlazy =
@@ -1121,9 +1125,15 @@ let rec s_type_kind t =
 	| TMono r ->
 		begin match r.tm_type with
 			| None ->
-				begin match r.tm_constraints with
-				| [] -> "TMono (None)"
-				| tl -> Printf.sprintf "TMono (None : %s)" (String.concat ", " (List.map (fun (t,_,_) -> s_type_kind t) tl))
+				begin match r.tm_constraint with
+				| None ->
+					Printf.sprintf "TMono (None)"
+				| Some (cstr,_,_) ->
+					let s_constraints = match cstr with
+						| CStructure(t,_) -> s_type_kind t
+						| CTypes tl -> String.concat ", " (List.map s_type_kind tl)
+					in
+					Printf.sprintf "(TMono (None : %s))"s_constraints
 				end
 			| Some t -> "TMono (Some (" ^ (s_type_kind t) ^ "))"
 		end
@@ -1142,6 +1152,8 @@ let s_module_type_kind = function
 	| TAbstractDecl a -> "TAbstractDecl(" ^ (s_type_path a.a_path) ^ ")"
 	| TTypeDecl t -> "TTypeDecl(" ^ (s_type_path t.t_path) ^ ")"
 
+let is_simn = false
+
 let rec s_type ctx t =
 	match t with
 	| TMono r ->
@@ -1153,12 +1165,15 @@ let rec s_type ctx t =
 			with Not_found ->
 				let id = List.length !ctx in
 				ctx := (t,id) :: !ctx;
-				begin match r.tm_constraints with
-				| [] ->
-					Printf.sprintf "Unknown<%d>" id
-				| _ ->
-					let s_constraints = String.concat ", " (List.map (fun (t,_,_) -> s_type ctx t) r.tm_constraints) in
+				begin match r.tm_constraint with
+				| Some (cstr,_,_) when is_simn ->
+					let s_constraints = match cstr with
+						| CStructure(t,_) -> s_type ctx t
+						| CTypes tl -> String.concat ", " (List.map (s_type ctx) tl)
+					in
 					Printf.sprintf "(Unknown<%d> : %s)" id s_constraints
+				| _ ->
+					Printf.sprintf "Unknown<%d>" id
 				end
 			end
 		| Some t -> s_type ctx t)
@@ -1784,6 +1799,8 @@ type unify_error =
 
 exception Unify_error of unify_error list
 
+let error l = raise (Unify_error l)
+
 let check_constraint name f =
 	try
 		f()
@@ -1793,7 +1810,7 @@ let check_constraint name f =
 module Monomorph = struct
 	let create () = {
 		tm_type = None;
-		tm_constraints = [];
+		tm_constraint = None;
 	}
 
 	let unify_merge a b = match a,b with
@@ -1809,46 +1826,63 @@ module Monomorph = struct
 		| _ ->
 			!unify_ref a b
 
-	let add_constraint m path p t =
+	let set_constraint m path p constr =
 		assert(m.tm_type = None);
-		(* if p.pfile = "source/Main.hx" then print_endline (Printf.sprintf "add_constraint %s: %s" path (s_type_kind t)); *)
-		m.tm_constraints <- (t,path,p) :: m.tm_constraints
+		assert(m.tm_constraint = None);
+		m.tm_constraint <- Some (constr,path,p)
+
+	let constrain_to_object m path p tl = set_constraint m path p (CTypes tl)
+
+	let constrain_to_fields m path p fl =
+		let anon = { a_fields = fl; a_status = ref Opened } in
+		set_constraint m path p (CStructure(TAnon anon,anon))
 
 	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 merge_constraints mono_to mono_from = match mono_from.tm_constraint with
+		| None ->
+			()
+		| Some cstr -> match mono_to.tm_constraint with
+			| None ->
+				mono_to.tm_constraint <- Some cstr
+			| Some cstr2 -> match cstr,cstr2 with
+				| (CStructure(t1,anon1),path,p),(CStructure(t2,_),_,_) ->
+					!unify_ref t1 t2;
+					mono_to.tm_constraint <- Some(CStructure(t1,anon1),path,p)
+				| (CTypes tl1,path,p),(CTypes tl2,_,_) ->
+					mono_to.tm_constraint <- Some(CTypes (tl1 @ tl2),path,p);
+				| _ ->
+					error [Unify_custom "Cannot merge constraints"]
+
 	let rec bind m t =
 		begin match t with
 		| TMono m2 ->
 			begin match m2.tm_type with
 			| None ->
 				(* Inherit constraints. This avoids too-early unification. *)
-				List.iter (fun (t,path,p) -> add_constraint m2 path p t) m.tm_constraints;
+				merge_constraints m2 m;
 				do_bind m t
 			| Some t ->
 				bind m t
 			end;
 		| _ ->
-			List.iter (fun (t',path,p) ->
-				(* if p.pfile = "source/Main.hx" then print_endline (Printf.sprintf "check constraint %s(%s): %s" path (s_type_kind t') (s_type_kind t)); *)
-				check_constraint path (fun () -> unify_merge t t')
-			) m.tm_constraints;
+			Option.may (fun (cstr,path,p) -> match cstr with
+				| CStructure(tanon,anon) ->
+					if not (PMap.is_empty anon.a_fields) then check_constraint path (fun () ->
+						unify_merge t tanon;
+					)
+				| CTypes tl ->
+					check_constraint path (fun () ->
+						List.iter (unify_merge t) tl
+					)
+			) m.tm_constraint;
 			do_bind m t;
 		end
 
 	let unbind m =
 		m.tm_type <- None
-
-	let become_single_constraint m =
-		assert(m.tm_type = None);
-		match m.tm_constraints with
-		| [t,_,_] ->
-			m.tm_type <- Some t;
-			m.tm_constraints <- [];
-			Some t;
-		| _ ->
-			None
 end
 
 let rec link e a b =
@@ -1982,7 +2016,6 @@ 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)
 let has_meta m ml = List.exists (fun (m2,_,_) -> m = m2) ml
 let get_meta m ml = List.find (fun (m2,_,_) -> m = m2) ml
 let no_meta = []

src/macro/eval/evalDebugSocket.ml

@@ -167,8 +167,6 @@ let output_threads ctx =
 	let threads = IntMap.fold fold ctx.evals [] in
 	JArray threads
 
-let is_simn = false
-
 let output_scopes ctx env =
 	let capture_infos = env.env_info.capture_infos in
 	let scopes = env.env_debug.scopes in

src/typing/fields.ml

@@ -166,6 +166,9 @@ let field_access ctx mode f fmode t e p =
 					normal()
 				| Statics c2 when ctx.curclass == c2 || can_access ctx c2 { f with cf_flags = unset_flag f.cf_flags (int_of_class_field_flag CfPublic) } true -> normal()
 				| _ -> if ctx.untyped then normal() else AKNo f.cf_name)
+			| TMono {tm_constraint = Some ((CStructure _),_,_)} when mode = MSet ->
+					f.cf_kind <- Var { v with v_write = AccNormal };
+					normal();
 			| _ ->
 				if ctx.untyped then normal() else AKNo f.cf_name)
 		| AccNormal | AccNo ->
@@ -474,20 +477,36 @@ let rec type_field cfg ctx e i p mode =
 				a.a_fields <- PMap.add i f a.a_fields;
 				field_access ctx mode f (FAnon f) (Type.field_type f) e p
 		)
-	| TMono r ->
-		let f = {
+	| TMono r as tmono ->
+		let spawn_field () =  {
 			(mk_field i (mk_mono()) p null_pos) with
 			cf_kind = Var { v_read = AccNormal; v_write = (match mode with MSet -> AccNormal | MGet | MCall -> AccNo) };
 		} in
-		let x = ref Opened in
-		let t = TAnon { a_fields = PMap.add i f PMap.empty; a_status = x } in
-		ctx.opened <- x :: ctx.opened;
-		begin try
-			Monomorph.bind r t;
-		with Unify_error l ->
-			raise (Error (Unify l,p))
-		end;
-		field_access ctx mode f (FAnon f) (Type.field_type f) e p
+		let field_access f =
+			field_access ctx mode f (FAnon f) (Type.field_type f) e p
+		in
+		begin match r.tm_constraint with
+			| None ->
+				let f = spawn_field () in
+				Monomorph.constrain_to_fields r "type_field" p (PMap.add i f PMap.empty);
+				(* Don't bother registering monomorphs if we're in untyped mode - we probably don't want to close them. *)
+				if not ctx.untyped then ctx.monomorphs <- (tmono,r) :: ctx.monomorphs;
+				field_access f
+			| Some (cstr,_,_) ->
+				begin match cstr with
+				| CStructure(_,an) ->
+					begin try
+						let f = PMap.find i an.a_fields in
+						field_access f
+					with Not_found ->
+						let f = spawn_field () in
+						an.a_fields <- PMap.add i f an.a_fields;
+						field_access f
+					end
+				| CTypes tl ->
+					no_field()
+				end
+		end
 	| TAbstract (a,pl) ->
 		let static_abstract_access_through_instance = ref false in
 		(try

src/typing/generic.ml

@@ -50,13 +50,13 @@ let make_generic ctx ps pt p =
 				| _ when not top ->
 					follow_or t top (fun() -> "_") (* allow unknown/incompatible types as type parameters to retain old behavior *)
 				| TMono ({ tm_type = None } as mono) ->
-					begin match Monomorph.become_single_constraint mono with
+					begin match instantiate_monomorph ctx t mono with
 					| Some t -> loop top t
 					| None -> raise (Generic_Exception (("Could not determine type for parameter " ^ s), p))
 					end
 				| TDynamic _ -> "Dynamic"
 				| t ->
-					follow_or t top (fun() -> raise (Generic_Exception (("Unsupported type parameter: " ^ (s_type (print_context()) t) ^ ")"), p)))
+					follow_or t top (fun() -> raise (Generic_Exception (("Unsupported type parameter: " ^ (s_type (print_context()) t)), p)))
 			and loop_tl top tl = match tl with
 				| [] -> ""
 				| tl -> "_" ^ String.concat "_" (List.map (loop top) tl)

src/typing/typeloadFunction.ml

@@ -45,12 +45,14 @@ let save_field_state ctx =
 	let old_ret = ctx.ret in
 	let old_fun = ctx.curfun in
 	let old_opened = ctx.opened in
+	let old_monos = ctx.monomorphs in
 	let locals = ctx.locals in
 	(fun () ->
 		ctx.locals <- locals;
 		ctx.ret <- old_ret;
 		ctx.curfun <- old_fun;
 		ctx.opened <- old_opened;
+		ctx.monomorphs <- old_monos;
 	)
 
 let type_var_field ctx t e stat do_display p =
@@ -107,6 +109,7 @@ let type_function ctx args ret fmode f do_display p =
 	ctx.curfun <- fmode;
 	ctx.ret <- ret;
 	ctx.opened <- [];
+	ctx.monomorphs <- [];
 	let e = match f.f_expr with
 		| None ->
 			if ctx.com.display.dms_error_policy = EPIgnore then
@@ -220,6 +223,7 @@ let type_function ctx args ret fmode f do_display p =
 		| _ -> e
 	in
 	List.iter (fun r -> r := Closed) ctx.opened;
+	List.iter (fun (tmono,mono) -> ignore(instantiate_monomorph ctx tmono mono)) ctx.monomorphs;
 	if is_position_debug then print_endline ("typing:\n" ^ (Texpr.dump_with_pos "" e));
 	e , fargs
 

src/typing/typeloadModule.ml

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

src/typing/typer.ml

@@ -2649,6 +2649,7 @@ let rec create com =
 		curfield = null_field;
 		tthis = mk_mono();
 		opened = [];
+		monomorphs = [];
 		vthis = None;
 		in_call_args = false;
 		on_error = (fun ctx msg p -> ctx.com.error msg p);

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

@@ -1,8 +1,8 @@
-Main.hx:4: characters 28-31 : Class<Two> should be Class<(Unknown<0> : One)>
+Main.hx:4: characters 28-31 : Class<Two> should be Class<Unknown<0>>
 Main.hx:4: characters 28-31 : Constraint check failure for downcast.S
 Main.hx:4: characters 28-31 : Two should be One
 Main.hx:4: characters 28-31 : For function argument 'c'
-Main.hx:5: characters 29-33 : Class<ITwo> should be Class<(Unknown<0> : IOne)>
+Main.hx:5: characters 29-33 : Class<ITwo> should be Class<Unknown<0>>
 Main.hx:5: characters 29-33 : Constraint check failure for downcast.S
 Main.hx:5: characters 29-33 : ITwo should be IOne
 Main.hx:5: characters 29-33 : For function argument 'c'

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

@@ -1,2 +1 @@
-Main.hx:5: characters 9-18 : {+ field : Unknown<0> } should be {+ args : {+ field : Unknown<0> } }
-Main.hx:5: characters 9-18 : For function argument 'type'
+Main.hx:4: characters 4-13 : { field : Unknown<1>, args : Unknown<0> } should be Unknown<0>