[typer] move some things around

src/context/typecore.ml

@@ -519,35 +519,6 @@ 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 (Some (s_type_path path)) (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
-		TMono mono
-	) params in
-	let map t = map (apply_params params monos t) in
-	check_constraints map params monos p;
-	monos
-
 let safe_mono_close ctx m p =
 	try
 		Monomorph.close m

src/core/tUnification.ml

@@ -172,6 +172,36 @@ module Monomorph = struct
 
 	let unbind m =
 		m.tm_type <- 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 -> constrain_to_type mono (Some (s_type_path path)) (map t)) constr
+				| _ ->
+					let tm = map tm in
+					check_constraint (s_type_path path) (fun () ->
+						List.iter (fun t ->
+							!unify_ref default_unification_context tm (map t)
+						) constr
+					)
+				end
+			| _ ->
+				assert false
+			end;
+		) params tl
+
+	let spawn_constrained_monos map params =
+		let monos = List.map (fun (s,_) ->
+			let mono = create() in
+			TMono mono
+		) params in
+		let map t = map (apply_params params monos t) in
+		check_constraints map params monos;
+		monos
+
 end
 
 let rec follow_and_close t = match follow t with

src/typing/calls.ml

@@ -232,7 +232,7 @@ let unify_call_args ctx el args r p inline force_inline =
 
 let unify_field_call ctx fa el args ret p inline =
 	let map_cf cf0 map cf =
-		let monos = spawn_constrained_monos ctx p map cf.cf_params in
+		let monos = Monomorph.spawn_constrained_monos map cf.cf_params in
 		let t = map (apply_params cf.cf_params monos cf.cf_type) in
 		begin match cf.cf_expr,cf.cf_kind with
 		| None,Method MethInline when not ctx.com.config.pf_overload ->
@@ -262,7 +262,7 @@ let unify_field_call ctx fa el args ret p inline =
 				List.map (map_cf cf map) cf.cf_overloads
 			else
 				List.map (fun (t,cf) ->
-					let monos = spawn_constrained_monos ctx p map cf.cf_params in
+					let monos = Monomorph.spawn_constrained_monos map cf.cf_params in
 					map (apply_params cf.cf_params monos t),cf
 				) (Overloads.get_overloads c cf.cf_name)
 			in
@@ -359,7 +359,7 @@ let type_generic_function ctx (e,fa) el ?(using_param=None) with_type p =
 	in
 	if cf.cf_params = [] then error "Function has no type parameters and cannot be generic" p;
 	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 monos = Monomorph.spawn_constrained_monos 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

src/typing/fields.ml

@@ -58,9 +58,9 @@ let remove_constant_flag t callb =
 		raise e
 
 let enum_field_type ctx en ef p =
-	let tl_en = spawn_constrained_monos ctx p (fun t -> t) en.e_params in
+	let tl_en = Monomorph.spawn_constrained_monos (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 tl_ef = Monomorph.spawn_constrained_monos map ef.ef_params in
 	let map t = map (apply_params ef.ef_params tl_ef t) in
 	map ef.ef_type
 
@@ -68,7 +68,7 @@ let field_type ctx c pl f p =
 	match f.cf_params with
 	| [] -> f.cf_type
 	| l ->
-		let monos = spawn_constrained_monos ctx p (if pl = [] then (fun t -> t) else apply_params c.cl_params pl) f.cf_params in
+		let monos = Monomorph.spawn_constrained_monos (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 =
@@ -255,7 +255,7 @@ let rec using_field ctx mode e i p =
 		try
 			let cf = PMap.find i c.cl_statics in
 			if Meta.has Meta.NoUsing cf.cf_meta || not (can_access ctx c cf true) || (Meta.has Meta.Impl cf.cf_meta) then raise Not_found;
-			let monos = spawn_constrained_monos ctx p (fun t -> t) cf.cf_params in
+			let monos = Monomorph.spawn_constrained_monos (fun t -> t) cf.cf_params in
 			let map = apply_params cf.cf_params monos in
 			let t = map cf.cf_type in
 			begin match follow t with
@@ -440,7 +440,7 @@ let rec type_field cfg ctx e i p mode =
 						FAnon f, Type.field_type f
 					| l ->
 						(* handle possible constraints *)
-						let monos = spawn_constrained_monos ctx p (fun t -> t) f.cf_params in
+						let monos = Monomorph.spawn_constrained_monos (fun t -> t) f.cf_params in
 						let t = apply_params f.cf_params monos f.cf_type in
 						FAnon f, t
 			) in

src/typing/typeload.ml

@@ -307,7 +307,7 @@ 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 monos = spawn_constrained_monos ctx p (fun t -> t) types in
+			let monos = Monomorph.spawn_constrained_monos (fun t -> t) types in
 			f (monos)
 		end else if path = ([],"Dynamic") then
 			match t.tparams with
@@ -391,7 +391,7 @@ let rec load_instance' ctx (t,p) allow_no_params =
 				in
 				delay ctx PCheckConstraint (fun () ->
 					try
-						check_constraints map types params p;
+						Monomorph.check_constraints map types params;
 					with Unify_error l ->
 						raise_error (Unify l) p
 				);

src/typing/typer.ml

@@ -1011,7 +1011,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 = spawn_constrained_monos ctx p (fun t -> t) cf.cf_params in
+								let monos = Monomorph.spawn_constrained_monos (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
@@ -1791,7 +1791,7 @@ 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 = spawn_constrained_monos ctx p (fun t -> t) c.cl_params in
+			let monos = Monomorph.spawn_constrained_monos (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

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 -> spawn_constrained_monos ctx p (fun t -> t) e.e_params | Some l -> l) in
+		let types = (match tparams with None -> Monomorph.spawn_constrained_monos (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