Jelajahi Sumber

[typer] move overload resolution to its own module

Simon Krajewski 5 tahun lalu
induk
melakukan
4909dd8c64
3 mengubah file dengan 107 tambahan dan 107 penghapusan
  1. 4 4
      src/generators/genjvm.ml
  2. 3 103
      src/generators/genshared.ml
  3. 100 0
      src/typing/overloadResolution.ml

+ 4 - 4
src/generators/genjvm.ml

@@ -1476,7 +1476,7 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return
 		| TField(e1,FStatic(c,({cf_kind = Method (MethNormal | MethInline)} as cf))) ->
 			let c,cf = match cf.cf_overloads with
 				| [] -> c,cf
-				| _ -> match filter_overloads (find_overload (fun t -> t) c cf el) with
+				| _ -> match OverloadResolution.filter_overloads (OverloadResolution.find_overload (fun t -> t) c cf el) with
 					| None ->
 						Error.error "Could not find overload" e1.epos
 					| Some(c,cf,_) ->
@@ -1515,7 +1515,7 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return
 				self#texpr rvalue_any e1;
 				false
 			in
-			begin match find_overload_rec false (apply_params c.cl_params tl) c cf el with
+			begin match OverloadResolution.maybe_resolve_instance_overload false (apply_params c.cl_params tl) c cf el with
 			| None -> Error.error "Could not find overload" e1.epos
 			| Some(c,cf,_) ->
 				let tl,tr = self#call_arguments cf.cf_type el in
@@ -1877,7 +1877,7 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return
 		| TNew(c,tl,el) ->
 			begin match get_constructor (fun cf -> cf.cf_type) c with
 			|_,cf ->
-				begin match find_overload_rec true (apply_params c.cl_params tl) c cf el with
+				begin match OverloadResolution.maybe_resolve_instance_overload true (apply_params c.cl_params tl) c cf el with
 				| None -> Error.error "Could not find overload" e.epos
 				| Some (c',cf,_) ->
 					let f () =
@@ -2238,7 +2238,7 @@ class tclass_to_jvm gctx c = object(self)
 							| TFun(tl,_) -> tl
 							| _ -> die "" __LOC__
 						in
-						begin match find_overload_rec' false map_type c cf.cf_name (List.map (fun (_,_,t) -> Texpr.Builder.make_null t null_pos) tl) with
+						begin match OverloadResolution.resolve_instance_overload false map_type c cf.cf_name (List.map (fun (_,_,t) -> Texpr.Builder.make_null t null_pos) tl) with
 							| Some(_,cf_impl,_) -> check true cf cf_impl
 							| None -> ()
 						end;

+ 3 - 103
src/generators/genshared.ml

@@ -15,107 +15,7 @@ let is_extern_abstract a = match a.a_impl with
 		| ([],("Void" | "Float" | "Int" | "Single" | "Bool" | "Null")) -> true
 		| _ -> false
 
-let unify_cf map_type c cf el =
-	let monos = List.map (fun _ -> mk_mono()) cf.cf_params in
-	match follow (apply_params cf.cf_params monos (map_type cf.cf_type)) with
-		| TFun(tl'',_) as tf ->
-			let rec loop2 acc el tl = match el,tl with
-				| e :: el,(_,o,t) :: tl ->
-					begin try
-						Type.unify e.etype t;
-						loop2 ((e,o) :: acc) el tl
-					with _ ->
-						match t,tl with
-						| TAbstract({a_path=["haxe";"extern"],"Rest"},[t]),[] ->
-							begin try
-								let el = List.map (fun e -> unify t e.etype; e,o) el in
-								Some ((List.rev acc) @ el,tf,(c,cf,monos))
-							with _ ->
-								None
-							end
-						| _ ->
-							None
-					end
-				| [],[] ->
-					Some ((List.rev acc),tf,(c,cf,monos))
-				| _ ->
-					None
-			in
-			loop2 [] el tl''
-		| t ->
-			None
-
-let unify_cf_with_fallback map_type c cf el =
-	match unify_cf map_type c cf el with
-	| Some(_,_,r) -> r
-	| None -> (c,cf,List.map snd cf.cf_params)
-
-let find_overload map_type c cf el =
-	let matches = ref [] in
-	let rec loop cfl = match cfl with
-		| cf :: cfl ->
-			begin match unify_cf map_type c cf el with
-			| Some r -> matches := r :: !matches;
-			| None -> ()
-			end;
-			loop cfl
-		| [] ->
-			List.rev !matches
-	in
-	loop (cf :: cf.cf_overloads)
-
-let filter_overloads candidates =
-	match Overloads.Resolution.reduce_compatible candidates with
-	| [_,_,(c,cf,tl)] -> Some(c,cf,tl)
-	| [] -> None
-	| ((_,_,(c,cf,tl)) :: _) (* as resolved *) ->
-		(* let st = s_type (print_context()) in
-		print_endline (Printf.sprintf "Ambiguous overload for %s(%s)" name (String.concat ", " (List.map (fun e -> st e.etype) el)));
-		List.iter (fun (_,t,(c,cf)) ->
-			print_endline (Printf.sprintf "\tCandidate: %s.%s(%s)" (s_type_path c.cl_path) cf.cf_name (st t));
-		) resolved; *)
-		Some(c,cf,tl)
-
-let find_overload_rec' is_ctor map_type c name el =
-	let candidates = ref [] in
-	let has_function t1 (_,t2,_) =
-		begin match follow t1,t2 with
-		| TFun(tl1,_),TFun(tl2,_) -> type_iseq (TFun(tl1,t_dynamic)) (TFun(tl2,t_dynamic))
-		| _ -> false
-		end
-	in
-	let rec loop map_type c =
-		begin try
-			let cf = if is_ctor then
-				(match c.cl_constructor with Some cf -> cf | None -> raise Not_found)
-			else
-				PMap.find name c.cl_fields
-			in
-			begin match find_overload map_type c cf el with
-			| [] -> raise Not_found
-			| l ->
-				List.iter (fun ((_,t,_) as ca) ->
-					if not (List.exists (has_function t) !candidates) then candidates := ca :: !candidates
-				) l
-			end;
-			if Meta.has Meta.Overload cf.cf_meta || cf.cf_overloads <> [] then raise Not_found
-		with Not_found ->
-			if c.cl_interface then
-				List.iter (fun (c,tl) -> loop (fun t -> apply_params c.cl_params (List.map map_type tl) t) c) c.cl_implements
-			else match c.cl_super with
-			| None -> ()
-			| Some(c,tl) -> loop (fun t -> apply_params c.cl_params (List.map map_type tl) t) c
-		end;
-	in
-	loop map_type c;
-	filter_overloads (List.rev !candidates)
-
-let find_overload_rec is_ctor map_type c cf el =
-	if Meta.has Meta.Overload cf.cf_meta || cf.cf_overloads <> [] then
-		find_overload_rec' is_ctor map_type c cf.cf_name el
-	else match unify_cf map_type c cf el with
-		| Some (_,_,(c,cf,tl)) -> Some (c,cf,tl)
-		| None -> Some(c,cf,List.map snd cf.cf_params)
+open OverloadResolution
 
 type path_field_mapping = {
 	pfm_path : path;
@@ -304,7 +204,7 @@ class ['a] preprocessor (basic : basic_types) (convert : Type.t -> 'a) =
 				| Some(c,tl) -> c,apply_params c.cl_params tl
 				| _ -> die "" __LOC__
 			in
-			match find_overload_rec' true map_type csup "new" el with
+			match resolve_instance_overload true map_type csup "new" el with
 			| Some(c,cf,_) ->
 				let rec loop csup =
 					if c != csup then begin
@@ -377,7 +277,7 @@ class ['a] preprocessor (basic : basic_types) (convert : Type.t -> 'a) =
 					| TFun(tl,_) -> tl
 					| _ -> die "" __LOC__
 				in
-				match find_overload_rec' false map_type csup cf.cf_name (List.map (fun (_,_,t) -> Texpr.Builder.make_null t null_pos) tl) with
+				match resolve_instance_overload false map_type csup cf.cf_name (List.map (fun (_,_,t) -> Texpr.Builder.make_null t null_pos) tl) with
 				| Some(_,cf',_) ->
 					let tr = match follow cf'.cf_type with
 						| TFun(_,tr) -> tr

+ 100 - 0
src/typing/overloadResolution.ml

@@ -0,0 +1,100 @@
+open TType
+open TUnification
+open TFunctions
+
+let unify_cf map_type c cf el =
+	let monos = List.map (fun _ -> mk_mono()) cf.cf_params in
+	match follow (apply_params cf.cf_params monos (map_type cf.cf_type)) with
+		| TFun(tl'',_) as tf ->
+			let rec loop2 acc el tl = match el,tl with
+				| e :: el,(_,o,t) :: tl ->
+					begin try
+						Type.unify e.etype t;
+						loop2 ((e,o) :: acc) el tl
+					with _ ->
+						match t,tl with
+						| TAbstract({a_path=["haxe";"extern"],"Rest"},[t]),[] ->
+							begin try
+								let el = List.map (fun e -> unify t e.etype; e,o) el in
+								Some ((List.rev acc) @ el,tf,(c,cf,monos))
+							with _ ->
+								None
+							end
+						| _ ->
+							None
+					end
+				| [],[] ->
+					Some ((List.rev acc),tf,(c,cf,monos))
+				| _ ->
+					None
+			in
+			loop2 [] el tl''
+		| t ->
+			None
+
+let find_overload map_type c cf el =
+	let matches = ref [] in
+	let rec loop cfl = match cfl with
+		| cf :: cfl ->
+			begin match unify_cf map_type c cf el with
+			| Some r -> matches := r :: !matches;
+			| None -> ()
+			end;
+			loop cfl
+		| [] ->
+			List.rev !matches
+	in
+	loop (cf :: cf.cf_overloads)
+
+let filter_overloads candidates =
+	match Overloads.Resolution.reduce_compatible candidates with
+	| [_,_,(c,cf,tl)] -> Some(c,cf,tl)
+	| [] -> None
+	| ((_,_,(c,cf,tl)) :: _) (* as resolved *) ->
+		(* let st = s_type (print_context()) in
+		print_endline (Printf.sprintf "Ambiguous overload for %s(%s)" name (String.concat ", " (List.map (fun e -> st e.etype) el)));
+		List.iter (fun (_,t,(c,cf)) ->
+			print_endline (Printf.sprintf "\tCandidate: %s.%s(%s)" (s_type_path c.cl_path) cf.cf_name (st t));
+		) resolved; *)
+		Some(c,cf,tl)
+
+let resolve_instance_overload is_ctor map_type c name el =
+	let candidates = ref [] in
+	let has_function t1 (_,t2,_) =
+		begin match follow t1,t2 with
+		| TFun(tl1,_),TFun(tl2,_) -> type_iseq (TFun(tl1,t_dynamic)) (TFun(tl2,t_dynamic))
+		| _ -> false
+		end
+	in
+	let rec loop map_type c =
+		begin try
+			let cf = if is_ctor then
+				(match c.cl_constructor with Some cf -> cf | None -> raise Not_found)
+			else
+				PMap.find name c.cl_fields
+			in
+			begin match find_overload map_type c cf el with
+			| [] -> raise Not_found
+			| l ->
+				List.iter (fun ((_,t,_) as ca) ->
+					if not (List.exists (has_function t) !candidates) then candidates := ca :: !candidates
+				) l
+			end;
+			if Meta.has Meta.Overload cf.cf_meta || cf.cf_overloads <> [] then raise Not_found
+		with Not_found ->
+			if c.cl_interface then
+				List.iter (fun (c,tl) -> loop (fun t -> apply_params c.cl_params (List.map map_type tl) t) c) c.cl_implements
+			else match c.cl_super with
+			| None -> ()
+			| Some(c,tl) -> loop (fun t -> apply_params c.cl_params (List.map map_type tl) t) c
+		end;
+	in
+	loop map_type c;
+	filter_overloads (List.rev !candidates)
+
+let maybe_resolve_instance_overload is_ctor map_type c cf el =
+	if Meta.has Meta.Overload cf.cf_meta || cf.cf_overloads <> [] then
+		resolve_instance_overload is_ctor map_type c cf.cf_name el
+	else match unify_cf map_type c cf el with
+		| Some (_,_,(c,cf,tl)) -> Some (c,cf,tl)
+		| None -> Some(c,cf,List.map snd cf.cf_params)