added variance.

git-svn-id: http://haxe.googlecode.com/svn/trunk@1432 f16182fa-f095-11de-8f43-4547254af6c6

ast.ml

@@ -132,10 +132,16 @@ type while_flag =
 	| NormalWhile
 	| DoWhile
 
+type variance =
+	| VNo
+	| VCo
+	| VContra
+	| VBi
+
 type type_path_normal = {
 	tpackage : string list;
 	tname : string;
-	tparams : type_path list;
+	tparams : (variance * type_path) list;
 }
 
 and anonymous_field =
@@ -185,7 +191,7 @@ and expr_def =
 
 and expr = expr_def * pos
 
-type type_param = string * type_path_normal list
+type type_param = variance * string * type_path_normal list
 
 type documentation = string option
 
@@ -201,11 +207,11 @@ type class_field =
 	| FFun of string * documentation * access list * type_param list * func
 	| FProp of string * documentation * access list * string * string * type_path
 
-type enum_param =
+type enum_flag =
 	| EPrivate
 	| EExtern
 
-type type_param_flag =
+type class_flag =
 	| HInterface
 	| HExtern
 	| HPrivate
@@ -214,10 +220,18 @@ type type_param_flag =
 
 type enum_constructor = string * documentation * (string * bool * type_path) list * pos
 
+type ('a,'b) definition = {
+	d_name : string;
+	d_doc : documentation;
+	d_params : type_param list;
+	d_flags : 'a list;
+	d_data : 'b;
+}
+
 type type_def =
-	| EClass of string * documentation * type_param list * type_param_flag list * (class_field * pos) list
-	| EEnum of string * documentation * type_param list * enum_param list * enum_constructor list
-	| ETypedef of string * documentation * type_param list * enum_param list * type_path
+	| EClass of (class_flag, (class_field * pos) list) definition
+	| EEnum of (enum_flag, enum_constructor list) definition
+	| ETypedef of (enum_flag, type_path) definition
 	| EImport of string list * string * string option
 
 type type_decl = type_def * pos

genxml.ml

@@ -51,14 +51,24 @@ let gen_arg_name (name,opt,_) =
 let rec gen_type t =
 	match t with
 	| TMono m -> (match !m with None -> tag "unknown" | Some t -> gen_type t)
-	| TEnum (e,params) -> node "e" [gen_path e.e_path e.e_private] (List.map gen_type params)
-	| TInst (c,params) -> node "c" [gen_path c.cl_path c.cl_private] (List.map gen_type params)
-	| TType (t,params) -> node "t" [gen_path t.t_path t.t_private] (List.map gen_type params)
+	| TEnum (e,params) -> node "e" [gen_path e.e_path e.e_private] (List.map gen_ptype params)
+	| TInst (c,params) -> node "c" [gen_path c.cl_path c.cl_private] (List.map gen_ptype params)
+	| TType (t,params) -> node "t" [gen_path t.t_path t.t_private] (List.map gen_ptype params)
 	| TFun (args,r) -> node "f" ["a",String.concat ":" (List.map gen_arg_name args)] (List.map gen_type (List.map (fun (_,_,t) -> t) args @ [r]))
 	| TAnon a -> node "a" [] (pmap (fun f -> node f.cf_name [] [gen_type f.cf_type]) a.a_fields)
 	| TDynamic t2 -> node "d" [] (if t == t2 then [] else [gen_type t2])
 	| TLazy f -> gen_type (!f())
 
+and gen_ptype (v,t) =
+	match gen_type t with
+	| Node (name,att,c) as n ->
+		(match v with
+		| VNo -> n
+		| VBi -> Node (name,("v","*") :: att,c)
+		| VCo -> Node (name,("v","+") :: att,c)
+		| VContra -> Node (name,("v","-") :: att,c))
+	| _ -> assert false
+
 let gen_constr e =
 	let doc = gen_doc_opt e.ef_doc in
 	let args, t = (match follow e.ef_type with
@@ -77,10 +87,10 @@ let gen_field att f =
 let gen_type_params priv path params pos m =
 	let mpriv = (if priv then [("private","1")] else []) in
 	let mpath = (if m.mpath <> path then [("module",snd (gen_path m.mpath false))] else []) in
-	gen_path path priv :: ("params", String.concat ":" (List.map fst params)) :: ("file",if pos == null_pos then "" else pos.pfile) :: (mpriv @ mpath)
+	gen_path path priv :: ("params", String.concat ":" (List.map (fun (_,n,_) -> n) params)) :: ("file",if pos == null_pos then "" else pos.pfile) :: (mpriv @ mpath)
 
 let gen_class_path name (c,pl) =
-	node name [("path",s_type_path c.cl_path)] (List.map gen_type pl)
+	node name [("path",s_type_path c.cl_path)] (List.map gen_ptype pl)
 
 let gen_type ctx t =
 	let m = Typer.module_of_type ctx t in

parser.ml

@@ -146,11 +146,32 @@ let rec	parse_file s =
 and parse_type_decl s =
 	match s with parser
 	| [< '(Kwd Import,p1); p, t, s = parse_import; p2 = semicolon >] -> EImport (p,t,s) , punion p1 p2
-	| [< c = parse_common_params; s >] ->
+	| [< c = parse_common_flags; s >] ->
 		match s with parser
-		| [< n , p1 = parse_enum_params; doc = get_doc; '(Const (Type name),_); tl = parse_type_params; '(BrOpen,_); l = plist parse_enum; '(BrClose,p2) >] -> (EEnum (name,doc,tl,List.map snd c @ n,l), punion p1 p2)
-		| [< n , p1 = parse_class_params; doc = get_doc; '(Const (Type name),_); tl = parse_type_params; hl = psep Comma parse_class_herit; '(BrOpen,_); fl = plist parse_class_field; '(BrClose,p2) >] -> (EClass (name,doc,tl,List.map fst c @ n @ hl,fl), punion p1 p2)
-		| [< '(Kwd Typedef,p1); doc = get_doc; '(Const (Type name),p2); tl = parse_type_params; '(Binop OpAssign,_); t = parse_type_path >] -> (ETypedef (name,doc,tl,List.map snd c,t), punion p1 p2)
+		| [< n , p1 = parse_enum_flags; doc = get_doc; '(Const (Type name),_); tl = parse_constraint_params; '(BrOpen,_); l = plist parse_enum; '(BrClose,p2) >] ->
+			(EEnum {
+				d_name = name;
+				d_doc = doc;
+				d_params = tl;
+				d_flags = List.map snd c @ n;
+				d_data = l
+			}, punion p1 p2)
+		| [< n , p1 = parse_class_flags; doc = get_doc; '(Const (Type name),_); tl = parse_constraint_params; hl = psep Comma parse_class_herit; '(BrOpen,_); fl = plist parse_class_field; '(BrClose,p2) >] ->
+			(EClass {
+				d_name = name;
+				d_doc = doc;
+				d_params = tl;
+				d_flags = List.map fst c @ n @ hl;
+				d_data = fl;
+			}, punion p1 p2)
+		| [< '(Kwd Typedef,p1); doc = get_doc; '(Const (Type name),p2); tl = parse_constraint_params; '(Binop OpAssign,_); t = parse_type_path >] ->
+			(ETypedef {
+				d_name = name;
+				d_doc = doc;
+				d_params = tl;
+				d_flags = List.map snd c;
+				d_data = t;
+			}, punion p1 p2)
 
 and parse_package s = psep Dot ident s
 
@@ -161,15 +182,15 @@ and parse_import = parser
 			| [< '(Dot,_); '(Const (Type s),_) >] -> Some s
 			| [< >] -> None
 
-and parse_common_params = parser
-	| [< '(Kwd Private,_); l = parse_common_params >] -> (HPrivate, EPrivate) :: l
-	| [< '(Kwd Extern,_); l = parse_common_params >] -> (HExtern, EExtern) :: l
+and parse_common_flags = parser
+	| [< '(Kwd Private,_); l = parse_common_flags >] -> (HPrivate, EPrivate) :: l
+	| [< '(Kwd Extern,_); l = parse_common_flags >] -> (HExtern, EExtern) :: l
 	| [< >] -> []
 
-and parse_enum_params = parser
+and parse_enum_flags = parser
 	| [< '(Kwd Enum,p) >] -> [] , p
 
-and parse_class_params = parser
+and parse_class_flags = parser
 	| [< '(Kwd Class,p) >] -> [] , p
 	| [< '(Kwd Interface,p) >] -> [HInterface] , p
 
@@ -198,7 +219,7 @@ and parse_type_path1 pack = parser
 	| [< '(Const (Ident name),_); '(Dot,_); t = parse_type_path1 (name :: pack) >] -> t
 	| [< '(Const (Type name),_); s >] ->
 		let params = (match s with parser
-			| [< '(Binop OpLt,_); l = psep Comma parse_type_path; '(Binop OpGt,_) >] -> l
+			| [< '(Binop OpLt,_); l = psep Comma parse_type_path_variance; '(Binop OpGt,_) >] -> l
 			| [< >] -> []
 		) in
 		{
@@ -207,6 +228,12 @@ and parse_type_path1 pack = parser
 			tparams = params
 		}
 
+and parse_type_path_variance = parser
+	| [< '(Binop OpAdd,_); t = parse_type_path >] -> VCo, t
+	| [< '(Binop OpSub,_); t = parse_type_path >] -> VContra, t
+	| [< '(Binop OpMult,_); t = parse_type_path >] -> VBi, t
+	| [< t = parse_type_path >] -> VNo, t
+
 and parse_type_path_next t = parser
 	| [< '(Arrow,_); t2 = parse_type_path >] ->
 		(match t2 with
@@ -256,7 +283,7 @@ and parse_class_field s =
 				| [< >] -> serror()
 				) in
 				(FVar (name,doc,l,t,e),punion p1 p2))
-		| [< '(Kwd Function,p1); name = parse_fun_name; pl = parse_type_params; '(POpen,_); al = psep Comma parse_fun_param; '(PClose,_); t = parse_type_opt; s >] ->
+		| [< '(Kwd Function,p1); name = parse_fun_name; pl = parse_constraint_params; '(POpen,_); al = psep Comma parse_fun_param; '(PClose,_); t = parse_type_opt; s >] ->
 			let e = (match s with parser
 				| [< e = expr >] -> e
 				| [< '(Semicolon,p) >] -> (EBlock [],p)
@@ -300,19 +327,23 @@ and parse_fun_param_type = parser
 	| [< '(Question,_); name = any_ident; '(DblDot,_); t = parse_type_path >] -> (name,true,t)
 	| [< name = any_ident; '(DblDot,_); t = parse_type_path >] -> (name,false,t)
 
-and parse_type_params = parser
-	| [< '(Binop OpLt,_); l = psep Comma parse_type_param; '(Binop OpGt,_) >] -> l
+and parse_constraint_params = parser
+	| [< '(Binop OpLt,_); l = psep Comma parse_constraint_param; '(Binop OpGt,_) >] -> l
 	| [< >] -> []
 
-and parse_type_param = parser
-	| [< '(Const (Type name),_); s >] ->
-		match s with parser
-		| [< '(DblDot,_); s >] ->
-			(match s with parser
-			| [< '(POpen,_); l = psep Comma parse_type_path_normal; '(PClose,_) >] -> (name,l)
-			| [< t = parse_type_path_normal >] -> (name,[t])
-			| [< >] -> serror())
-		| [< >] -> (name,[])
+and parse_constraint_param = parser
+	| [< '(Binop OpAdd,_); '(Const (Type name),_); s >] -> parse_constraint_param_next VCo name s
+	| [< '(Binop OpSub,_); '(Const (Type name),_); s >] -> parse_constraint_param_next VContra name s
+	| [< '(Binop OpMult,_); '(Const (Type name),_); s >] -> parse_constraint_param_next VBi name s
+	| [< '(Const (Type name),_); s >] -> parse_constraint_param_next VNo name s
+
+and parse_constraint_param_next v name = parser
+	| [< '(DblDot,_); s >] ->
+		(match s with parser
+		| [< '(POpen,_); l = psep Comma parse_type_path_normal; '(PClose,_) >] -> (v,name,l)
+		| [< t = parse_type_path_normal >] -> (v,name,[t])
+		| [< >] -> serror())
+	| [< >] -> (v,name,[])
 
 and parse_class_herit = parser
 	| [< '(Kwd Extends,_); t = parse_type_path_normal >] -> HExtends t
@@ -361,7 +392,7 @@ and parse_obj_decl = parser
 		| [< >] -> [])
 	| [< >] -> []
 
-and parse_array_decl = parser 
+and parse_array_decl = parser
 	| [< e = expr; s >] ->
 		(match s with parser
 		| [< '(Comma,_); l = parse_array_decl >] -> e :: l
@@ -483,9 +514,9 @@ let parse code file =
 	cache := DynArray.create();
 	doc := None;
 	Lexer.init file;
-	let rec next_token() = process_token (Lexer.token code) 
+	let rec next_token() = process_token (Lexer.token code)
 
-	and process_token tk =		
+	and process_token tk =
 		match fst tk with
 		| Comment s ->
 			let l = String.length s in
@@ -545,17 +576,17 @@ let parse code file =
 
 	and skip_tokens_loop test tk =
 		match fst tk with
-		| Macro "end" ->			
+		| Macro "end" ->
 			Lexer.token code
-		| Macro "else" when not test ->			
+		| Macro "else" when not test ->
 			skip_tokens test
-		| Macro "else" ->			
+		| Macro "else" ->
 			enter_macro()
-		| Macro "if" ->			
+		| Macro "if" ->
 			skip_tokens_loop test (skip_tokens false)
-		| Eof ->			
+		| Eof ->
 			raise Exit
-		| _ ->			
+		| _ ->
 			skip_tokens test
 
 	and skip_tokens test = skip_tokens_loop test (Lexer.token code)

std/StdTypes.hx

@@ -51,3 +51,9 @@ typedef Iterator<T> = {
 }
 
 extern interface ArrayAccess<T> { }
+
+/**
+   Protected represent the type parameter that cannot be used when using variance annotations.
+*/
+extern enum Protected {	
+}