Move function argument handling into functionArguments.ml (#9786)

* [typer] factor out function argument handling into functionArguments.ml

* [typer] fix extern name checking

* [typer] clean up

src/typing/functionArguments.ml

@@ -0,0 +1,153 @@
+open Globals
+open Ast
+open Type
+open Typecore
+open Error
+
+let type_opt ctx is_core_api p t =
+	let c = ctx.curclass in
+	match t with
+	| None when (has_class_flag c CExtern) || (has_class_flag c CInterface) ->
+		display_error ctx "Type required for extern classes and interfaces" p;
+		t_dynamic
+	| None when is_core_api ->
+		display_error ctx "Type required for core api classes" p;
+		t_dynamic
+	| _ ->
+		Typeload.load_type_hint ctx p t
+
+let type_function_arg ctx t e opt p =
+	(* TODO https://github.com/HaxeFoundation/haxe/issues/8461 *)
+	(* delay ctx PTypeField (fun() ->
+		if ExtType.is_void (follow t) then
+			error "Arguments of type Void are not allowed" p
+	); *)
+	if opt then
+		let e = (match e with None -> Some (EConst (Ident "null"),null_pos) | _ -> e) in
+		ctx.t.tnull t, e
+	else
+		let t = match e with Some (EConst (Ident "null"),null_pos) -> ctx.t.tnull t | _ -> t in
+		t, e
+
+let type_function_arg_value ctx t c do_display =
+	match c with
+		| None -> None
+		| Some e ->
+			let p = pos e in
+			let e = if do_display then Display.ExprPreprocessing.process_expr ctx.com e else e in
+			let e = ctx.g.do_optimize ctx (type_expr ctx e (WithType.with_type t)) in
+			unify ctx e.etype t p;
+			let rec loop e = match e.eexpr with
+				| TConst _ -> Some e
+				| TField({eexpr = TTypeExpr _},FEnum _) -> Some e
+				| TField({eexpr = TTypeExpr _},FStatic({cl_kind = KAbstractImpl a},cf)) when a.a_enum && has_class_field_flag cf CfEnum -> Some e
+				| TCast(e,None) -> loop e
+				| _ ->
+					if ctx.com.display.dms_kind = DMNone || ctx.com.display.dms_inline && ctx.com.display.dms_error_policy = EPCollect then
+						display_error ctx "Parameter default value should be constant" p;
+					None
+			in
+			loop e
+
+class function_arguments
+	(ctx : typer)
+	(type_arg : bool -> type_hint option -> pos -> Type.t)
+	(is_extern : bool)
+	(do_display : bool)
+	(abstract_this : Type.t option)
+	(syntax : (placed_name * bool * metadata * type_hint option * expr option) list)
+=
+	let with_default =
+		let l = List.map (fun ((name,pn),opt,m,t,eo) ->
+			let t = type_arg opt t pn in
+			let t,eo = type_function_arg ctx t eo opt pn in
+			(name,eo,t)
+		) syntax in
+		let l = match abstract_this with
+			| None ->
+				l
+			| Some t ->
+				("this",None,t) :: l
+		in
+		l
+	in
+
+object(self)
+
+	val mutable type_repr = None
+	val mutable expr_repr = None
+
+	(* Returns the `(string * bool * Type.t) list` requires by `TFun` .*)
+	method for_type = match type_repr with
+		| Some l ->
+			l
+		| None ->
+			let l = List.map (fun (n,eo,t) -> n,eo <> None,t) with_default in
+			type_repr <- Some l;
+			l
+
+	method private check_rest (is_last : bool) (eo : expr option) (opt : bool) (t : Type.t) (pn : pos) =
+		match follow t with
+			| TAbstract({a_path = ["haxe";"extern"],"Rest"},_) ->
+				if not is_extern then error "Rest argument are only supported for extern methods" pn;
+				if opt then error "Rest argument cannot be optional" pn;
+				begin match eo with None -> () | Some (_,p) -> error "Rest argument cannot have default value" p end;
+				if not is_last then error "Rest should only be used for the last function argument" pn;
+			| _ ->
+				()
+
+	(* Returns the `(tvar * texpr option) list` for `tf_args`. Also checks the validity of argument names and whether or not
+	   an argument should be displayed. *)
+	method for_expr = match expr_repr with
+		| Some l ->
+			l
+		| None ->
+			let make_local name t meta pn =
+				let v = alloc_var (VUser TVOArgument) name t pn in
+				v.v_meta <- v.v_meta @ meta;
+				v
+			in
+			let rec loop acc is_abstract_this syntax typed = match syntax,typed with
+				| syntax,(name,_,t) :: typed when is_abstract_this ->
+					let v = make_local name t [] null_pos in
+					v.v_meta <- (Meta.This,[],null_pos) :: v.v_meta;
+					loop ((v,None) :: acc) false syntax typed
+				| ((_,pn),opt,m,_,_) :: syntax,(name,eo,t) :: typed ->
+					delay ctx PTypeField (fun() -> self#check_rest (typed = []) eo opt t pn);
+					if not is_extern then check_local_variable_name ctx name TVOArgument pn;
+					let eo = type_function_arg_value ctx t eo do_display in
+					let v = make_local name t m pn in
+					if do_display && DisplayPosition.display_position#enclosed_in pn then
+						DisplayEmitter.display_variable ctx v pn;
+					loop ((v,eo) :: acc) false syntax typed
+				| [],[] ->
+					List.rev acc
+				| _ ->
+					die "" __LOC__
+			in
+			let l = loop [] (abstract_this <> None) syntax with_default in
+			expr_repr <- Some l;
+			l
+
+	(* Verifies the validity of any argument typed as `haxe.extern.Rest` and checks default values. *)
+	method verify_extern =
+		let rec loop is_abstract_this syntax typed = match syntax,typed with
+			| syntax,(name,_,t) :: typed when is_abstract_this ->
+				loop false syntax typed
+			| ((_,pn),opt,m,_,_) :: syntax,(name,eo,t) :: typed ->
+				delay ctx PTypeField (fun() -> self#check_rest (typed = []) eo opt t pn);
+				ignore(type_function_arg_value ctx t eo do_display);
+				loop false syntax typed
+			| [],[] ->
+				()
+			| _ ->
+				die "" __LOC__
+		in
+		loop (abstract_this <> None) syntax with_default
+
+	(* Brings arguments into context by adding them to `ctx.locals`. *)
+	method bring_into_context =
+		List.iter (fun (v,_) ->
+			ctx.locals <- PMap.add v.v_name v ctx.locals
+		) self#for_expr
+end

src/typing/typeloadFields.ml

@@ -637,18 +637,6 @@ let rec get_parent c name =
 		with
 			Not_found -> get_parent csup name
 
-let type_opt (ctx,cctx) p t =
-	let c = cctx.tclass in
-	match t with
-	| None when (has_class_flag c CExtern) || (has_class_flag c CInterface) ->
-		display_error ctx "Type required for extern classes and interfaces" p;
-		t_dynamic
-	| None when cctx.is_core_api ->
-		display_error ctx "Type required for core api classes" p;
-		t_dynamic
-	| _ ->
-		load_type_hint ctx p t
-
 let transform_field (ctx,cctx) c f fields p =
 	let f = match cctx.abstract with
 		| Some a ->
@@ -898,7 +886,7 @@ module TypeBinding = struct
 		| Some e ->
 			bind_var_expression ctx cctx fctx cf e
 
-	let bind_method ctx cctx fctx cf t args ret fargs e p =
+	let bind_method ctx cctx fctx cf t args ret e p =
 		let c = cctx.tclass in
 		let bind r =
 			r := lazy_processing (fun() -> t);
@@ -907,10 +895,7 @@ module TypeBinding = struct
 			if ctx.com.verbose then Common.log ctx.com ("Typing " ^ (if ctx.in_macro then "macro " else "") ^ s_type_path c.cl_path ^ "." ^ cf.cf_name);
 			let fmode = (match cctx.abstract with
 				| Some _ ->
-					(match args with
-					| ("this",_,_) :: _ -> FunMemberAbstract
-					| _ when cf.cf_name = "_new" -> FunMemberAbstract
-					| _ -> FunStatic)
+					if fctx.is_abstract_member then FunMemberAbstract else FunStatic
 				| None ->
 					if fctx.field_kind = FKConstructor then FunConstructor else if fctx.is_static then FunStatic else FunMember
 			) in
@@ -922,7 +907,7 @@ module TypeBinding = struct
 					cf.cf_type <- t
 				| _ ->
 					if Meta.has Meta.DisplayOverride cf.cf_meta then DisplayEmitter.check_field_modifiers ctx c cf fctx.override fctx.display_modifier;
-					let e , fargs = TypeloadFunction.type_function ctx args fargs ret fmode e fctx.is_display_field p in
+					let e = TypeloadFunction.type_function ctx args ret fmode e fctx.is_display_field p in
 					begin match fctx.field_kind with
 					| FKNormal when not fctx.is_static -> TypeloadCheck.check_overriding ctx c cf
 					| _ -> ()
@@ -932,7 +917,7 @@ module TypeBinding = struct
 						if v.v_name <> "_" && has_mono v.v_type then ctx.com.warning "Uninferred function argument, please add a type-hint" v.v_pos;
 					) fargs; *)
 					let tf = {
-						tf_args = fargs;
+						tf_args = args#for_expr;
 						tf_type = ret;
 						tf_expr = e;
 					} in
@@ -1202,33 +1187,17 @@ let create_method (ctx,cctx,fctx) c f fd p =
 
 	ctx.type_params <- if fctx.is_static && not fctx.is_abstract_member then params else params @ ctx.type_params;
 	(* TODO is_lib: avoid forcing the return type to be typed *)
-	let ret = if fctx.field_kind = FKConstructor then ctx.t.tvoid else type_opt (ctx,cctx) p fd.f_type in
-	let rec loop args = match args with
-		| ((name,p),opt,m,t,ct) :: args ->
-			(* TODO is_lib: avoid forcing the field to be typed *)
-			let t, ct = TypeloadFunction.type_function_arg ctx (type_opt (ctx,cctx) p t) ct opt p in
-			delay ctx PTypeField (fun() -> match follow t with
-				| TAbstract({a_path = ["haxe";"extern"],"Rest"},_) ->
-					if not fctx.is_extern && not (has_class_flag c CExtern) then error "Rest argument are only supported for extern methods" p;
-					if opt then error "Rest argument cannot be optional" p;
-					begin match ct with None -> () | Some (_,p) -> error "Rest argument cannot have default value" p end;
-					if args <> [] then error "Rest should only be used for the last function argument" p;
-				| _ ->
-					()
-			);
-			(name, ct, t) :: (loop args)
-		| [] ->
-			[]
-	in
-	let args = loop fd.f_args in
-	let fargs = TypeloadFunction.convert_fargs fd in
-	let args,fargs = match cctx.abstract with
+	let ret = if fctx.field_kind = FKConstructor then ctx.t.tvoid else FunctionArguments.type_opt ctx cctx.is_core_api p fd.f_type in
+	let abstract_this = match cctx.abstract with
 		| Some a when fctx.is_abstract_member && fst f.cff_name <> "_new" (* TODO: this sucks *) && not fctx.is_macro ->
-			("this",None,a.a_this) :: args,(null_pos,[]) :: fargs
+			Some a.a_this
 		| _ ->
-			args,fargs
+			None
 	in
-	let t = TFun (fun_args args,ret) in
+	let is_extern = fctx.is_extern || has_class_flag ctx.curclass CExtern in
+	let type_arg opt t p = FunctionArguments.type_opt ctx cctx.is_core_api p t in
+	let args = new FunctionArguments.function_arguments ctx type_arg is_extern fctx.is_display_field abstract_this fd.f_args in
+	let t = TFun (args#for_type,ret) in
 	let cf = {
 		(mk_field (fst f.cff_name) ~public:(is_public (ctx,cctx) f.cff_access parent) t f.cff_pos (pos f.cff_name)) with
 		cf_doc = f.cff_doc;
@@ -1267,24 +1236,16 @@ let create_method (ctx,cctx,fctx) c f fd p =
 	init_meta_overloads ctx (Some c) cf;
 	ctx.curfield <- cf;
 	if fctx.do_bind then
-		TypeBinding.bind_method ctx cctx fctx cf t args ret fargs fd.f_expr (match fd.f_expr with Some e -> snd e | None -> f.cff_pos)
+		TypeBinding.bind_method ctx cctx fctx cf t args ret fd.f_expr (match fd.f_expr with Some e -> snd e | None -> f.cff_pos)
 	else begin
-		delay ctx PTypeField (fun () ->
-			(* We never enter type_function so we're missing out on the argument processing there. Let's do it here. *)
-			List.iter2 (fun (n,ct,t) (pn,m) ->
-				(* dirty dodge to avoid flash extern problems until somebody fixes that *)
-				begin if ctx.com.platform = Flash && (has_class_flag c CExtern) then
-					()
-				else
-					ignore(TypeloadFunction.process_function_arg ctx n t ct fctx.is_display_field (not (has_class_flag c CExtern) && not fctx.is_extern) pn)
-				end;
-				if fctx.is_display_field && DisplayPosition.display_position#enclosed_in pn then begin
-					let v = add_local_with_origin ctx TVOArgument n t pn in
-					DisplayEmitter.display_variable ctx v pn;
-				end
-			) args fargs;
-		);
-		check_field_display ctx fctx c cf;
+		if fctx.is_display_field then begin
+			delay ctx PTypeField (fun () ->
+				(* We never enter type_function so we're missing out on the argument processing there. Let's do it here. *)
+				ignore(args#for_expr)
+			);
+			check_field_display ctx fctx c cf;
+		end else
+			delay ctx PTypeField (fun () -> args#verify_extern);
 		if fd.f_expr <> None then begin
 			if fctx.is_abstract then display_error ctx "Abstract methods may not have an expression" p
 			else if not (fctx.is_inline || fctx.is_macro) then ctx.com.warning "Extern non-inline function may not have an expression" p;

src/typing/typeloadFunction.ml

@@ -27,19 +27,7 @@ open DisplayTypes.DisplayMode
 open DisplayException
 open Common
 open Error
-
-let type_function_arg ctx t e opt p =
-	(* TODO https://github.com/HaxeFoundation/haxe/issues/8461 *)
-	(* delay ctx PTypeField (fun() ->
-		if ExtType.is_void (follow t) then
-			error "Arguments of type Void are not allowed" p
-	); *)
-	if opt then
-		let e = (match e with None -> Some (EConst (Ident "null"),null_pos) | _ -> e) in
-		ctx.t.tnull t, e
-	else
-		let t = match e with Some (EConst (Ident "null"),null_pos) -> ctx.t.tnull t | _ -> t in
-		t, e
+open FunctionArguments
 
 let save_field_state ctx =
 	let old_ret = ctx.ret in
@@ -62,48 +50,13 @@ let type_function_params ctx fd fname p =
 	params := Typeload.type_type_params ctx ([],fname) (fun() -> !params) p fd.f_params;
 	!params
 
-let type_function_arg_value ctx t c do_display =
-	match c with
-		| None -> None
-		| Some e ->
-			let p = pos e in
-			let e = if do_display then Display.ExprPreprocessing.process_expr ctx.com e else e in
-			let e = ctx.g.do_optimize ctx (type_expr ctx e (WithType.with_type t)) in
-			unify ctx e.etype t p;
-			let rec loop e = match e.eexpr with
-				| TConst _ -> Some e
-				| TField({eexpr = TTypeExpr _},FEnum _) -> Some e
-				| TField({eexpr = TTypeExpr _},FStatic({cl_kind = KAbstractImpl a},cf)) when a.a_enum && has_class_field_flag cf CfEnum -> Some e
-				| TCast(e,None) -> loop e
-				| _ ->
-					if ctx.com.display.dms_kind = DMNone || ctx.com.display.dms_inline && ctx.com.display.dms_error_policy = EPCollect then
-						display_error ctx "Parameter default value should be constant" p;
-					None
-			in
-			loop e
-
-let process_function_arg ctx n t c do_display check_name p =
-	if check_name && starts_with n '$' then error "Function argument names starting with a dollar are not allowed" p;
-	type_function_arg_value ctx t c do_display
-
-let convert_fargs fd =
-	List.map (fun ((_,pn),_,m,_,_) -> (pn,m)) fd.f_args
-
-let type_function ctx args fargs ret fmode e do_display p =
-	let fargs = List.map2 (fun (n,c,t) (pn,m) ->
-		let c = process_function_arg ctx n t c do_display true pn in
-		let v = add_local_with_origin ctx TVOArgument n t pn in
-		v.v_meta <- v.v_meta @ m;
-		if do_display && DisplayPosition.display_position#enclosed_in pn then
-			DisplayEmitter.display_variable ctx v pn;
-		if n = "this" then v.v_meta <- (Meta.This,[],null_pos) :: v.v_meta;
-		v,c
-	) args fargs in
+let type_function ctx (args : function_arguments) ret fmode e do_display p =
 	ctx.in_function <- true;
 	ctx.curfun <- fmode;
 	ctx.ret <- ret;
 	ctx.opened <- [];
 	ctx.monomorphs.perfunction <- [];
+	args#bring_into_context;
 	let e = match e with
 		| None ->
 			if ctx.com.display.dms_error_policy = EPIgnore then
@@ -219,11 +172,11 @@ let type_function ctx args fargs ret fmode e do_display p =
 	List.iter (fun r -> r := Closed) ctx.opened;
 	List.iter (fun (m,p) -> safe_mono_close ctx m p) ctx.monomorphs.perfunction;
 	if is_position_debug then print_endline ("typing:\n" ^ (Texpr.dump_with_pos "" e));
-	e , fargs
+	e
 
-let type_function ctx args fargs ret fmode e do_display p =
+let type_function ctx args ret fmode e do_display p =
 	let save = save_field_state ctx in
-	Std.finally save (type_function ctx args fargs ret fmode e do_display) p
+	Std.finally save (type_function ctx args ret fmode e do_display) p
 
 let add_constructor ctx c force_constructor p =
 	let super() =

src/typing/typer.ml

@@ -1183,21 +1183,19 @@ and type_local_function ctx kind f with_type p =
 	ctx.type_params <- params @ ctx.type_params;
 	if not inline then ctx.in_loop <- false;
 	let rt = Typeload.load_type_hint ctx p f.f_type in
-	let args = List.map (fun ((s,_),opt,_,t,c) ->
-		let t = Typeload.load_type_hint ctx p t in
-		let t, c = TypeloadFunction.type_function_arg ctx t c opt p in
-		s, c, t
-	) f.f_args in
+	let type_arg opt t p = Typeload.load_type_hint ~opt ctx p t in
+	let args = new FunctionArguments.function_arguments ctx type_arg false ctx.in_display None f.f_args in
+	let targs = args#for_type in
 	(match with_type with
 	| WithType.WithType(t,_) ->
 		let rec loop t =
 			(match follow t with
-			| TFun (args2,tr) when List.length args2 = List.length args ->
+			| TFun (args2,tr) when List.length args2 = List.length targs ->
 				List.iter2 (fun (_,_,t1) (_,_,t2) ->
 					match follow t1 with
 					| TMono _ -> unify ctx t2 t1 p
 					| _ -> ()
-				) args args2;
+				) targs args2;
 				(* unify for top-down inference unless we are expecting Void *)
 				begin
 					match follow tr,follow rt with
@@ -1214,7 +1212,7 @@ and type_local_function ctx kind f with_type p =
 		if name = None then display_error ctx "Unnamed lvalue functions are not supported" p
 	| _ ->
 		());
-	let ft = TFun (fun_args args,rt) in
+	let ft = TFun (targs,rt) in
 	let v = (match v with
 		| None -> None
 		| Some v ->
@@ -1228,12 +1226,11 @@ and type_local_function ctx kind f with_type p =
 		| FunMemberAbstractLocal -> FunMemberAbstractLocal
 		| _ -> FunMemberClassLocal
 	in
-	let fargs = TypeloadFunction.convert_fargs f in
-	let e , fargs = TypeloadFunction.type_function ctx args fargs rt curfun f.f_expr ctx.in_display p in
+	let e = TypeloadFunction.type_function ctx args rt curfun f.f_expr ctx.in_display p in
 	ctx.type_params <- old_tp;
 	ctx.in_loop <- old_in_loop;
 	let tf = {
-		tf_args = fargs;
+		tf_args = args#for_expr;
 		tf_type = rt;
 		tf_expr = e;
 	} in