Browse Source

Add support for `Type & Type` syntax (#7127)

* [syntax] add CTIntersection

* [typer] allow loading intersection types over structures

* [std/tests] use intersection types in place of structural extensions

* don't forget about haxe.macro.Printer

* [typer] add initial support for intersection constraints

* right...
Simon Krajewski 7 years ago
parent
commit
9fea5f91ad

+ 3 - 3
src/codegen/dotnet.ml

@@ -469,7 +469,7 @@ let convert_ilmethod ctx p m is_explicit_impl =
 			{
 				tp_name = "M" ^ string_of_int t.tnumber,null_pos;
 				tp_params = [];
-				tp_constraints = [];
+				tp_constraints = None;
 				tp_meta = [];
 			}
 		) m.mtypes in
@@ -638,7 +638,7 @@ let convert_delegate ctx p ilcls =
 		{
 			tp_name = ("T" ^ string_of_int t.tnumber),null_pos;
 			tp_params = [];
-			tp_constraints = [];
+			tp_constraints = None;
 			tp_meta = [];
 		}
 	) ilcls.ctypes in
@@ -802,7 +802,7 @@ let convert_ilclass ctx p ?(delegate=false) ilcls = match ilcls.csuper with
 				{
 					tp_name = "T" ^ string_of_int p.tnumber,null_pos;
 					tp_params = [];
-					tp_constraints = [];
+					tp_constraints = None;
 					tp_meta = [];
 				}) ilcls.ctypes
 			in

+ 8 - 4
src/codegen/java.ml

@@ -183,6 +183,11 @@ let rec same_sig parent jsig =
 	| TArray(s,_) -> same_sig parent s
 	| _ -> false
 
+let convert_constraints ctx p tl = match tl with
+	| [] -> None
+	| [t] -> Some (convert_signature ctx p t,null_pos)
+	| tl -> Some (CTIntersection(List.map (fun t -> convert_signature ctx p t,null_pos) tl),null_pos)
+
 let convert_param ctx p parent param =
 	let name, constraints = match param with
 		| (name, Some extends_sig, implem_sig) ->
@@ -194,7 +199,7 @@ let convert_param ctx p parent param =
 		{
 			tp_name = jname_to_hx name,null_pos;
 			tp_params = [];
-			tp_constraints = List.map (fun t -> convert_signature ctx p t,null_pos) constraints;
+			tp_constraints = convert_constraints ctx p constraints;
 			tp_meta = [];
 		}
 
@@ -311,20 +316,19 @@ let convert_java_enum ctx p pe =
 					) args in
 					let t = Option.map_default (convert_signature ctx p) (mk_type_path ctx ([], "Void") []) ret in
 					cff_meta := (Meta.Overload, [], p) :: !cff_meta;
-
 					let types = List.map (function
 						| (name, Some ext, impl) ->
 							{
 								tp_name = name,null_pos;
 								tp_params = [];
-								tp_constraints = List.map (fun t -> convert_signature ctx p t,null_pos) (ext :: impl);
+								tp_constraints = convert_constraints ctx p (ext :: impl);
 								tp_meta = [];
 							}
 						| (name, None, impl) ->
 							{
 								tp_name = name,null_pos;
 								tp_params = [];
-								tp_constraints = List.map (fun t -> convert_signature ctx p t,null_pos) (impl);
+								tp_constraints = convert_constraints ctx p impl;
 								tp_meta = [];
 							}
 					) field.jf_types in

+ 3 - 1
src/context/display/findReferences.ml

@@ -39,9 +39,11 @@ let find_possible_references kind name (pack,decls) =
 		| CTExtend(tl,cffl) ->
 			List.iter (fun (path,_) -> type_path KModuleType path) tl;
 			List.iter field cffl;
+		| CTIntersection tl ->
+			List.iter type_hint tl
 	and type_param tp =
 		List.iter type_param tp.tp_params;
-		List.iter type_hint tp.tp_constraints
+		Option.may type_hint tp.tp_constraints
 	and expr (e,p) =
 		begin match e with
 		| EConst(Ident s) ->

+ 9 - 3
src/core/ast.ml

@@ -162,6 +162,7 @@ and complex_type =
 	| CTExtend of placed_type_path list * class_field list
 	| CTOptional of type_hint
 	| CTNamed of placed_name * type_hint
+	| CTIntersection of type_hint list
 
 and type_hint = complex_type * pos
 
@@ -217,7 +218,7 @@ and expr = expr_def * pos
 and type_param = {
 	tp_name : placed_name;
 	tp_params :	type_param list;
-	tp_constraints : type_hint list;
+	tp_constraints : type_hint option;
 	tp_meta : metadata;
 }
 
@@ -575,9 +576,10 @@ let map_expr loop (e,p) =
 			CTExtend (tl,fl)
 		| CTOptional t -> CTOptional (type_hint t)
 		| CTNamed (n,t) -> CTNamed (n,type_hint t)
+		| CTIntersection tl -> CTIntersection(List.map type_hint tl)
 		),p
 	and tparamdecl t =
-		let constraints = List.map type_hint t.tp_constraints in
+		let constraints = opt type_hint t.tp_constraints in
 		let params = List.map tparamdecl t.tp_params in
 		{ tp_name = t.tp_name; tp_constraints = constraints; tp_params = params; tp_meta = t.tp_meta }
 	and func f =
@@ -782,6 +784,7 @@ let s_expr e =
 		| 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) ^ " }"
+		| CTIntersection tl -> String.concat "&" (List.map (fun (t,_) -> s_complex_type tabs t) tl)
 	and s_class_field tabs f =
 		match f.cff_doc with
 		| Some s -> "/**\n\t" ^ tabs ^ s ^ "\n**/\n"
@@ -809,7 +812,10 @@ let s_expr e =
 		s_opt_expr tabs f.f_expr " "
 	and s_type_param tabs t =
 		fst (t.tp_name) ^ s_type_param_list tabs t.tp_params ^
-		if List.length t.tp_constraints > 0 then ":(" ^ String.concat ", " (List.map ((fun (t,_) -> s_complex_type tabs t)) t.tp_constraints) ^ ")" else ""
+		begin match t.tp_constraints with
+			| None -> ""
+			| Some(th,_) -> ":(" ^ s_complex_type tabs th ^ ")"
+		end
 	and s_type_param_list tabs tl =
 		if List.length tl > 0 then "<" ^ String.concat ", " (List.map (s_type_param tabs) tl) ^ ">" else ""
 	and s_func_arg tabs ((n,_),o,_,t,e) =

+ 1 - 1
src/core/display/completionItem.ml

@@ -151,7 +151,7 @@ module CompletionModuleType = struct
 			| TInst(c,_) -> {
 				tp_name = s,null_pos;
 				tp_params = [];
-				tp_constraints = []; (* TODO? *)
+				tp_constraints = None; (* TODO? *)
 				tp_meta = c.cl_meta
 			}
 			| _ ->

+ 12 - 2
src/macro/macroApi.ml

@@ -440,6 +440,8 @@ and encode_ctype t =
 		5, [encode_ctype t]
 	| CTNamed (n,t) ->
 		6, [encode_placed_name n; encode_ctype t]
+	| CTIntersection tl ->
+		7, [(encode_array (List.map encode_ctype tl))]
 	in
 	encode_enum ~pos:(Some (pos t)) ICType tag pl
 
@@ -448,7 +450,9 @@ and encode_tparam_decl tp =
 		"name", encode_placed_name tp.tp_name;
 		"name_pos", encode_pos (pos tp.tp_name);
 		"params", encode_array (List.map encode_tparam_decl tp.tp_params);
-		"constraints", encode_array (List.map encode_ctype tp.tp_constraints);
+		"constraints", (match tp.tp_constraints with
+			| None -> encode_array []
+			| Some th -> encode_array [encode_ctype th]);
 		"meta", encode_meta_content tp.tp_meta;
 	]
 
@@ -678,7 +682,11 @@ and decode_tparams v =
 and decode_tparam_decl v =
 	{
 		tp_name = decode_placed_name (field v "name_pos") (field v "name");
-		tp_constraints = decode_opt_array decode_ctype (field v "constraints");
+		tp_constraints = (match decode_array(field v "constraints") with
+			| [] -> None
+			| [t] -> Some (decode_ctype t)
+			| tl -> Some (CTIntersection (List.map decode_ctype tl),Globals.null_pos)
+		);
 		tp_params = decode_tparams (field v "params");
 		tp_meta = decode_meta_content (field v "meta");
 	}
@@ -755,6 +763,8 @@ and decode_ctype t =
 		CTOptional (decode_ctype t)
 	| 6, [n;t] ->
 		CTNamed ((decode_string n,p), decode_ctype t)
+	| 7, [tl] ->
+		CTIntersection (List.map decode_ctype (decode_array tl))
 	| _ ->
 		raise Invalid_expr),p
 

+ 19 - 5
src/syntax/grammar.mly

@@ -599,6 +599,12 @@ and parse_complex_type_next (t : type_hint) s =
 		| _ ->
 			CTFunction ([t] , (t2,p2)),punion (pos t) p2
 	in
+	let make_intersection t2 p2 = match t2 with
+		| CTIntersection tl ->
+			CTIntersection (t :: tl),punion (pos t) p2
+		| _ ->
+			CTIntersection ([t;t2,p2]),punion (pos t) p2
+	in
 	match s with parser
 	| [< '(Arrow,pa); s >] ->
 		begin match s with parser
@@ -609,6 +615,15 @@ and parse_complex_type_next (t : type_hint) s =
 				make_fun ct null_pos
 			end else serror()
 		end
+	| [< '(Binop OpAnd,pa); s >] ->
+		begin match s with parser
+		| [< t2,p2 = parse_complex_type >] -> make_intersection t2 p2
+		| [< >] ->
+			if would_skip_display_position pa s then begin
+				let ct = CTPath magic_type_path in
+				make_intersection ct null_pos
+			end else serror()
+		end
 	| [< >] -> t
 
 and parse_function_type_next tl p1 = parser
@@ -805,18 +820,17 @@ and parse_constraint_param = parser
 		let params = (match s with parser
 			| [< >] -> []
 		) in
-		let ctl = (match s with parser
+		let cto = (match s with parser
 			| [< '(DblDot,_); s >] ->
 				(match s with parser
-				| [< '(POpen,_); l = psep Comma parse_complex_type; '(PClose,_) >] -> l
-				| [< t = parse_complex_type >] -> [t]
+				| [< t = parse_complex_type >] -> Some t
 				| [< >] -> serror())
-			| [< >] -> []
+			| [< >] -> None
 		) in
 		{
 			tp_name = name;
 			tp_params = params;
-			tp_constraints = ctl;
+			tp_constraints = cto;
 			tp_meta = meta;
 		}
 

+ 3 - 2
src/syntax/reification.ml

@@ -137,6 +137,7 @@ let reify in_macro =
 		| 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]
+		| CTIntersection tl -> ct "TIntersection" (List.map (fun t -> to_ctype t p) tl)
 	and to_type_hint (t,p) _ =
 		(* to_obj ["type",to_ctype t p;"pos",to_pos p] p *)
 		to_ctype (t,p) p
@@ -154,7 +155,7 @@ let reify in_macro =
 		let rec fparam t p =
 			let fields = [
 				"name", to_placed_name t.tp_name;
-				"constraints", to_array to_ctype t.tp_constraints p;
+				"constraints", to_opt to_ctype t.tp_constraints p;
 				"params", to_array fparam t.tp_params p;
 			] in
 			to_obj fields p
@@ -364,7 +365,7 @@ let reify in_macro =
 		to_obj [
 			"name", to_placed_name t.tp_name;
 			"params", (EArrayDecl (List.map (to_tparam_decl p) t.tp_params),p);
-			"constraints", (EArrayDecl (List.map (fun t -> to_ctype t p) t.tp_constraints),p)
+			"constraints", (EArrayDecl (match t.tp_constraints with None -> [] | Some th -> [to_ctype th p]),p)
 		] p
 	and to_type_def (t,p) =
 		match t with

+ 51 - 18
src/typing/typeload.ml

@@ -333,27 +333,57 @@ and load_instance ctx ?(allow_display=false) (t,pn) allow_no_params p =
 *)
 and load_complex_type ctx allow_display p (t,pn) =
 	let p = pselect pn p in
+	let is_redefined cf1 fields =
+		try
+			let cf2 = PMap.find cf1.cf_name fields in
+			let st = s_type (print_context()) in
+			if not (type_iseq cf1.cf_type cf2.cf_type) then begin
+				display_error ctx ("Cannot redefine field " ^ cf1.cf_name ^ " with different type") p;
+				display_error ctx ("First type was " ^ (st cf1.cf_type)) cf1.cf_pos;
+				error ("Second type was " ^ (st cf2.cf_type)) cf2.cf_pos
+			end else
+				true
+		with Not_found ->
+			false
+	in
 	match t with
 	| 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
+	| CTIntersection tl ->
+		let tl = List.map (fun (t,pn) ->
+			try
+				load_complex_type ctx allow_display p (t,pn)
+			with DisplayException(DisplayFields(l,CRTypeHint,p)) ->
+				let l = List.filter (fun item -> match item.ci_kind with
+					| ITType({kind = Struct},_) -> true
+					| _ -> false
+				) l in
+				raise_fields l CRStructExtension p
+		) tl in
+		let tr = ref None in
+		let t = TMono tr in
+		let r = exc_protect ctx (fun r ->
+			r := lazy_processing (fun() -> t);
+			let mk_extension fields t = match follow t with
+				| TAnon a ->
+					PMap.fold (fun cf fields ->
+						if not (is_redefined cf fields) then PMap.add cf.cf_name cf fields
+						else fields
+					) a.a_fields fields
+				| _ ->
+					error "Can only extend structures" p
+			in
+			let fields = List.fold_left mk_extension PMap.empty tl in
+			let ta = TAnon { a_fields = fields; a_status = ref (Extend tl); } in
+			tr := Some ta;
+			ta
+		) "constraint" in
+		TLazy r
 	| CTExtend (tl,l) ->
 		begin match load_complex_type ctx allow_display p (CTAnonymous l,p) with
 		| TAnon a as ta ->
-			let is_redefined cf1 a2 =
-				try
-					let cf2 = PMap.find cf1.cf_name a2.a_fields in
-					let st = s_type (print_context()) in
-					if not (type_iseq cf1.cf_type cf2.cf_type) then begin
-						display_error ctx ("Cannot redefine field " ^ cf1.cf_name ^ " with different type") p;
-						display_error ctx ("First type was " ^ (st cf1.cf_type)) cf1.cf_pos;
-						error ("Second type was " ^ (st cf2.cf_type)) cf2.cf_pos
-					end else
-						true
-				with Not_found ->
-					false
-			in
 			let mk_extension t =
 				match follow t with
 				| TInst ({cl_kind = KTypeParameter _},_) ->
@@ -361,14 +391,14 @@ and load_complex_type ctx allow_display p (t,pn) =
 				| TMono _ ->
 					error "Loop found in cascading signatures definitions. Please change order/import" p
 				| TAnon a2 ->
-					PMap.iter (fun _ cf -> ignore(is_redefined cf a2)) a.a_fields;
+					PMap.iter (fun _ cf -> ignore(is_redefined cf a2.a_fields)) a.a_fields;
 					TAnon { a_fields = (PMap.foldi PMap.add a.a_fields a2.a_fields); a_status = ref (Extend [t]); }
 				| _ -> error "Can only extend structures" p
 			in
 			let loop t = match follow t with
 				| TAnon a2 ->
 					PMap.iter (fun f cf ->
-						if not (is_redefined cf a) then
+						if not (is_redefined cf a.a_fields) then
 							a.a_fields <- PMap.add f cf a.a_fields
 					) a2.a_fields
 				| _ ->
@@ -649,13 +679,16 @@ let rec type_type_param ?(enum_constructor=false) ctx path get_params p tp =
 	if ctx.is_display_file && DisplayPosition.encloses_display_position (pos tp.tp_name) then
 		DisplayEmitter.display_type ctx t (pos tp.tp_name);
 	match tp.tp_constraints with
-	| [] ->
+	| None ->
 		n, t
-	| _ ->
+	| Some th ->
 		let r = exc_protect ctx (fun r ->
 			r := lazy_processing (fun() -> t);
 			let ctx = { ctx with type_params = ctx.type_params @ get_params() } in
-			let constr = List.map (load_complex_type ctx true p) tp.tp_constraints in
+			let constr = match fst th with
+				| CTIntersection tl -> List.map (load_complex_type ctx true p) tl
+				| _ -> [load_complex_type ctx true p th]
+			in
 			(* check against direct recursion *)
 			let rec loop t =
 				match follow t with

+ 1 - 1
src/typing/typer.ml

@@ -1981,7 +1981,7 @@ and type_local_function ctx name f with_type p =
 		if name = None then display_error ctx "Type parameters not supported in unnamed local functions" p;
 		if with_type <> NoValue then error "Type parameters are not supported for rvalue functions" p
 	end;
-	List.iter (fun tp -> if tp.tp_constraints <> [] then display_error ctx "Type parameter constraints are not supported for local functions" p) f.f_params;
+	List.iter (fun tp -> if tp.tp_constraints <> None then display_error ctx "Type parameter constraints are not supported for local functions" p) f.f_params;
 	let inline, v = (match name with
 		| None -> false, None
 		| Some v when ExtString.String.starts_with v "inline_" -> true, Some (String.sub v 7 (String.length v - 7))

+ 5 - 0
std/haxe/macro/Expr.hx

@@ -583,6 +583,11 @@ enum ComplexType {
 		Represents a type with a name.
 	**/
 	TNamed( n : String, t : ComplexType );
+
+	/**
+		Represents an intersection type `T1 & T2 & ... & TN`.
+	**/
+	TIntersection(tl:Array<ComplexType>);
 }
 
 /**

+ 1 - 0
std/haxe/macro/Printer.hx

@@ -122,6 +122,7 @@ class Printer {
 		case TOptional(ct): "?" + printComplexType(ct);
 		case TNamed(n,ct): n + ":" + printComplexType(ct);
 		case TExtend(tpl, fields): '{> ${tpl.map(printTypePath).join(" >, ")}, ${fields.map(printField).join(", ")} }';
+		case TIntersection(tl): tl.map(printComplexType).join(" & ");
 	}
 
 	public function printMetadata(meta:MetadataEntry) return

+ 4 - 4
std/haxe/macro/Type.hx

@@ -393,7 +393,7 @@ typedef BaseType = {
 /**
 	Represents a class type.
 */
-typedef ClassType = {> BaseType,
+typedef ClassType = BaseType & {
 	/**
 		The kind of the class.
 	**/
@@ -446,7 +446,7 @@ typedef ClassType = {> BaseType,
 /**
 	Represents an enum type.
 */
-typedef EnumType = {> BaseType,
+typedef EnumType = BaseType & {
 	/**
 		The available enum constructors.
 	**/
@@ -461,7 +461,7 @@ typedef EnumType = {> BaseType,
 /**
 	Represents a typedef.
 */
-typedef DefType = {> BaseType,
+typedef DefType = BaseType & {
 	/**
 		The target type of the typedef.
 	**/
@@ -471,7 +471,7 @@ typedef DefType = {> BaseType,
 /**
 	Represents an abstract type.
 */
-typedef AbstractType = {>BaseType,
+typedef AbstractType = BaseType & {
 	/**
 		The underlying type of the abstract.
 	**/

+ 4 - 4
std/haxe/rtti/CType.hx

@@ -229,7 +229,7 @@ typedef TypeInfos = {
 /**
 	The runtime class definition information.
 **/
-typedef Classdef = {> TypeInfos,
+typedef Classdef = TypeInfos & {
 	/**
 		Whether or not the class is [extern](https://haxe.org/manual/lf-externs.html).
 	**/
@@ -310,7 +310,7 @@ typedef EnumField = {
 
 	@see <https://haxe.org/manual/cr-rtti-structure.html#enum-type-information>
 **/
-typedef Enumdef = {> TypeInfos,
+typedef Enumdef = TypeInfos & {
 	/**
 		Whether or not the enum is [extern](https://haxe.org/manual/lf-externs.html).
 	**/
@@ -325,7 +325,7 @@ typedef Enumdef = {> TypeInfos,
 /**
 	The typedef runtime information.
 **/
-typedef Typedef = {> TypeInfos,
+typedef Typedef = TypeInfos & {
 	/**
 		The type of the typedef.
 	**/
@@ -342,7 +342,7 @@ typedef Typedef = {> TypeInfos,
 
 	@see <https://haxe.org/manual/cr-rtti-structure.html#abstract-type-information>
 **/
-typedef Abstractdef = {> TypeInfos,
+typedef Abstractdef = TypeInfos & {
 	var to : Array<{t:CType, field:Null<String>}>;
 	var from : Array<{t:CType, field:Null<String>}>;
 	var impl : Classdef;

+ 2 - 2
tests/unit/src/unit/MyClass.hx

@@ -156,11 +156,11 @@ class ParamConstraintsClass {
 	public function new() { }
 	static public function staticSingle< A:Base > (a:A):A { return a; }
 	public function memberSingle< A:Base > (a:A):A { return a; }
-	public function memberMultiple < A:(Base, I1) > (a:A):A { return a; }
+	public function memberMultiple < A:Base & I1 > (a:A):A { return a; }
 	public function memberComplex < A:I1, B:List<A> > (a:A, b:B) { return b; }
 	public function memberBasic < A:String, B:Array<A> > (a:A, b:B) { return b[0]; }
 
-	public function memberAnon < A:( { x : Int }, { y : Float } ) > (v:A) { return v.x + v.y; }
+	public function memberAnon < A:{ x : Int } & { y : Float }> (v:A) { return v.x + v.y; }
 
 #if !(java || cs)  //this is a known bug caused by issue #915
 	@:overload(function< A, B:Array<A> > (a:A, b:B):Void { } )

+ 7 - 0
tests/unit/src/unit/issues/Issue3198.hx

@@ -9,10 +9,15 @@ private typedef B = {b:Int}
 private typedef C = {>A,}
 private typedef D = {>A, >B,}
 
+private typedef C2 = {} & A;
+private typedef D2 = A & B;
+
 class Issue3198 extends Test {
 	function test() {
 		eq(getExtends((null : C)), "A");
 		eq(getExtends((null : D)), "A,B");
+		eq(getExtends((null : C2)), "A");
+		eq(getExtends((null : D2)), "A,B");
 	}
 
 	static macro function getExtends(e) {
@@ -22,6 +27,8 @@ class Issue3198 extends Test {
 				for (t in tl) switch (t) {
 					case TType(_.get() => dt, []):
 						p.push(dt.name);
+					case TAnonymous(_):
+						// ignore
 					default:
 						throw false;
 				}