added metadata parsing + typing (still need api + codegen)

Makefile.win

@@ -19,48 +19,31 @@ haxe.exe: $(FILES)
 	ocamlopt $(LFLAGS) $(LIBS) $(FILES)
 
 ../neko/libs/include/ocaml/binast.cmx: ../neko/libs/include/ocaml/nast.cmx
-
-genneko.cmx: type.cmx codegen.cmx ../neko/libs/include/ocaml/nxml.cmx ../neko/libs/include/ocaml/nast.cmx lexer.cmx common.cmx ../neko/libs/include/ocaml/binast.cmx ast.cmx
-
 ../neko/libs/include/ocaml/nxml.cmx: ../neko/libs/include/ocaml/nast.cmx
 
-codegen.cmx: typeload.cmx typecore.cmx type.cmx genxml.cmx common.cmx ast.cmx
-
-common.cmx: type.cmx ast.cmx
-
-genas3.cmx: type.cmx codegen.cmx common.cmx ast.cmx
-
-genjs.cmx: type.cmx codegen.cmx lexer.cmx common.cmx ast.cmx
-
-genphp.cmx: type.cmx codegen.cmx lexer.cmx common.cmx ast.cmx
-
-genswf.cmx: type.cmx codegen.cmx genswf9.cmx genswf8.cmx common.cmx ast.cmx
-
-genswf8.cmx: type.cmx codegen.cmx lexer.cmx common.cmx ast.cmx
-
-genswf9.cmx: type.cmx codegen.cmx lexer.cmx common.cmx ast.cmx
-
-genxml.cmx: type.cmx lexer.cmx common.cmx ast.cmx
-
-lexer.cmx: lexer.ml
-
-lexer.cmx: ast.cmx
-
-main.cmx: typer.cmx typeload.cmx typecore.cmx type.cmx parser.cmx lexer.cmx genxml.cmx genswf.cmx genneko.cmx genjs.cmx genas3.cmx common.cmx ast.cmx
-
-parser.cmx: parser.ml lexer.cmx common.cmx ast.cmx
+codegen.cmx: typeload.cmx typecore.cmx type.cmx genxml.cmx common.cmx ast.cmx 
+common.cmx: type.cmx lexer.cmx ast.cmx 
+genas3.cmx: type.cmx common.cmx codegen.cmx ast.cmx 
+gencpp.cmx: type.cmx common.cmx codegen.cmx ast.cmx 
+genjs.cmx: type.cmx lexer.cmx common.cmx codegen.cmx ast.cmx 
+genneko.cmx: type.cmx lexer.cmx common.cmx codegen.cmx ast.cmx 
+genphp.cmx: type.cmx lexer.cmx common.cmx codegen.cmx ast.cmx 
+genswf.cmx: type.cmx genswf9.cmx genswf8.cmx common.cmx ast.cmx 
+genswf8.cmx: type.cmx lexer.cmx common.cmx codegen.cmx ast.cmx 
+genswf9.cmx: type.cmx lexer.cmx genswf8.cmx common.cmx codegen.cmx ast.cmx 
+genxml.cmx: type.cmx lexer.cmx common.cmx ast.cmx 
+lexer.cmx: ast.cmx 
+main.cmx: typer.cmx typeload.cmx typecore.cmx type.cmx parser.cmx \
+    optimizer.cmx lexer.cmx genxml.cmx genswf.cmx genphp.cmx genneko.cmx \
+    genjs.cmx gencpp.cmx genas3.cmx common.cmx codegen.cmx ast.cmx 
+optimizer.cmx: typecore.cmx type.cmx parser.cmx common.cmx ast.cmx 
+parser.cmx: parser.ml lexer.cmx common.cmx ast.cmx 
 	(ocamlopt -pp camlp4o $(CFLAGS) -c parser.ml 2>tmp.cmi && $(OUTPUT)) || ($(OUTPUT) && exit 1)
-
-type.cmx: ast.cmx
-
-typecore.cmx: type.cmx common.cmx ast.cmx
-
-typeload.cmx: typecore.cmx type.cmx parser.cmx common.cmx ast.cmx
-
-typer.cmx: typeload.cmx typecore.cmx type.cmx parser.cmx lexer.cmx common.cmx ast.cmx codegen.cmx optimizer.cmx
-
-optimizer.cmx: type.cmx
-
+type.cmx: ast.cmx 
+typecore.cmx: type.cmx common.cmx ast.cmx 
+typeload.cmx: typecore.cmx type.cmx parser.cmx common.cmx ast.cmx 
+typer.cmx: typeload.cmx typecore.cmx type.cmx parser.cmx optimizer.cmx \
+    lexer.cmx common.cmx codegen.cmx ast.cmx 
 
 clean:
 	rm -f haxe.exe

ast.ml

@@ -124,6 +124,7 @@ type token =
 	| IntInterval of string
 	| Macro of string
 	| Question
+	| At
 
 type unop_flag =
 	| Prefix
@@ -198,6 +199,8 @@ type type_param = string * type_path_normal list
 
 type documentation = string option
 
+type metadata = (string * expr list) list
+
 type access =
 	| APublic
 	| APrivate
@@ -207,9 +210,9 @@ type access =
 	| AInline
 
 type class_field =
-	| FVar of string * documentation * access list * type_path option * expr option
-	| FFun of string * documentation * access list * type_param list * func
-	| FProp of string * documentation * access list * string * string * type_path
+	| FVar of string * documentation * metadata * access list * type_path option * expr option
+	| FFun of string * documentation * metadata * access list * type_param list * func
+	| FProp of string * documentation * metadata * access list * string * string * type_path
 
 type enum_flag =
 	| EPrivate
@@ -222,12 +225,13 @@ type class_flag =
 	| HExtends of type_path_normal
 	| HImplements of type_path_normal
 
-type enum_constructor = string * documentation * (string * bool * type_path) list * pos
+type enum_constructor = string * documentation * metadata * (string * bool * type_path) list * pos
 
 type ('a,'b) definition = {
 	d_name : string;
 	d_doc : documentation;
 	d_params : type_param list;
+	d_meta : metadata;
 	d_flags : 'a list;
 	d_data : 'b;
 }
@@ -380,6 +384,7 @@ let s_token = function
 	| IntInterval s -> s ^ "..."
 	| Macro s -> "#" ^ s
 	| Question -> "?"
+	| At -> "@"
 
 let unescape s =
 	let b = Buffer.create 0 in

codegen.ml

@@ -71,15 +71,15 @@ let extend_remoting ctx c t p async prot =
 	let decls = (try Typeload.parse_module ctx path p with e -> ctx.com.package_rules <- rules; raise e) in
 	ctx.com.package_rules <- rules;
 	let base_fields = [
-		(FVar ("__cnx",None,[],Some (TPNormal { tpackage = ["haxe";"remoting"]; tname = if async then "AsyncConnection" else "Connection"; tparams = []; tsub = None }),None),p);
-		(FFun ("new",None,[APublic],[],{ f_args = ["c",false,None,None]; f_type = None; f_expr = (EBinop (OpAssign,(EConst (Ident "__cnx"),p),(EConst (Ident "c"),p)),p) }),p);
+		(FVar ("__cnx",None,[],[],Some (TPNormal { tpackage = ["haxe";"remoting"]; tname = if async then "AsyncConnection" else "Connection"; tparams = []; tsub = None }),None),p);
+		(FFun ("new",None,[],[APublic],[],{ f_args = ["c",false,None,None]; f_type = None; f_expr = (EBinop (OpAssign,(EConst (Ident "__cnx"),p),(EConst (Ident "c"),p)),p) }),p);
 	] in
 	let tvoid = TPNormal { tpackage = []; tname = "Void"; tparams = []; tsub = None } in
 	let build_field is_public acc (f,p) =
 		match f with
-		| FFun ("new",_,_,_,_) ->
+		| FFun ("new",_,_,_,_,_) ->
 			acc
-		| FFun (name,doc,acl,pl,f) when (is_public || List.mem APublic acl) && not (List.mem AStatic acl) ->
+		| FFun (name,doc,meta,acl,pl,f) when (is_public || List.mem APublic acl) && not (List.mem AStatic acl) ->
 			if List.exists (fun (_,_,t,_) -> t = None) f.f_args then error ("Field " ^ name ^ " type is not complete and cannot be used by RemotingProxy") p;
 			let eargs = [EArrayDecl (List.map (fun (a,_,_,_) -> (EConst (Ident a),p)) f.f_args),p] in
 			let ftype = (match f.f_type with Some (TPNormal { tpackage = []; tname = "Void" }) -> None | _ -> f.f_type) in
@@ -103,7 +103,7 @@ let extend_remoting ctx c t p async prot =
 				f_type = if async then None else ftype;
 				f_expr = (EBlock [expr],p);
 			} in
-			(FFun (name,None,[APublic],pl,f),p) :: acc
+			(FFun (name,None,[],[APublic],pl,f),p) :: acc
 		| _ -> acc
 	in
 	let decls = List.map (fun d ->
@@ -156,7 +156,7 @@ let rec build_generic ctx c p tl =
 	with Error(Module_not_found path,_) when path = (pack,name) ->
 		let m = (try Hashtbl.find ctx.modules (Hashtbl.find ctx.types_module c.cl_path) with Not_found -> assert false) in
 		let ctx = { ctx with local_types = m.mtypes @ ctx.local_types } in
-		let cg = mk_class (pack,name) c.cl_pos None false in
+		let cg = mk_class (pack,name) c.cl_pos in
 		let mg = {
 			mpath = cg.cl_path;
 			mtypes = [TClassDecl cg];
@@ -243,6 +243,7 @@ let extend_xml_proxy ctx c t file p =
 						cf_type = t;
 						cf_public = true;
 						cf_doc = None;
+						cf_meta = [];
 						cf_get = ResolveAccess;
 						cf_set = NoAccess;
 						cf_params = [];

lexer.mll

@@ -229,6 +229,7 @@ and token = parse
 	| "(" { mk lexbuf POpen }
 	| ")" { mk lexbuf PClose }
 	| "?" { mk lexbuf Question }
+	| "@" { mk lexbuf At }
 	| "/*" {
 			reset();
 			let pmin = lexeme_start lexbuf in

optimizer.ml

@@ -431,7 +431,7 @@ let rec reduce_loop ctx is_sub e =
 	| TCall ({ eexpr = TFunction func } as ef,el) ->
 		(match follow ef.etype with
 		| TFun (_,rt) ->
-			let cf = { cf_name = ""; cf_params = []; cf_type = ef.etype; cf_public = true; cf_doc = None; cf_get = NormalAccess; cf_set = NoAccess; cf_expr = None } in
+			let cf = { cf_name = ""; cf_params = []; cf_type = ef.etype; cf_public = true; cf_doc = None; cf_meta = []; cf_get = NormalAccess; cf_set = NoAccess; cf_expr = None } in
 			let inl = (try type_inline ctx cf func (mk (TConst TNull) (mk_mono()) e.epos) el rt e.epos with Error (Custom _,_) -> None) in
 			(match inl with
 			| None -> e

parser.ml

@@ -165,12 +165,13 @@ and parse_type_decl s =
 	match s with parser
 	| [< '(Kwd Import,p1); t = parse_type_path_normal; p2 = semicolon >] -> EImport t, punion p1 p2
 	| [< '(Kwd Using,p1); t = parse_type_path_normal; p2 = semicolon >] -> EUsing t, punion p1 p2
-	| [< c = parse_common_flags; s >] ->
+	| [< meta = parse_meta; c = parse_common_flags; s >] ->
 		match s with parser
 		| [< 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_meta = meta;
 				d_params = tl;
 				d_flags = List.map snd c @ n;
 				d_data = l
@@ -183,6 +184,7 @@ and parse_type_decl s =
 			(EClass {
 				d_name = name;
 				d_doc = doc;
+				d_meta = meta;
 				d_params = tl;
 				d_flags = List.map fst c @ n @ hl;
 				d_data = fl;
@@ -194,6 +196,7 @@ and parse_type_decl s =
 			(ETypedef {
 				d_name = name;
 				d_doc = doc;
+				d_meta = meta;
 				d_params = tl;
 				d_flags = List.map snd c;
 				d_data = t;
@@ -208,10 +211,10 @@ and parse_class_field_resume s =
 		(* junk all tokens until we reach next variable/function or next type declaration *)
 		let rec loop() =
 			(match List.map fst (Stream.npeek 2 s) with
-			| Kwd Public :: _ | Kwd Static :: _ | Kwd Var :: _ | Kwd Override :: _ | Kwd Dynamic :: _ ->
+			| At :: _ | Kwd Public :: _ | Kwd Static :: _ | Kwd Var :: _ | Kwd Override :: _ | Kwd Dynamic :: _ ->
 				raise Exit
 			| [] | Eof :: _ | Kwd Import :: _ | Kwd Using :: _ | Kwd Extern :: _ | Kwd Class :: _ | Kwd Interface :: _ | Kwd Enum :: _ | Kwd Typedef :: _ ->
-				raise Not_found
+				raise Not_found				
 			| [Kwd Private; Kwd Function]
 			| [Kwd Private; Kwd Var] ->
 				raise Exit
@@ -244,6 +247,18 @@ and parse_common_flags = parser
 	| [< '(Kwd Extern,_); l = parse_common_flags >] -> (HExtern, EExtern) :: l
 	| [< >] -> []
 
+and parse_meta = parser
+	| [< '(At,_); name = meta_name; s >] ->
+		(match s with parser
+		| [< '(POpen,_); params = psep Comma expr; '(PClose,_); s >] -> (name,params) :: parse_meta s
+		| [< >] -> (name,[]) :: parse_meta s)
+	| [< >] -> []
+
+and meta_name = parser
+	| [< '(Const (Ident i),_) >] -> i
+	| [< '(Const (Type t),_) >] -> t
+	| [< '(Kwd k,_) >] -> s_keyword k
+
 and parse_enum_flags = parser
 	| [< '(Kwd Enum,p) >] -> [] , p
 
@@ -329,11 +344,12 @@ and parse_type_anonymous_resume name = parser
 
 and parse_enum s =
 	doc := None;
+	let meta = parse_meta s in
 	match s with parser
 	| [< name = any_ident; doc = get_doc; s >] ->
 		match s with parser
-		| [< '(POpen,_); l = psep Comma parse_enum_param; '(PClose,_); p = semicolon; >] -> (name,doc,l,p)
-		| [< '(Semicolon,p) >] -> (name,doc,[],p)
+		| [< '(POpen,_); l = psep Comma parse_enum_param; '(PClose,_); p = semicolon; >] -> (name,doc,meta,l,p)
+		| [< '(Semicolon,p) >] -> (name,doc,meta,[],p)
 		| [< >] -> serror()
 
 and parse_enum_param = parser
@@ -343,19 +359,19 @@ and parse_enum_param = parser
 and parse_class_field s =
 	doc := None;
 	match s with parser
-	| [< l = parse_cf_rights true []; doc = get_doc; s >] ->
+	| [< meta = parse_meta; l = parse_cf_rights true []; doc = get_doc; s >] ->
 		match s with parser
 		| [< '(Kwd Var,p1); name = any_ident; s >] ->
 			(match s with parser
 			| [< '(POpen,_); i1 = property_ident; '(Comma,_); i2 = property_ident; '(PClose,_); '(DblDot,_); t = parse_type_path; p2 = semicolon >] ->
-				(FProp (name,doc,l,i1,i2,t),punion p1 p2)
+				(FProp (name,doc,meta,l,i1,i2,t),punion p1 p2)
 			| [< t = parse_type_opt; s >] ->
 				let e , p2 = (match s with parser
 				| [< '(Binop OpAssign,_) when List.mem AStatic l; e = toplevel_expr; p2 = semicolon >] -> Some e , p2
 				| [< '(Semicolon,p2) >] -> None , p2
 				| [< >] -> serror()
 				) in
-				(FVar (name,doc,l,t,e),punion p1 p2))
+				(FVar (name,doc,meta,l,t,e),punion p1 p2))
 		| [< '(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 = toplevel_expr >] -> e
@@ -367,7 +383,7 @@ and parse_class_field s =
 				f_type = t;
 				f_expr = e;
 			} in
-			(FFun (name,doc,l,pl,f),punion p1 (pos e))
+			(FFun (name,doc,meta,l,pl,f),punion p1 (pos e))
 		| [< >] ->
 			if l = [] then raise Stream.Failure else serror()
 

type.ml

@@ -109,6 +109,7 @@ and tclass_field = {
 	mutable cf_type : t;
 	cf_public : bool;
 	cf_doc : Ast.documentation;
+	cf_meta : metadata;
 	cf_get : field_access;
 	cf_set : field_access;
 	cf_params : (string * t) list;
@@ -123,11 +124,14 @@ and tclass_kind =
 	| KGeneric
 	| KGenericInstance of tclass * tparams
 
+and metadata = (string * texpr list) list
+
 and tclass = {
 	cl_path : path;
 	cl_pos : Ast.pos;
-	cl_doc : Ast.documentation;
-	cl_private : bool;
+	mutable cl_private : bool;
+	mutable cl_doc : Ast.documentation;
+	mutable cl_meta : metadata;
 	mutable cl_kind : tclass_kind;
 	mutable cl_extern : bool;
 	mutable cl_interface : bool;
@@ -150,13 +154,15 @@ and tenum_field = {
 	ef_type : t;
 	ef_pos : Ast.pos;
 	ef_doc : Ast.documentation;
+	ef_meta : metadata;
 	ef_index : int;
 }
 
 and tenum = {
 	e_path : path;
 	e_pos : Ast.pos;
 	e_doc : Ast.documentation;
+	e_meta : metadata;
 	e_private : bool;
 	e_extern : bool;
 	mutable e_types : (string * t) list;
@@ -168,6 +174,7 @@ and tdef = {
 	t_path : path;
 	t_pos : Ast.pos;
 	t_doc : Ast.documentation;
+	t_meta : metadata;
 	t_private : bool;
 	mutable t_types : (string * t) list;
 	mutable t_type : t;
@@ -200,12 +207,13 @@ let tfun pl r = TFun (List.map (fun t -> "",false,t) pl,r)
 
 let fun_args l = List.map (fun (a,c,t) -> a, c <> None, t) l
 
-let mk_class path pos doc priv =
+let mk_class path pos =
 	{
 		cl_path = path;
 		cl_pos = pos;
-		cl_doc = doc;
-		cl_private = priv;
+		cl_doc = None;
+		cl_meta = [];
+		cl_private = false;
 		cl_kind = KNormal;
 		cl_extern = false;
 		cl_interface = false;
@@ -223,7 +231,10 @@ let mk_class path pos doc priv =
 		cl_overrides = [];
 	}
 
-let null_class = mk_class ([],"") Ast.null_pos None true
+let null_class = 
+	let c = mk_class ([],"") Ast.null_pos in
+	c.cl_private <- true;
+	c
 
 let arg_name (name,_,_) = name
 

typecore.ml

@@ -202,6 +202,7 @@ let mk_field name t = {
 	cf_name = name;
 	cf_type = t;
 	cf_doc = None;
+	cf_meta = [];
 	cf_public = true;
 	cf_get = NormalAccess;
 	cf_set = NormalAccess;