store structure extended types and expose it to the macro api with An…

…onStatus.AExtend (closes #3198)

extra/CHANGES.txt

@@ -38,6 +38,7 @@
 	macro : added Context.getLocalTVars
 	macro : added TypedExprTools.iter
 	macro : changed @:genericBuild macros to prefer ComplexType returns
+	macro : [breaking] extended TAnonymous structures now have AExtend status instead of AClosed
 
 	Deprecations:
 

interp.ml

@@ -4374,9 +4374,10 @@ and encode_anon_status s =
 		| Closed -> 0, []
 		| Opened -> 1, []
 		| Type.Const -> 2, []
-		| Statics cl -> 3, [encode_clref cl]
-		| EnumStatics en -> 4, [encode_enref en]
-		| AbstractStatics ab -> 5, [encode_abref ab]
+		| Extend tl -> 3, [encode_ref tl (fun tl -> enc_array (List.map encode_type tl)) (fun() -> "<extended types>")]
+		| Statics cl -> 4, [encode_clref cl]
+		| EnumStatics en -> 5, [encode_enref en]
+		| AbstractStatics ab -> 6, [encode_abref ab]
 	)
 	in
 	enc_enum IAnonStatus tag pl

std/haxe/macro/Type.hx

@@ -47,6 +47,7 @@ enum AnonStatus {
 	AClosed;
 	AOpened;
 	AConst;
+	AExtend( tl:Ref<Array<Type>> );
 	AClassStatics( t : Ref<ClassType> );
 	AEnumStatics( t : Ref<EnumType> );
 	AAbstractStatics( t : Ref<AbstractType> );

tests/unit/issues/Issue3198.hx

@@ -0,0 +1,33 @@
+package unit.issues;
+
+#if macro
+import haxe.macro.Context;
+#end
+
+private typedef A = {a:Int}
+private typedef B = {b:Int}
+private typedef C = {>A,}
+private typedef D = {>A, >B,}
+
+class Issue3198 extends Test {
+    function test() {
+        eq(getExtends((null : C)), "A");
+        eq(getExtends((null : D)), "A,B");
+    }
+
+    static macro function getExtends(e) {
+        switch (Context.follow(Context.typeof(e))) {
+            case TAnonymous(_.get() => {status: AExtend(_.get() => tl)}):
+                var p = [];
+                for (t in tl) switch (t) {
+                    case TType(_.get() => dt, []):
+                        p.push(dt.name);
+                    default:
+                        throw false;
+                }
+                return macro $v{p.join(",")};
+            default:
+                throw false;
+        }
+    }
+}

type.ml

@@ -91,6 +91,7 @@ and anon_status =
 	| Closed
 	| Opened
 	| Const
+	| Extend of t list
 	| Statics of tclass
 	| EnumStatics of tenum
 	| AbstractStatics of tabstract
@@ -1360,7 +1361,7 @@ let rec unify a b =
 			(match !(an.a_status) with
 			| Opened -> an.a_status := Closed;
 			| Statics _ | EnumStatics _ | AbstractStatics _ -> error []
-			| Closed | Const -> ())
+			| Closed | Extend _ | Const -> ())
 		with
 			Unify_error l -> error (cannot_unify a b :: l))
 	| TAnon a1, TAnon a2 ->
@@ -1403,7 +1404,7 @@ let rec unify a b =
 			| EnumStatics e -> (match !(a1.a_status) with EnumStatics e2 when e == e2 -> () | _ -> error [])
 			| AbstractStatics a -> (match !(a1.a_status) with AbstractStatics a2 when a == a2 -> () | _ -> error [])
 			| Opened -> a2.a_status := Closed
-			| Const | Closed -> ())
+			| Const | Extend _ | Closed -> ())
 		with
 			Unify_error l -> error (cannot_unify a b :: l))
 	| TAnon an, TAbstract ({ a_path = [],"Class" },[pt]) ->

typeload.ml

@@ -466,7 +466,7 @@ and load_complex_type ctx p t =
 					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;
-					mk_anon (PMap.foldi PMap.add a.a_fields a2.a_fields)
+					TAnon { a_fields = (PMap.foldi PMap.add a.a_fields a2.a_fields); a_status = ref (Extend [t]); }
 				| _ -> error "Can only extend classes and structures" p
 			in
 			let loop t = match follow t with
@@ -488,6 +488,7 @@ and load_complex_type ctx p t =
 						mk_extension i
 					| _ ->
 						List.iter loop il;
+						a.a_status := Extend il;
 						ta);
 				t
 			) "constraint" in

typer.ml

@@ -1390,7 +1390,7 @@ and type_field ?(resume=false) ctx e i p mode =
 			let f = PMap.find i a.a_fields in
 			if not f.cf_public && not ctx.untyped then begin
 				match !(a.a_status) with
-				| Closed -> () (* always allow anon private fields access *)
+				| Closed | Extend _ -> () (* always allow anon private fields access *)
 				| Statics c when can_access ctx c f true -> ()
 				| _ -> display_error ctx ("Cannot access private field " ^ i) p
 			end;