Enum subtyping

doc/CHANGES.txt

@@ -15,6 +15,7 @@
 	used AS3 namespace for F9 Array and String instance methods
 	fixed F9 with uninitialized integer registers
 	fixed F9 + operator with Dynamic/Null operands
+	added Enum subtyping
 
 2007-07-25: 1.14
 	fixed no error when invalid "catch" expression

genas3.ml

@@ -44,6 +44,7 @@ let s_path ctx path p =
 		| "Float" -> "Number"
 		| "Dynamic" -> "Object"
 		| "Bool" -> "Boolean"
+		| "Enum" -> "Class"
 		| _ -> name)
 	| (["flash"],"FlashXml__") ->
 		"Xml"
@@ -133,18 +134,6 @@ let print ctx = Printf.kprintf (fun s -> Buffer.add_string ctx.buf s)
 
 let unsupported = Typer.error "This expression cannot be generated to AS3"
 
-let rec follow_not_stat t =
-	match t with
-	| TMono r ->
-		(match !r with
-		| Some t -> follow_not_stat t
-		| _ -> t)
-	| TLazy f ->
-		follow_not_stat (!f())
-	| TType (t,tl) when t.t_static = None ->
-		follow_not_stat (apply_params t.t_types tl t.t_type)
-	| _ -> t
-
 let newline ctx =
 	match Buffer.nth ctx.buf (Buffer.length ctx.buf - 1) with
 	| '}' | '{' | ':' -> print ctx "\n%s" ctx.tabs
@@ -333,9 +322,8 @@ and gen_value_op ctx e =
 		gen_value ctx e
 
 and gen_field_access ctx t s =
-	match follow_not_stat t with
-	| TType ({ t_static = Some c },_) | TInst (c,_) ->
-		(match fst c.cl_path, snd c.cl_path, s with
+	let field c =
+		match fst c.cl_path, snd c.cl_path, s with
 		| [], "Math", "NaN"
 		| [], "Math", "NEGATIVE_INFINITY"
 		| [], "Math", "POSITIVE_INFINITY"
@@ -349,7 +337,14 @@ and gen_field_access ctx t s =
 		->
 			print ctx "[\"%s\"]" s
 		| _ ->
-			print ctx ".%s" (s_ident s));
+			print ctx ".%s" (s_ident s)
+	in
+	match follow t with
+	| TInst (c,_) -> field c
+	| TAnon a ->
+		(match !(a.a_status) with
+		| Statics c -> field c
+		| _ -> print ctx ".%s" (s_ident s))
 	| _ ->
 		print ctx ".%s" (s_ident s)
 

genswf8.ml

@@ -183,7 +183,7 @@ let rec is_protected_path path ext =
 	| _ -> false
 
 let rec is_protected ctx ?(stat=false) t field =
-	match t with
+	match follow t with
 	| TInst (c,_) ->
 		let rec loop c =
 			(is_protected_path c.cl_path c.cl_extern && PMap.mem field (if stat then c.cl_statics else c.cl_fields))
@@ -191,16 +191,10 @@ let rec is_protected ctx ?(stat=false) t field =
 			|| (not stat && match c.cl_super with None -> false | Some (c,_) -> loop c)
 		in
 		loop c
-	| TMono r ->
-		(match !r with
-		| None -> true (* in Transform.emk only *)
-		| Some t -> is_protected ctx ~stat t field)
-	| TLazy f ->
-		is_protected ctx ~stat ((!f)()) field
-	| TType (t,tl) ->
-		(match t.t_static with
-		| None -> is_protected ctx ~stat (apply_params t.t_types tl t.t_type) field
-		| Some c -> is_protected ctx ~stat:true (TInst (c,[])) field)
+	| TAnon a ->
+		(match !(a.a_status) with
+		| Statics c -> is_protected ctx ~stat:true (TInst (c,[])) field
+		| _ -> false)
 	| _ -> false
 
 let push ctx items =

genswf9.ml

@@ -193,6 +193,7 @@ let type_path ctx ?(getclass=false) path =
 		| [] , "Float" -> [] , "Number"
 		| [] , "Bool" -> [] , "Boolean"
 		| [] , "Void" -> [] , "void"
+		| [] , "Enum" -> [] , "Class"
 		| ["flash"] , "FlashXml__" -> [] , "Xml"
 		| ["flash"] , "Boot" -> [] , ctx.boot
 		| _ -> path

std/Type.hx

@@ -3,7 +3,7 @@
 	An abstract type that represents an Enum.
 	See [Type] for the haXe Reflection API.
 **/
-enum Enum {
+extern class Enum {
 }
 
 /**

type.ml

@@ -58,6 +58,7 @@ and anon_status =
 	| Closed
 	| Opened
 	| Statics of tclass
+	| EnumStatics of tenum
 
 and tanon = {
 	mutable a_fields : (string, tclass_field) PMap.t;
@@ -152,7 +153,6 @@ and tdef = {
 	t_pos : Ast.pos;
 	t_doc : Ast.documentation;
 	t_private : bool;
-	t_static : tclass option;
 	mutable t_types : (string * t) list;
 	mutable t_type : t;
 }
@@ -576,8 +576,6 @@ let rec unify a b =
 		(match !t with
 		| None -> if not (link t b a) then error [cannot_unify a b]
 		| Some t -> unify a t)
-	| TType ({ t_static = Some cl },params), TInst ({ cl_path = [],"Class" },[pt]) ->
-		unify (TInst (cl,params)) pt
 	| TType (t,tl) , _ ->
 		(try
 			unify (apply_params t.t_types tl t.t_type) b
@@ -659,6 +657,14 @@ let rec unify a b =
 			if !(a2.a_status) = Opened then a2.a_status := Closed;
 		with
 			Unify_error l -> error (cannot_unify a b :: l))
+	| TAnon an, TInst ({ cl_path = [],"Class" },[pt]) ->
+		(match !(an.a_status) with
+		| Statics cl -> unify (TInst (cl,List.map snd cl.cl_types)) pt
+		| _ -> error [cannot_unify a b])
+	| TAnon an, TInst ({ cl_path = [],"Enum" },[]) ->
+		(match !(an.a_status) with
+		| EnumStatics _ -> ()
+		| _ -> error [cannot_unify a b])
 	| TDynamic t , _ ->
 		if t == a then
 			()

typer.ml

@@ -906,9 +906,11 @@ let type_type ctx tpath p =
 			t_path = fst c.cl_path, "#" ^ snd c.cl_path;
 			t_doc = None;
 			t_pos = c.cl_pos;
-			t_type = if pub then mk_anon (PMap.map (fun f -> { f with cf_public = true }) c.cl_statics) else TAnon { a_fields = c.cl_statics; a_status = ref (Statics c) };
+			t_type = TAnon {
+				a_fields = if pub then PMap.map (fun f -> { f with cf_public = true }) c.cl_statics else c.cl_statics;
+				a_status = ref (Statics c);
+			};
 			t_private = true;
-			t_static = Some c;
 			t_types = [];
 		} in
 		mk (TTypeExpr (TClassDecl c)) (TType (t_tmp,[])) p
@@ -930,9 +932,11 @@ let type_type ctx tpath p =
 			t_path = fst e.e_path, "#" ^ snd e.e_path;
 			t_doc = None;
 			t_pos = e.e_pos;
-			t_type = mk_anon fl;
+			t_type = TAnon {
+				a_fields = fl;
+				a_status = ref (EnumStatics e);
+			};
 			t_private = true;
-			t_static = None;
 			t_types = e.e_types;
 		} in
 		mk (TTypeExpr (TEnumDecl e)) (TType (t_tmp,types)) p
@@ -2503,8 +2507,7 @@ let type_module ctx m tdecls loadp =
 				t_pos = p;
 				t_doc = d.d_doc;
 				t_private = priv;
-				t_types = [];
-				t_static = None;
+				t_types = [];				
 				t_type = mk_mono();
 			} in
 			decls := TTypeDecl t :: !decls