add new function type syntax (closes #4799)

src/core/ast.ml

@@ -161,6 +161,7 @@ and complex_type =
 	| CTParent of type_hint
 	| CTExtend of placed_type_path list * class_field list
 	| CTOptional of type_hint
+	| CTNamed of placed_name * type_hint
 
 and type_hint = complex_type * pos
 
@@ -559,7 +560,9 @@ let map_expr loop (e,p) =
 			let tl = List.map tpath tl in
 			let fl = List.map cfield fl in
 			CTExtend (tl,fl)
-		| CTOptional t -> CTOptional (type_hint t)),p
+		| CTOptional t -> CTOptional (type_hint t)
+		| CTNamed (n,t) -> CTNamed (n,type_hint t)
+		),p
 	and tparamdecl t =
 		let constraints = List.map type_hint t.tp_constraints in
 		let params = List.map tparamdecl t.tp_params in
@@ -757,6 +760,7 @@ let s_expr e =
 		| CTAnonymous fl -> "{ " ^ String.concat "; " (List.map (s_class_field tabs) fl) ^ "}";
 		| CTParent(t,_) -> "(" ^ s_complex_type tabs t ^ ")"
 		| CTOptional(t,_) -> "?" ^ s_complex_type tabs t
+		| CTNamed((n,_),(t,_)) -> n ^ ":" ^ s_complex_type tabs t
 		| CTExtend (tl, fl) -> "{> " ^ String.concat " >, " (List.map (s_complex_type_path tabs) tl) ^ ", " ^ String.concat ", " (List.map (s_class_field tabs) fl) ^ " }"
 	and s_class_field tabs f =
 		match f.cff_doc with

src/macro/macroApi.ml

@@ -433,6 +433,8 @@ and encode_ctype t =
 		4, [encode_array (List.map encode_path tl); encode_array (List.map encode_field fields)]
 	| CTOptional t ->
 		5, [encode_ctype t]
+	| CTNamed (n,t) ->
+		6, [encode_placed_name n; encode_ctype t]
 	in
 	encode_enum ~pos:(Some (pos t)) ICType tag pl
 
@@ -732,6 +734,8 @@ and decode_ctype t =
 		CTExtend (List.map decode_path (decode_array tl), List.map decode_field (decode_array fl))
 	| 5, [t] ->
 		CTOptional (decode_ctype t)
+	| 6, [n;t] ->
+		CTNamed ((decode_string n,p), decode_ctype t)
 	| _ ->
 		raise Invalid_expr),p
 

src/syntax/grammar.mly

@@ -377,15 +377,31 @@ and parse_type_opt = parser
 	| [< t = parse_type_hint >] -> Some t
 	| [< >] -> None
 
-and parse_complex_type s =
-	let t = parse_complex_type_inner s in
-	parse_complex_type_next t s
+and parse_complex_type s = parse_complex_type_maybe_named false s
+
+and parse_complex_type_maybe_named allow_named = parser
+	| [< '(POpen,p1); tl = psep Comma (parse_complex_type_maybe_named true); '(PClose,p2); s >] ->
+		begin match tl with
+		| [] | [(CTNamed _,_)] ->
+			(* it was () or (a:T) - clearly a new function type syntax, proceed with parsing return type *)
+			parse_function_type_next tl p1 s
+		| [t] ->
+			(* it was some single unnamed type in parenthesis - use old function type syntax  *)
+			let t = CTParent t,punion p1 p2 in
+			parse_complex_type_next t s
+		| _ ->
+			(* it was multiple arguments - clearly a new function type syntax, proceed with parsing return type  *)
+			parse_function_type_next tl p1 s
+		end
+	| [< s >] ->
+		let t = parse_complex_type_inner allow_named s in
+		parse_complex_type_next t s
 
 and parse_structural_extension = parser
 	| [< '(Binop OpGt,_); t = parse_type_path; '(Comma,_); s >] ->
 		t
 
-and parse_complex_type_inner = parser
+and parse_complex_type_inner allow_named = parser
 	| [< '(POpen,p1); t = parse_complex_type; '(PClose,p2) >] -> CTParent t,punion p1 p2
 	| [< '(BrOpen,p1); s >] ->
 		(match s with parser
@@ -397,51 +413,64 @@ and parse_complex_type_inner = parser
 			| [< l,p2 = parse_class_fields true p1 >] -> CTExtend (tl,l),punion p1 p2)
 		| [< l,p2 = parse_class_fields true p1 >] -> CTAnonymous l,punion p1 p2
 		| [< >] -> serror())
-	| [< '(Question,p1); t,p2 = parse_complex_type_inner >] ->
+	| [< '(Question,p1); t,p2 = parse_complex_type_inner allow_named >] ->
 		CTOptional (t,p2),punion p1 p2
+	| [< n = dollar_ident; s >] ->
+		(match s with parser
+		| [< '(DblDot,_) when allow_named; t = parse_complex_type >] ->
+			let p1 = snd n in
+			let p2 = snd t in
+			CTNamed (n,t),punion p1 p2
+		| [< s >] ->
+			let n,p = n in
+			let t,p = parse_type_path2 None [] n p s in
+			CTPath t,p)
 	| [< t,p = parse_type_path >] ->
 		CTPath t,p
 
 and parse_type_path s = parse_type_path1 None [] s
 
 and parse_type_path1 p0 pack = parser
 	| [< name, p1 = dollar_ident_macro pack; s >] ->
-		if is_lower_ident name then
-			(match s with parser
-			| [< '(Dot,p) >] ->
-				if is_resuming p then
-					raise (TypePath (List.rev (name :: pack),None,false))
-				else
-					parse_type_path1 (match p0 with None -> Some p1 | Some _ -> p0) (name :: pack) s
-			| [< '(Semicolon,_) >] ->
-				error (Custom "Type name should start with an uppercase letter") p1
-			| [< >] -> serror())
-		else
-			let sub,p2 = (match s with parser
-				| [< '(Dot,p); s >] ->
-					(if is_resuming p then
-						raise (TypePath (List.rev pack,Some (name,false),false))
-					else match s with parser
-						| [< '(Const (Ident name),p2) when not (is_lower_ident name) >] -> Some name,p2
-						| [< '(Binop OpOr,_) when do_resume() >] ->
-							set_resume p;
-							raise (TypePath (List.rev pack,Some (name,false),false))
-						| [< >] -> serror())
-				| [< >] -> None,p1
-			) in
-			let params,p2 = (match s with parser
-				| [< '(Binop OpLt,_); l = psep Comma parse_type_path_or_const; '(Binop OpGt,p2) >] -> l,p2
-				| [< >] -> [],p2
-			) in
-			{
-				tpackage = List.rev pack;
-				tname = name;
-				tparams = params;
-				tsub = sub;
-			},punion (match p0 with None -> p1 | Some p -> p) p2
+		parse_type_path2 p0 pack name p1 s
 	| [< '(Binop OpOr,_) when do_resume() >] ->
 		raise (TypePath (List.rev pack,None,false))
 
+and parse_type_path2 p0 pack name p1 s =
+	if is_lower_ident name then
+		(match s with parser
+		| [< '(Dot,p) >] ->
+			if is_resuming p then
+				raise (TypePath (List.rev (name :: pack),None,false))
+			else
+				parse_type_path1 (match p0 with None -> Some p1 | Some _ -> p0) (name :: pack) s
+		| [< '(Semicolon,_) >] ->
+			error (Custom "Type name should start with an uppercase letter") p1
+		| [< >] -> serror())
+	else
+		let sub,p2 = (match s with parser
+			| [< '(Dot,p); s >] ->
+				(if is_resuming p then
+					raise (TypePath (List.rev pack,Some (name,false),false))
+				else match s with parser
+					| [< '(Const (Ident name),p2) when not (is_lower_ident name) >] -> Some name,p2
+					| [< '(Binop OpOr,_) when do_resume() >] ->
+						set_resume p;
+						raise (TypePath (List.rev pack,Some (name,false),false))
+					| [< >] -> serror())
+			| [< >] -> None,p1
+		) in
+		let params,p2 = (match s with parser
+			| [< '(Binop OpLt,_); l = psep Comma parse_type_path_or_const; '(Binop OpGt,p2) >] -> l,p2
+			| [< >] -> [],p2
+		) in
+		{
+			tpackage = List.rev pack;
+			tname = name;
+			tparams = params;
+			tsub = sub;
+		},punion (match p0 with None -> p1 | Some p -> p) p2
+
 and type_name = parser
 	| [< '(Const (Ident name),p) >] ->
 		if is_lower_ident name then
@@ -467,6 +496,11 @@ and parse_complex_type_next (t : type_hint) = parser
 			CTFunction ([t] , (t2,p2)),punion (pos t) p2)
 	| [< >] -> t
 
+and parse_function_type_next tl p1 = parser
+	| [< '(Arrow,_); tret = parse_complex_type_inner false >] ->
+		CTFunction (tl,tret), punion p1 (snd tret)
+	| [< >] -> serror ()
+
 and parse_type_anonymous opt final = parser
 	| [< '(Question,_) when not opt; s >] -> parse_type_anonymous true final s
 	| [< '(Kwd Final,_) when not opt && not final; s >] -> parse_type_anonymous opt true s

src/syntax/reification.ml

@@ -136,6 +136,7 @@ let reify in_macro =
 		| CTParent t -> ct "TParent" [to_type_hint t p]
 		| CTExtend (tl,fields) -> ct "TExtend" [to_array to_tpath tl p; to_array to_cfield fields p]
 		| CTOptional t -> ct "TOptional" [to_type_hint t p]
+		| CTNamed (n,t) -> ct "TNamed" [to_placed_name n; to_type_hint t p]
 	and to_type_hint (t,p) _ =
 		(* to_obj ["type",to_ctype t p;"pos",to_pos p] p *)
 		to_ctype (t,p) p

src/typing/typeload.ml

@@ -546,6 +546,7 @@ and load_complex_type ctx allow_display p (t,pn) =
 	| CTParent t -> load_complex_type ctx allow_display p t
 	| CTPath t -> load_instance ~allow_display ctx (t,pn) false p
 	| CTOptional _ -> error "Optional type not allowed here" p
+	| CTNamed _ -> error "Named type not allowed here" p
 	| CTExtend (tl,l) ->
 		(match load_complex_type ctx allow_display p (CTAnonymous l,p) with
 		| TAnon a as ta ->
@@ -685,7 +686,8 @@ and load_complex_type ctx allow_display p (t,pn) =
 		| _ ->
 			TFun (List.map (fun t ->
 				let t, opt = (match fst t with CTOptional t -> t, true | _ -> t,false) in
-				"",opt,load_complex_type ctx allow_display p t
+				let n,t = (match fst t with CTNamed (n,t) -> (fst n), t | _ -> "", t) in
+				n,opt,load_complex_type ctx allow_display p t
 			) args,load_complex_type ctx allow_display p r)
 
 and init_meta_overloads ctx co cf =

std/haxe/macro/Expr.hx

@@ -570,6 +570,11 @@ enum ComplexType {
 		Represents an optional type.
 	**/
 	TOptional( t : ComplexType );
+
+	/**
+		Represents a type with a name.
+	**/
+	TNamed( n : String, t : ComplexType );
 }
 
 /**

std/haxe/macro/Printer.hx

@@ -120,6 +120,7 @@ class Printer {
 		case TAnonymous(fields): "{ " + [for (f in fields) printField(f) + "; "].join("") + "}";
 		case TParent(ct): "(" + printComplexType(ct) + ")";
 		case TOptional(ct): "?" + printComplexType(ct);
+		case TNamed(n,ct): n + ":" + printComplexType(ct);
 		case TExtend(tpl, fields): '{> ${tpl.map(printTypePath).join(" >, ")}, ${fields.map(printField).join(", ")} }';
 	}
 

tests/unit/src/unit/HelperMacros.hx

@@ -7,6 +7,12 @@ class HelperMacros {
 		return macro $v { Std.string(Date.now()) };
 	}
 
+	static public macro function typeString(e) {
+		var typed = haxe.macro.Context.typeExpr(e);
+		var s = haxe.macro.TypeTools.toString(typed.t);
+		return macro $v{s};
+	}
+
 	static public macro function typedAs(actual:haxe.macro.Expr, expected:haxe.macro.Expr) {
 		var tExpected = haxe.macro.Context.typeof(expected);
 		var tActual = haxe.macro.Context.typeof(actual);

tests/unit/src/unit/issues/Issue2958.hx

@@ -1,5 +1,7 @@
 package unit.issues;
 
+import unit.HelperMacros.typeString;
+
 private typedef Asset<@:const T> = String;
 
 class Issue2958 extends Test {
@@ -9,11 +11,4 @@ class Issue2958 extends Test {
 		   "unit.issues._Issue2958.Asset<[\"test\", 1]>"
 		);
 	}
-
-	static macro function typeString(e)
-	{
-		var typed = haxe.macro.Context.typeExpr(e);
-		var s = haxe.macro.TypeTools.toString(typed.t);
-		return macro $v{s};
-	}
 }

tests/unit/src/unit/issues/Issue4799.hx

@@ -0,0 +1,29 @@
+package unit.issues;
+
+import unit.HelperMacros.typeString;
+
+class Issue4799 extends Test {
+	function test() {
+		eq(typeString((null : Int)), "Int");
+		eq(typeString((null : (Int))), "Int");
+		eq(typeString((null : (Int,Int)->Int)), "Int -> Int -> Int");
+		eq(typeString((null : (a:Int,Int)->Int)), "a : Int -> Int -> Int");
+		eq(typeString((null : (a:Int, b:Int)->Int)), "a : Int -> b : Int -> Int");
+		eq(typeString((null : (a:Int, Int, ?String->Void, ?b:(Int->Int)->Int, c:(a:Int)->Void)->Int)),
+		                      "a : Int -> Int -> (?String -> Void) -> ?b : ((Int -> Int) -> Int) -> c : (a : Int -> Void) -> Int");
+		t(parseError("(Int,Int)->Int->Int"));
+		t(parseError("(a:Int)->Int->Int"));
+		eq(typeString((null : (Int,Int)->(Int->Int))), "Int -> Int -> (Int -> Int)");
+		eq(typeString((null : (a:Int)->(Int->Int))), "a : Int -> (Int -> Int)");
+	}
+
+	static macro function parseError(s:String) {
+		var s = "(null : " + s + ")";
+		try {
+			haxe.macro.Context.parseInlineString(s, haxe.macro.Context.currentPos());
+			return macro false;
+		} catch (e:Any) {
+			return macro true;
+		}
+	}
+}