From 715f7275064e6269ad54e03867c9c16729ab1a5c Mon Sep 17 00:00:00 2001
From: Dan Korostelev <nadako@gmail.com>
Date: Wed, 6 Aug 2014 00:43:59 +0400
Subject: [PATCH] store structure extended types and expose it to the macro api
 with AnonStatus.AExtend (closes #3198)

---
 extra/CHANGES.txt              |  1 +
 interp.ml                      |  7 ++++---
 std/haxe/macro/Type.hx         |  1 +
 tests/unit/issues/Issue3198.hx | 33 +++++++++++++++++++++++++++++++++
 type.ml                        |  5 +++--
 typeload.ml                    |  3 ++-
 typer.ml                       |  2 +-
 7 files changed, 45 insertions(+), 7 deletions(-)
 create mode 100644 tests/unit/issues/Issue3198.hx

diff --git a/extra/CHANGES.txt b/extra/CHANGES.txt
index 9972090c1e1..1d12791950a 100644
--- a/extra/CHANGES.txt
+++ b/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:
 
diff --git a/interp.ml b/interp.ml
index ce6cdde6cac..b983bdf6493 100644
--- a/interp.ml
+++ b/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
diff --git a/std/haxe/macro/Type.hx b/std/haxe/macro/Type.hx
index ce676745969..cbc9c018f0e 100644
--- a/std/haxe/macro/Type.hx
+++ b/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> );
diff --git a/tests/unit/issues/Issue3198.hx b/tests/unit/issues/Issue3198.hx
new file mode 100644
index 00000000000..c31f06c31cc
--- /dev/null
+++ b/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;
+        }
+    }
+}
diff --git a/type.ml b/type.ml
index 8cdb9a56bca..7da99489301 100644
--- a/type.ml
+++ b/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]) ->
diff --git a/typeload.ml b/typeload.ml
index cab351e1250..a56bb8b7c71 100644
--- a/typeload.ml
+++ b/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
diff --git a/typer.ml b/typer.ml
index d928110a7f8..3eb2d4afaa6 100644
--- a/typer.ml
+++ b/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;