open Type

let same_overload_args ?(get_vmtype) t1 t2 f1 f2 =
	let get_vmtype = match get_vmtype with
		| None -> (fun f -> f)
		| Some f -> f
	in
	if List.length f1.cf_params <> List.length f2.cf_params then
		false
	else
	let rec follow_skip_null t = match t with
		| TMono r ->
			(match !r with
			| Some t -> follow_skip_null t
			| _ -> t)
		| TLazy f ->
			follow_skip_null (!f())
		| TType ({ t_path = [],"Null" } as t, [p]) ->
			TType(t,[follow p])
		| TType (t,tl) ->
			follow_skip_null (apply_params t.t_params tl t.t_type)
		| _ -> t
	in
	let same_arg t1 t2 =
		let t1 = get_vmtype (follow_skip_null t1) in
		let t2 = get_vmtype (follow_skip_null t2) in
		match t1, t2 with
			| TType _, TType _ -> type_iseq t1 t2
			| TType _, _
			| _, TType _ -> false
			| _ -> type_iseq t1 t2
	in

	match follow (apply_params f1.cf_params (List.map (fun (_,t) -> t) f2.cf_params) t1), follow t2 with
		| TFun(a1,_), TFun(a2,_) ->
			(try
				List.for_all2 (fun (_,_,t1) (_,_,t2) ->
				same_arg t1 t2) a1 a2
			with | Invalid_argument("List.for_all2") ->
				false)
		| _ -> assert false


(** retrieves all overloads from class c and field i, as (Type.t * tclass_field) list *)
let rec get_overloads c i =
	let ret = try
			let f = PMap.find i c.cl_fields in
			match f.cf_kind with
				| Var _ ->
					(* @:libType may generate classes that have a variable field in a superclass of an overloaded method *)
					[]
				| Method _ ->
					(f.cf_type, f) :: (List.map (fun f -> f.cf_type, f) f.cf_overloads)
		with | Not_found -> []
	in
	let rsup = match c.cl_super with
	| None when c.cl_interface ->
			let ifaces = List.concat (List.map (fun (c,tl) ->
				List.map (fun (t,f) -> apply_params c.cl_params tl t, f) (get_overloads c i)
			) c.cl_implements) in
			ret @ ifaces
	| None -> ret
	| Some (c,tl) ->
			ret @ ( List.map (fun (t,f) -> apply_params c.cl_params tl t, f) (get_overloads c i) )
	in
	ret @ (List.filter (fun (t,f) -> not (List.exists (fun (t2,f2) -> same_overload_args t t2 f f2) ret)) rsup)

(** Overload resolution **)
module Resolution =
struct
	let rec simplify_t t = match t with
		| TAbstract(a,_) when Meta.has Meta.CoreType a.a_meta ->
			t
		| TInst _ | TEnum _ ->
			t
		| TAbstract(a,tl) -> simplify_t (Abstract.get_underlying_type a tl)
		| TType(({ t_path = [],"Null" } as t), [t2]) -> (match simplify_t t2 with
			| (TAbstract(a,_) as t2) when Meta.has Meta.CoreType a.a_meta ->
				TType(t, [simplify_t t2])
			| (TEnum _ as t2) ->
				TType(t, [simplify_t t2])
			| t2 -> t2)
		| TType(t, tl) ->
			simplify_t (apply_params t.t_params tl t.t_type)
		| TMono r -> (match !r with
			| Some t -> simplify_t t
			| None -> t_dynamic)
		| TAnon _ -> t_dynamic
		| TDynamic _ -> t
		| TLazy f -> simplify_t (!f())
		| TFun _ -> t

	(* rate type parameters *)
	let rate_tp tlfun tlarg =
		let acc = ref 0 in
		List.iter2 (fun f a -> if not (type_iseq f a) then incr acc) tlfun tlarg;
		!acc

	(**
		The rate function returns an ( int * int ) type.
		The smaller the int, the best rated the caller argument is in comparison with the callee.

		The first int refers to how many "conversions" would be necessary to convert from the callee to the caller type, and
		the second refers to the type parameters.
	**)
	let rec rate_conv cacc tfun targ =
		match simplify_t tfun, simplify_t targ with
		| TInst({ cl_interface = true } as cf, tlf), TInst(ca, tla) ->
			(* breadth-first *)
			let stack = ref [0,ca,tla] in
			let cur = ref (0, ca,tla) in
			let rec loop () =
				match !stack with
				| [] -> (let acc, ca, tla = !cur in match ca.cl_super with
					| None -> raise Not_found
					| Some (sup,tls) ->
						cur := (acc+1,sup,List.map (apply_params ca.cl_params tla) tls);
						stack := [!cur];
						loop())
				| (acc,ca,tla) :: _ when ca == cf ->
					acc,tla
				| (acc,ca,tla) :: s ->
					stack := s @ List.map (fun (c,tl) -> (acc+1,c,List.map (apply_params ca.cl_params tla) tl)) ca.cl_implements;
					loop()
			in
			let acc, tla = loop() in
			(cacc + acc, rate_tp tlf tla)
		| TInst(cf,tlf), TInst(ca,tla) ->
			let rec loop acc ca tla =
				if cf == ca then
					acc, tla
				else match ca.cl_super with
				| None -> raise Not_found
				| Some(sup,stl) ->
					loop (acc+1) sup (List.map (apply_params ca.cl_params tla) stl)
			in
			let acc, tla = loop 0 ca tla in
			(cacc + acc, rate_tp tlf tla)
		| TEnum(ef,tlf), TEnum(ea, tla) ->
			if ef != ea then raise Not_found;
			(cacc, rate_tp tlf tla)
		| TDynamic _, TDynamic _ ->
			(cacc, 0)
		| TDynamic _, _ ->
			(max_int, 0) (* a function with dynamic will always be worst of all *)
		| TAbstract(a, _), TDynamic _ when Meta.has Meta.CoreType a.a_meta ->
			(cacc + 2, 0) (* a dynamic to a basic type will have an "unboxing" penalty *)
		| _, TDynamic _ ->
			(cacc + 1, 0)
		| TAbstract(af,tlf), TAbstract(aa,tla) ->
			(if af == aa then
				(cacc, rate_tp tlf tla)
			else
				let ret = ref None in
				if List.exists (fun t -> try
					ret := Some (rate_conv (cacc+1) (apply_params af.a_params tlf t) targ);
					true
				with | Not_found ->
					false
				) af.a_from then
					Option.get !ret
			else
				if List.exists (fun t -> try
					ret := Some (rate_conv (cacc+1) tfun (apply_params aa.a_params tla t));
					true
				with | Not_found ->
					false
				) aa.a_to then
					Option.get !ret
			else
				raise Not_found)
		| TType({ t_path = [], "Null" }, [tf]), TType({ t_path = [], "Null" }, [ta]) ->
			rate_conv (cacc+0) tf ta
		| TType({ t_path = [], "Null" }, [tf]), ta ->
			rate_conv (cacc+1) tf ta
		| tf, TType({ t_path = [], "Null" }, [ta]) ->
			rate_conv (cacc+1) tf ta
		| TFun _, TFun _ -> (* unify will make sure they are compatible *)
			cacc,0
		| tfun,targ ->
			raise Not_found

	let is_best arg1 arg2 =
		(List.for_all2 (fun v1 v2 ->
			v1 <= v2)
		arg1 arg2) && (List.exists2 (fun v1 v2 ->
			v1 < v2)
		arg1 arg2)

	let rec rm_duplicates acc ret = match ret with
		| [] -> acc
		| ( el, t, _ ) :: ret when List.exists (fun (_,t2,_) -> type_iseq t t2) acc ->
			rm_duplicates acc ret
		| r :: ret ->
			rm_duplicates (r :: acc) ret

	let s_options rated =
		String.concat ",\n" (List.map (fun ((elist,t,_),rate) ->
			"( " ^ (String.concat "," (List.map (fun(e,_) -> s_expr (s_type (print_context())) e) elist)) ^ " ) => " ^
			"( " ^ (String.concat "," (List.map (fun (i,i2) -> string_of_int i ^ ":" ^ string_of_int i2) rate)) ^ " ) => " ^ (s_type (print_context()) t)
		) rated)

	let count_optionals elist =
		List.fold_left (fun acc (_,is_optional) -> if is_optional then acc + 1 else acc) 0 elist

	let rec fewer_optionals acc compatible = match acc, compatible with
		| _, [] -> acc
		| [], c :: comp -> fewer_optionals [c] comp
		| (elist_acc, _, _) :: _, ((elist, _, _) as cur) :: comp ->
			let acc_opt = count_optionals elist_acc in
			let comp_opt = count_optionals elist in
			if acc_opt = comp_opt then
				fewer_optionals (cur :: acc) comp
			else if acc_opt < comp_opt then
				fewer_optionals acc comp
			else
				fewer_optionals [cur] comp

	let reduce_compatible compatible = match fewer_optionals [] (rm_duplicates [] compatible) with
		| [] -> []
		| [v] -> [v]
		| compatible ->
			(* convert compatible into ( rate * compatible_type ) list *)
			let rec mk_rate acc elist args = match elist, args with
				| [], [] -> acc
				| (_,true) :: elist, _ :: args -> mk_rate acc elist args
				| (e,false) :: elist, (n,o,t) :: args ->
					(* if the argument is an implicit cast, we need to start with a penalty *)
					(* The penalty should be higher than any other implicit cast - other than Dynamic *)
					(* since Dynamic has a penalty of max_int, we'll impose max_int - 1 to it *)
					(match e.eexpr with
						| TMeta( (Meta.ImplicitCast,_,_), _) ->
							mk_rate ((max_int - 1, 0) :: acc) elist args
						| _ ->
							mk_rate (rate_conv 0 t e.etype :: acc) elist args)
				| _ -> assert false
			in

			let rated = ref [] in
			List.iter (function
				| (elist,TFun(args,ret),d) -> (try
					rated := ( (elist,TFun(args,ret),d), mk_rate [] elist args ) :: !rated
					with | Not_found -> ())
				| _ -> assert false
			) compatible;

			let rec loop best rem = match best, rem with
				| _, [] -> best
				| [], r1 :: rem -> loop [r1] rem
				| (bover, bargs) :: b1, (rover, rargs) :: rem ->
					if is_best bargs rargs then
						loop best rem
					else if is_best rargs bargs then
						loop (loop b1 [rover,rargs]) rem
					else (* equally specific *)
						loop ( (rover,rargs) :: best ) rem
			in

			let r = loop [] !rated in
			List.map fst r
end