allow multiple structural extension (closes #2364)

ast.ml

@@ -283,7 +283,7 @@ and complex_type =
 	| CTFunction of complex_type list * complex_type
 	| CTAnonymous of class_field list
 	| CTParent of complex_type
-	| CTExtend of type_path * class_field list
+	| CTExtend of type_path list * class_field list
 	| CTOptional of complex_type
 
 and func = {
@@ -644,7 +644,7 @@ let map_expr loop (e,p) =
 		| CTFunction (cl,c) -> CTFunction (List.map ctype cl, ctype c)
 		| CTAnonymous fl -> CTAnonymous (List.map cfield fl)
 		| CTParent t -> CTParent (ctype t)
-		| CTExtend (t,fl) -> CTExtend (tpath t, List.map cfield fl)
+		| CTExtend (tl,fl) -> CTExtend (List.map tpath tl, List.map cfield fl)
 		| CTOptional t -> CTOptional (ctype t)
 	and tparamdecl t =
 		{ tp_name = t.tp_name; tp_constraints = List.map ctype t.tp_constraints; tp_params = List.map tparamdecl t.tp_params }

doc/CHANGES.txt

@@ -21,6 +21,7 @@
 	all : added haxe.xml.Printer
 	all : added haxe.Int32 as abstract type
 	all : improved inline constructors by detecting more cases where it can be applied
+	all : allow multiple structural extension using { > T1, > T2, fields }
 	js : window and console are reserved words. Access them with __js__ instead of untyped.
 	js : added -D js-flatten
 	js : improved inlining
@@ -32,6 +33,7 @@
 	macro : resolve error line number in external files
 	macro : rewrote macros used as static extension
 	macro : exposed typed AST
+	macro : [breaking] first argument of ComplexType.TExtend is now Array<TypePath> instead of TypePath
 	flash : fixed font embedding with UTF8 chars
 	flash : give error if non-nullable basic types are skipped in a call
 

interp.ml

@@ -3728,8 +3728,8 @@ and encode_ctype t =
 		2, [enc_array (List.map encode_field fl)]
 	| CTParent t ->
 		3, [encode_ctype t]
-	| CTExtend (t,fields) ->
-		4, [encode_path t; enc_array (List.map encode_field fields)]
+	| CTExtend (tl,fields) ->
+		4, [enc_array (List.map encode_path tl); enc_array (List.map encode_field fields)]
 	| CTOptional t ->
 		5, [encode_ctype t]
 	in
@@ -4027,8 +4027,8 @@ and decode_ctype t =
 		CTAnonymous (List.map decode_field (dec_array fl))
 	| 3, [t] ->
 		CTParent (decode_ctype t)
-	| 4, [t;fl] ->
-		CTExtend (decode_path t, List.map decode_field (dec_array fl))
+	| 4, [tl;fl] ->
+		CTExtend (List.map decode_path (dec_array tl), List.map decode_field (dec_array fl))
 	| 5, [t] ->
 		CTOptional (decode_ctype t)
 	| _ ->

parser.ml

@@ -230,7 +230,7 @@ let reify in_macro =
 		| CTFunction (args,ret) -> ct "TFunction" [to_array to_ctype args p; to_ctype ret p]
 		| CTAnonymous fields -> ct "TAnonymous" [to_array to_cfield fields p]
 		| CTParent t -> ct "TParent" [to_ctype t p]
-		| CTExtend (t,fields) -> ct "TExtend" [to_tpath t p; to_array to_cfield fields p]
+		| CTExtend (tl,fields) -> ct "TExtend" [to_array to_tpath tl p; to_array to_cfield fields p]
 		| CTOptional t -> ct "TOptional" [to_ctype t p]
 	and to_fun f p =
 		let farg (n,o,t,e) p =
@@ -765,16 +765,20 @@ and parse_complex_type s =
 	let t = parse_complex_type_inner 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
 	| [< '(POpen,_); t = parse_complex_type; '(PClose,_) >] -> CTParent t
 	| [< '(BrOpen,p1); s >] ->
 		(match s with parser
 		| [< l = parse_type_anonymous false >] -> CTAnonymous l
-		| [< '(Binop OpGt,_); t = parse_type_path; '(Comma,_); s >] ->
+		| [< t = parse_structural_extension; s>] ->
+			let tl = t :: plist parse_structural_extension s in
 			(match s with parser
-			| [< l = parse_type_anonymous false >] -> CTExtend (t,l)
-			| [< l, _ = parse_class_fields true p1 >] -> CTExtend (t,l)
-			| [< >] -> serror())
+			| [< l = parse_type_anonymous false >] -> CTExtend (tl,l)
+			| [< l, _ = parse_class_fields true p1 >] -> CTExtend (tl,l))
 		| [< l, _ = parse_class_fields true p1 >] -> CTAnonymous l
 		| [< >] -> serror())
 	| [< '(Question,_); t = parse_complex_type_inner >] ->
@@ -1264,7 +1268,7 @@ and parse_switch_cases eswitch cases = parser
 	| [< '(Kwd Case,p1); el = psep Comma expr; eg = popt parse_guard; '(DblDot,_); s >] ->
 		(match el with
 		| [] -> error (Custom "case without a pattern is not allowed") p1
-		| _ -> 
+		| _ ->
 			let b = (try block [] s with Display e -> display (ESwitch (eswitch,List.rev ((el,eg,Some e) :: cases),None),punion (pos eswitch) (pos e))) in
 			let b = match b with
 				| [] -> None

std/haxe/macro/Expr.hx

@@ -231,7 +231,7 @@ enum ComplexType {
 	TFunction( args : Array<ComplexType>, ret : ComplexType );
 	TAnonymous( fields : Array<Field> );
 	TParent( t : ComplexType );
-	TExtend( p : TypePath, fields : Array<Field> );
+	TExtend( p : Array<TypePath>, fields : Array<Field> );
 	TOptional( t : ComplexType );
 }
 

std/haxe/macro/Printer.hx

@@ -99,7 +99,7 @@ class Printer {
 		case TAnonymous(fields): "{ " + [for (f in fields) printField(f) + "; "].join("") + "}";
 		case TParent(ct): "(" + printComplexType(ct) + ")";
 		case TOptional(ct): "?" + printComplexType(ct);
-		case TExtend(tp, fields): '{${printTypePath(tp)} >, ${fields.map(printField).join(", ")} }';
+		case TExtend(tpl, fields): '{${tpl.map(printTypePath).join(", ")} >, ${fields.map(printField).join(", ")} }';
 	}
 
 	public function printMetadata(meta:MetadataEntry) return

typeload.ml

@@ -419,10 +419,10 @@ and load_complex_type ctx p t =
 	| CTParent t -> load_complex_type ctx p t
 	| CTPath t -> load_instance ctx t p false
 	| CTOptional _ -> error "Optional type not allowed here" p
-	| CTExtend (t,l) ->
+	| CTExtend (tl,l) ->
 		(match load_complex_type ctx p (CTAnonymous l) with
-		| TAnon a ->
-			let rec loop t =
+		| TAnon a as ta ->
+			let mk_extension t =
 				match follow t with
 				| TInst ({cl_kind = KTypeParameter _},_) ->
 					error "Cannot structurally extend type parameters" p
@@ -445,17 +445,31 @@ and load_complex_type ctx p t =
 					error "Loop found in cascading signatures definitions. Please change order/import" p
 				| TAnon a2 ->
 					PMap.iter (fun f _ ->
-						if PMap.mem f a2.a_fields then error ("Cannot redefine field " ^ f) p
+						if PMap.mem f a2.a_fields then error ("Cannot redefine field " ^ f) p;
 					) a.a_fields;
 					mk_anon (PMap.foldi PMap.add a.a_fields a2.a_fields)
 				| _ -> error "Can only extend classes and structures" p
 			in
-			let i = load_instance ctx t p false in
+			let loop t = match follow t with
+				| TAnon a2 ->
+					PMap.iter (fun f cf ->
+						if PMap.mem f a.a_fields then error ("Cannot redefine field " ^ f) p;
+						a.a_fields <- PMap.add f cf a.a_fields
+					) a2.a_fields
+				| _ ->
+					error "Multiple structural extension is only allowed for structures" p
+			in
+			let il = List.map (fun t -> load_instance ctx t p false) tl in
 			let tr = ref None in
 			let t = TMono tr in
 			let r = exc_protect ctx (fun r ->
 				r := (fun _ -> t);
-				tr := Some (loop i);
+				tr := Some (match il with
+					| [i] ->
+						mk_extension i
+					| _ ->
+						List.iter loop il;
+						ta);
 				t
 			) "constraint" in
 			delay ctx PForce (fun () -> ignore(!r()));