restructure a bit

src/context/typecore.ml

@@ -526,7 +526,7 @@ let check_constraints map params tl p =
 		| 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
+				List.iter (fun t -> Monomorph.constrain_to_type mono (Some (s_type_path path)) (map t)) constr
 			| _ ->
 				let tm = map tm in
 				check_constraint (s_type_path path) (fun () ->

src/core/tPrinting.ml

@@ -37,7 +37,7 @@ let rec s_type ctx t =
 		| None ->
 			let s_const = match r.tm_constraints with
 				| [] -> ""
-				| l when is_simn -> Printf.sprintf " : %s" (String.concat " & " (List.map (fun constr -> s_constraint constr.mc_kind) l))
+				| l when is_simn -> Printf.sprintf " : %s" (String.concat " & " (List.map s_constraint l))
 				| _ -> ""
 			in
 			begin try
@@ -109,9 +109,9 @@ and s_type_params ctx = function
 	| l -> "<" ^ String.concat ", " (List.map (s_type ctx) l) ^ ">"
 
 and s_constraint = function
-	| MMono m -> Printf.sprintf "MMono %s" (s_type_kind (TMono m))
+	| MMono(m,_) -> Printf.sprintf "MMono %s" (s_type_kind (TMono m))
 	| MField cf -> Printf.sprintf "MField %s" cf.cf_name
-	| MType t -> Printf.sprintf "MType %s" (s_type_kind t)
+	| MType(t,_) -> Printf.sprintf "MType %s" (s_type_kind t)
 	| MOpenStructure -> "MOpenStructure"
 
 let s_access is_read = function

src/core/tType.ml

@@ -48,18 +48,12 @@ and tmono = {
 	mutable tm_constraints : tmono_constraint list;
 }
 
-and tmono_constraint_kind =
-	| MMono of tmono
+and tmono_constraint =
+	| MMono of tmono * string option
 	| MField of tclass_field
-	| MType of t
+	| MType of t * string option
 	| MOpenStructure
 
-and tmono_constraint = {
-	mc_kind : tmono_constraint_kind;
-	mc_pos : pos;
-	mc_name : string;
-}
-
 and tlazy =
 	| LAvailable of t
 	| LProcessing of (unit -> t)

src/core/tUnification.ml

@@ -59,7 +59,7 @@ module Monomorph = struct
 	type constraint_kind =
 		| CUnknown
 		| CStructural of (string,tclass_field) PMap.t * bool
-		| CTypes of (string * pos * t) list
+		| CTypes of (t * string option) list
 
 	type closing_mode =
 		| CContextual
@@ -67,41 +67,38 @@ module Monomorph = struct
 
 	(* constraining *)
 
-	let make_constraint name p kind =
-		{mc_kind = kind; mc_name = name; mc_pos = p}
+	let add_constraint m constr =
+		m.tm_constraints <- constr :: m.tm_constraints
 
-	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
+	let constraint_of_type name t = match follow t with
 		| TMono m2 ->
-			[MMono m2]
+			[MMono(m2,name)]
 		| TAnon an when not (PMap.is_empty an.a_fields) ->
 			PMap.fold (fun cf l ->
 				(MField cf) :: l
 			) an.a_fields []
 		| _ ->
-			[MType t]
+			[MType(t,name)]
 
-	let constrain_to_type m name p t =
-		List.iter (add_constraint m name p) (constraint_of_type t)
+	let constrain_to_type m name t =
+		List.iter (add_constraint m) (constraint_of_type name t)
 
 	let classify_constraints m =
 		let types = DynArray.create () in
 		let fields = ref PMap.empty in
 		let is_open = ref false in
-		let rec check constr = match constr.mc_kind with
-			| MMono m2 ->
+		let rec check constr = match constr with
+			| MMono(m2,name) ->
 				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)
+					List.iter (fun constr -> check constr) (constraint_of_type name t)
 				end;
 			| MField cf ->
 				fields := PMap.add cf.cf_name cf !fields;
-			| MType t2 ->
-				DynArray.add types (constr.mc_name,constr.mc_pos,t2)
+			| MType(t2,name) ->
+				DynArray.add types (t2,name)
 			| MOpenStructure ->
 				is_open := true
 		in
@@ -117,10 +114,15 @@ module Monomorph = struct
 		| CUnknown ->
 			()
 		| CTypes tl ->
-			List.iter (fun (name,_,t2) -> check_constraint name (fun () -> (!unify_ref) default_unification_context t t2)) tl
+			List.iter (fun (t2,name) ->
+				let f () = (!unify_ref) default_unification_context t t2 in
+				match name with
+				| Some name -> check_constraint name f
+				| None -> f()
+			) tl
 		| CStructural(fields,is_open) ->
 			let t2 = mk_anon ~fields (ref Closed) in
-			check_constraint "" (fun () -> (!unify_ref) default_unification_context t t2)
+			(!unify_ref) default_unification_context t t2
 
 	(* binding *)
 
@@ -131,10 +133,10 @@ module Monomorph = struct
 
 	let rec bind m t =
 		begin match t with
-		| TAnon _ when List.exists (fun constr -> constr.mc_kind = MOpenStructure) m.tm_constraints ->
+		| TAnon _ when List.mem MOpenStructure m.tm_constraints ->
 			(* If we assign an open structure monomorph to another structure, the semantics want us to merge the
 			   fields. This is kinda weird, but that's how it has always worked. *)
-			constrain_to_type m "implicit" null_pos t;
+			constrain_to_type m None t;
 			ignore(close m CContextual)
 		| TMono m2 ->
 			begin match m2.tm_type with
@@ -155,7 +157,7 @@ module Monomorph = struct
 		| None -> match classify_constraints m with
 			| CUnknown ->
 				false
-			| CTypes [(_,_,t)] when mode = CRequired ->
+			| CTypes [(t,_)] when mode = CRequired ->
 				do_bind m t;
 				true
 			| CTypes _ ->

src/typing/fields.ml

@@ -498,7 +498,7 @@ let rec type_field cfg ctx e i p mode =
 					no_field()
 				else begin
 					let f = mk_field() in
-					Monomorph.add_constraint r "FA" p (MField f);
+					Monomorph.add_constraint r (MField f);
 					access f
 				end
 			end
@@ -506,7 +506,7 @@ let rec type_field cfg ctx e i p mode =
 			let rec loop tl = match tl with
 				| [] ->
 					no_field()
-				| (_,_,t) :: tl ->
+				| (t,_) :: tl ->
 					try
 						type_field (TypeFieldConfig.with_resume cfg) ctx {e with etype = t} i p mode
 					with Not_found ->
@@ -518,8 +518,8 @@ let rec type_field cfg ctx e i p mode =
 				ctx.monomorphs.perfunction <- (r,p) :: ctx.monomorphs.perfunction;
 			end;
 			let f = mk_field() in
-			Monomorph.add_constraint r "FA" p (MField f);
-			Monomorph.add_constraint r "FA" p MOpenStructure;
+			Monomorph.add_constraint r (MField f);
+			Monomorph.add_constraint r MOpenStructure;
 			access f
 		end
 	| TAbstract (a,pl) ->