Browse Source

[typer] clean up unify_call_args a bit

Simon Krajewski 4 years ago
parent
commit
c190c20c30

+ 10 - 6
src/codegen/overloads.ml

@@ -225,15 +225,19 @@ struct
 			"( " ^ (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 count_optionals t =
+		match follow t with
+		| TFun(args,_) ->
+			List.fold_left (fun acc (_,is_optional,_) -> if is_optional then acc + 1 else acc) 0 args
+		| _ ->
+			0
 
 	let rec fewer_optionals acc compatible = match acc, compatible with
 		| _, [] -> acc
 		| [], c :: comp -> fewer_optionals [c] comp
 		| fcc_acc :: _, fcc :: comp ->
-			let acc_opt = count_optionals fcc_acc.fc_args in
-			let comp_opt = count_optionals fcc.fc_args in
+			let acc_opt = count_optionals fcc_acc.fc_type in
+			let comp_opt = count_optionals fcc.fc_type in
 			if acc_opt = comp_opt then
 				fewer_optionals (fcc :: acc) comp
 			else if acc_opt < comp_opt then
@@ -248,8 +252,8 @@ struct
 			(* 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 ->
+				| _ :: elist, (_,true,_) :: args -> mk_rate acc elist args
+				| e :: 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 *)

+ 2 - 2
src/context/typecore.ml

@@ -150,7 +150,7 @@ and monomorphs = {
 type 'a field_call_candidate = {
 	(* The argument expressions for this call and whether or not the argument is optional on the
 	   target function. *)
-	fc_args  : (texpr * bool) list;
+	fc_args  : texpr list;
 	(* The applied return type. *)
 	fc_ret   : Type.t;
 	(* The applied function type. *)
@@ -605,7 +605,7 @@ let make_field_call_candidate args ret monos t cf data = {
 let s_field_call_candidate fcc =
 	let pctx = print_context() in
 	let se = s_expr_pretty false "" false (s_type pctx) in
-	let sl_args = List.map (fun (e,_) -> se e) fcc.fc_args in
+	let sl_args = List.map se fcc.fc_args in
 	Printer.s_record_fields "" [
 		"fc_args",String.concat ", " sl_args;
 		"fc_type",s_type pctx fcc.fc_type;

+ 9 - 14
src/typing/callUnification.ml

@@ -54,7 +54,7 @@ let rec is_pos_infos = function
 	| _ ->
 		false
 
-let rec unify_call_args' ctx el args r callp inline force_inline in_overload =
+let rec unify_call_args ctx el args r callp inline force_inline in_overload =
 	let call_error err p =
 		raise (Error (Call_error err,p))
 	in
@@ -98,7 +98,7 @@ let rec unify_call_args' ctx el args r callp inline force_inline in_overload =
 		| _,[name,false,t] when (match follow t with TAbstract({a_path = ["haxe";"extern"],"Rest"},_) -> true | _ -> false) ->
 			begin match follow t with
 				| TAbstract({a_path=(["haxe";"extern"],"Rest")},[t]) ->
-					(try List.map (fun e -> type_against name t e,false) el with WithTypeError(ul,p) -> arg_error ul name false p)
+					(try List.map (fun e -> type_against name t e) el with WithTypeError(ul,p) -> arg_error ul name false p)
 				| _ ->
 					die "" __LOC__
 			end
@@ -107,11 +107,11 @@ let rec unify_call_args' ctx el args r callp inline force_inline in_overload =
 		| [],(name,true,t) :: args ->
 			begin match loop [] args with
 				| [] when not (inline && (ctx.g.doinline || force_inline)) && not ctx.com.config.pf_pad_nulls ->
-					if is_pos_infos t then [mk_pos_infos t,true]
+					if is_pos_infos t then [mk_pos_infos t]
 					else []
 				| args ->
 					let e_def = default_value name t in
-					(e_def,true) :: args
+					e_def :: args
 			end
 		| (e,p) :: el, [] ->
 			begin match List.rev !skipped with
@@ -126,12 +126,12 @@ let rec unify_call_args' ctx el args r callp inline force_inline in_overload =
 		| e :: el,(name,opt,t) :: args ->
 			begin try
 				let e = type_against name t e in
-				(e,opt) :: loop el args
+				e :: loop el args
 			with
 				WithTypeError (ul,p)->
 					if opt && List.length el < List.length args then
 						let e_def = skip name ul t p in
-						(e_def,true) :: loop (e :: el) args
+						e_def :: loop (e :: el) args
 					else
 						match List.rev !skipped with
 						| [] -> arg_error ul name opt p
@@ -152,10 +152,6 @@ let rec unify_call_args' ctx el args r callp inline force_inline in_overload =
 	restore();
 	el,TFun(args,r)
 
-let unify_call_args ctx el args r p inline force_inline =
-	let el,tf = unify_call_args' ctx el args r p inline force_inline false in
-	List.map fst el,tf
-
 type overload_kind =
 	| OverloadProper (* @:overload or overload *)
 	| OverloadMeta (* @:overload(function() {}) *)
@@ -219,7 +215,7 @@ let unify_field_call ctx fa el_typed el p inline =
 						let call_error = Call_error(Could_not_unify msg) in
 						raise(Error(call_error,p))
 					end;
-					loop ((e,opt) :: acc_el) (arg :: acc_args) (fun t -> t) args el_typed
+					loop (e :: acc_el) (arg :: acc_args) (fun t -> t) args el_typed
 				| [],_ :: _ ->
 					let call_error = Call_error(Too_many_arguments) in
 					raise(Error(call_error,p))
@@ -227,12 +223,11 @@ let unify_field_call ctx fa el_typed el p inline =
 					List.rev acc_el,List.rev acc_args,args
 			in
 			let el_typed,args_typed,args = loop [] [] tmap args el_typed in
-			let el,_ = unify_call_args' ctx el args ret p inline is_forced_inline in_overload in
+			let el,_ = unify_call_args ctx el args ret p inline is_forced_inline in_overload in
 			let el = el_typed @ el in
 			let tf = TFun(args_typed @ args,ret) in
 			let mk_call () =
 				let ef = mk (TField(fa.fa_on,FieldAccess.apply_fa cf fa.fa_host)) t fa.fa_pos in
-				let el = List.map fst el in
 				!make_call_ref ctx ef el ret ~force_inline:inline p
 			in
 			make_field_call_candidate el ret monos tf cf (mk_call,extract_delayed_display())
@@ -423,7 +418,7 @@ object(self)
 		check_assign();
 		let rec loop t = match follow t with
 		| TFun (args,r) ->
-			let el, tfunc = unify_call_args ctx el args r p false false in
+			let el, tfunc = unify_call_args ctx el args r p false false false in
 			let r = match tfunc with TFun(_,r) -> r | _ -> die "" __LOC__ in
 			mk (TCall (e,el)) r p
 		| TAbstract(a,tl) when Meta.has Meta.Callable a.a_meta ->

+ 1 - 1
src/typing/generic.ml

@@ -360,7 +360,7 @@ let type_generic_function ctx fa el_typed el with_type p =
 		| TMono m -> safe_mono_close ctx m p
 		| _ -> ()
 	) monos;
-	let el = List.map fst fcc.fc_args in
+	let el = fcc.fc_args in
 	(try
 		let gctx = make_generic ctx cf.cf_params monos p in
 		let name = cf.cf_name ^ "_" ^ gctx.name in

+ 2 - 2
src/typing/macroContext.ml

@@ -685,7 +685,7 @@ let type_macro ctx mode cpath f (el:Ast.expr list) p =
 			incr index;
 			(EArray ((EArrayDecl [e],p),(EConst (Int (string_of_int (!index))),p)),p)
 		) el in
-		let elt = fst (CallUnification.unify_call_args mctx constants (List.map fst eargs) t_dynamic p false false) in
+		let elt = fst (CallUnification.unify_call_args mctx constants (List.map fst eargs) t_dynamic p false false false) in
 		List.map2 (fun (_,mct) e ->
 			let e, et = (match e.eexpr with
 				(* get back our index and real expression *)
@@ -757,7 +757,7 @@ let type_macro ctx mode cpath f (el:Ast.expr list) p =
 let call_macro ctx path meth args p =
 	let mctx, (margs,_,mclass,mfield), call = load_macro ctx false path meth p in
 	mctx.curclass <- null_class;
-	let el, _ = CallUnification.unify_call_args mctx args margs t_dynamic p false false in
+	let el, _ = CallUnification.unify_call_args mctx args margs t_dynamic p false false false in
 	call (List.map (fun e -> try Interp.make_const e with Exit -> error "Parameter should be a constant" e.epos) el)
 
 let call_init_macro ctx e =

+ 2 - 2
src/typing/overloadResolution.ml

@@ -11,12 +11,12 @@ let unify_cf map_type c cf el =
 				| e :: el,(_,o,t) :: tl ->
 					begin try
 						Type.unify e.etype t;
-						loop2 ((e,o) :: acc) el tl
+						loop2 (e :: 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
+								let el = List.map (fun e -> unify t e.etype; e) el in
 								let fcc = make_field_call_candidate ((List.rev acc) @ el) ret monos tf cf (c,cf,monos) in
 								Some fcc
 							with _ ->

+ 3 - 3
src/typing/typer.ml

@@ -999,7 +999,7 @@ and type_new ctx path el with_type force_inline p =
 		| None ->
 			raise_error (No_constructor (TClassDecl c)) p
 		| Some(tl,tr) ->
-			let el,_ = unify_call_args ctx el tl tr p false false in
+			let el,_ = unify_call_args ctx el tl tr p false false false in
 			mk (TNew (c,params,el)) t p
 		end
 	| TAbstract({a_impl = Some c} as a,tl) when not (Meta.has Meta.MultiType a.a_meta) ->
@@ -1007,7 +1007,7 @@ and type_new ctx path el with_type force_inline p =
 		{ (fcc.fc_data()) with etype = t }
 	| TInst (c,params) | TAbstract({a_impl = Some c},params) ->
 		let fcc = build_constructor_call None c params in
-		let el = List.map fst fcc.fc_args in
+		let el = fcc.fc_args in
 		mk (TNew (c,params,el)) t p
 	| _ ->
 		error (s_type (print_context()) t ^ " cannot be constructed") p
@@ -1638,7 +1638,7 @@ and type_call ?(mode=MGet) ctx e el (with_type:WithType.t) inline p =
 			if (Meta.has Meta.CompilerGenerated cf.cf_meta) then display_error ctx (error_msg (No_constructor (TClassDecl c))) p;
 			let fa = FieldAccess.create e cf (FHInstance(c,params)) false p in
 			let fcc = unify_field_call ctx fa [] el p false in
-			let el = List.map fst fcc.fc_args in
+			let el = fcc.fc_args in
 			el,t
 		) in
 		mk (TCall (mk (TConst TSuper) t sp,el)) ctx.t.tvoid p

+ 1 - 1
src/typing/typerDisplay.ml

@@ -209,7 +209,7 @@ let rec handle_signature_display ctx e_ast with_type =
 			| (t,doc,values) :: tl ->
 				let keep (args,r) =
 					begin try
-						let _ = unify_call_args' ctx el args r p false false false in
+						let _ = unify_call_args ctx el args r p false false false in
 						true
 					with
 					| Error(Call_error (Not_enough_arguments _),_) -> true