[typer] factor out some parts of `unify_min`

src/core/tUnification.ml

@@ -35,6 +35,10 @@ type unification_context = {
 	equality_kind         : eq_kind;
 }
 
+type unify_min_result =
+	| UnifyMinOk of t
+	| UnifyMinError of unify_error list * int
+
 let error l = raise (Unify_error l)
 
 let check_constraint name f =
@@ -44,6 +48,7 @@ let check_constraint name f =
 		raise (Unify_error ((Constraint_failure name) :: l))
 
 let unify_ref : (unification_context -> t -> t -> unit) ref = ref (fun _ _ _ -> ())
+let unify_min_ref : (unification_context -> t -> t list -> unify_min_result) ref = ref (fun _ _ _ -> assert false)
 
 let default_unification_context = {
 	allow_transitive_cast = true;
@@ -1003,7 +1008,68 @@ let type_eq param = type_eq {default_unification_context with equality_kind = pa
 
 let type_iseq_custom = type_iseq
 let type_iseq = type_iseq default_unification_context
+module UnifyMinT = struct
+	let collect_base_types t =
+		let tl = ref [] in
+		let rec loop t = (match t with
+			| TInst(cl, params) ->
+				(match cl.cl_kind with
+				| KTypeParameter tl -> List.iter loop tl
+				| _ -> ());
+				List.iter (fun (ic, ip) ->
+					let t = apply_params cl.cl_params params (TInst (ic,ip)) in
+					loop t
+				) cl.cl_implements;
+				(match cl.cl_super with None -> () | Some (csup, pl) ->
+					let t = apply_params cl.cl_params params (TInst (csup,pl)) in
+					loop t);
+				tl := t :: !tl;
+			| TType (td,pl) ->
+				loop (apply_params td.t_params pl td.t_type);
+				(* prioritize the most generic definition *)
+				tl := t :: !tl;
+			| TLazy f -> loop (lazy_type f)
+			| TMono r -> (match r.tm_type with None -> () | Some t -> loop t)
+			| _ -> tl := t :: !tl)
+		in
+		loop t;
+		!tl
+
+	let unify_min' uctx common_types tl =
+		let first_error = ref None in
+		let rec loop index common_types tl = match tl with
+			| [] ->
+				begin match common_types with
+				| [] ->
+					begin match !first_error with
+					| None -> die "" __LOC__
+					| Some(l,p) -> UnifyMinError(l,p)
+					end
+				| hd :: _ ->
+					UnifyMinOk hd
+				end
+			| t :: tl ->
+				let common_types = List.filter (fun t' ->
+					try
+						unify_custom uctx t t';
+						true
+					with Unify_error l ->
+						if !first_error = None then first_error := Some(l,index);
+						false
+				) common_types in
+				loop (index + 1) common_types tl
+		in
+		loop 0 common_types tl
 
+	let unify_min uctx t0 tl =
+		match tl with
+		| [] ->
+			UnifyMinOk t0
+		| _ ->
+			let common_types = collect_base_types t0 in
+			unify_min' uctx common_types tl
+end
 ;;
 unify_ref := unify_custom;;
-monomorph_classify_constraints_ref := Monomorph.classify_constraints
+unify_min_ref := UnifyMinT.unify_min;;
+monomorph_classify_constraints_ref := Monomorph.classify_constraints

src/typing/typer.ml

@@ -167,32 +167,6 @@ let check_error ctx err p = match err with
 
 let rec unify_min_raise ctx (el:texpr list) : t =
 	let basic = ctx.com.basic in
-	let rec base_types t =
-		let tl = ref [] in
-		let rec loop t = (match t with
-			| TInst(cl, params) ->
-				(match cl.cl_kind with
-				| KTypeParameter tl -> List.iter loop tl
-				| _ -> ());
-				List.iter (fun (ic, ip) ->
-					let t = apply_params cl.cl_params params (TInst (ic,ip)) in
-					loop t
-				) cl.cl_implements;
-				(match cl.cl_super with None -> () | Some (csup, pl) ->
-					let t = apply_params cl.cl_params params (TInst (csup,pl)) in
-					loop t);
-				tl := t :: !tl;
-			| TType (td,pl) ->
-				loop (apply_params td.t_params pl td.t_type);
-				(* prioritize the most generic definition *)
-				tl := t :: !tl;
-			| TLazy f -> loop (lazy_type f)
-			| TMono r -> (match r.tm_type with None -> () | Some t -> loop t)
-			| _ -> tl := t :: !tl)
-		in
-		loop t;
-		!tl
-	in
 	match el with
 	| [] -> spawn_monomorph ctx null_pos
 	| [e] -> e.etype
@@ -207,7 +181,6 @@ let rec unify_min_raise ctx (el:texpr list) : t =
 			| TParenthesis e | TMeta(_,e) -> chk_null e
 			| _ -> false
 		in
-
 		(* First pass: Try normal unification and find out if null is involved. *)
 		let rec loop t = function
 			| [] ->
@@ -254,7 +227,7 @@ let rec unify_min_raise ctx (el:texpr list) : t =
 		with Not_found ->
 			(* Second pass: Get all base types (interfaces, super classes and their interfaces) of most general type.
 			   Then for each additional type filter all types that do not unify. *)
-			let common_types = base_types t in
+			let common_types = UnifyMinT.collect_base_types t in
 			let dyn_types = List.fold_left (fun acc t ->
 				let rec loop c =
 					Meta.has Meta.UnifyMinDynamic c.cl_meta || (match c.cl_super with None -> false | Some (c,_) -> loop c)
@@ -264,23 +237,15 @@ let rec unify_min_raise ctx (el:texpr list) : t =
 					TInst (c,List.map (fun _ -> t_dynamic) params) :: acc
 				| _ -> acc
 			) [] common_types in
-			let common_types = ref (match List.rev dyn_types with [] -> common_types | l -> common_types @ l) in
-			let loop e =
-				let first_error = ref None in
-				let filter t = (try Type.unify e.etype t; true
-					with Unify_error l -> if !first_error = None then first_error := Some(Unify l,e.epos); false)
-				in
-				common_types := List.filter filter !common_types;
-				match !common_types, !first_error with
-				| [], Some(err,p) -> raise_error err p
-				| _ -> ()
-			in
-			match !common_types with
-			| [] ->
-				error "No common base type found" (punion (List.hd el).epos (List.hd (List.rev el)).epos)
-			| _ ->
-				List.iter loop (List.tl el);
-				List.hd !common_types
+			let common_types = (match List.rev dyn_types with [] -> common_types | l -> common_types @ l) in
+			let el = List.tl el in
+			let tl = List.map (fun e -> e.etype) el in
+			begin match UnifyMinT.unify_min' default_unification_context common_types tl with
+			| UnifyMinOk t ->
+				t
+			| UnifyMinError(l,index) ->
+				raise_error (Unify l) (List.nth el index).epos
+			end
 
 let unify_min ctx el =
 	try unify_min_raise ctx el