macros working !

Makefile.win

@@ -8,9 +8,9 @@ LFLAGS=-g -o haxe.exe -I ../neko/libs/include/ocaml
 OUTPUT=sed 's/File "\([^"]\+\)", line \([0-9]\+\), \(.*\)/\1(\2): \3/' tmp.cmi
 
 FILES = ast.cmx lexer.cmx type.cmx common.cmx parser.cmx typecore.cmx \
-	genxml.cmx typeload.cmx codegen.cmx optimizer.cmx typer.cmx \
+	genxml.cmx typeload.cmx codegen.cmx optimizer.cmx \
 	../neko/libs/include/ocaml/nast.cmx ../neko/libs/include/ocaml/binast.cmx ../neko/libs/include/ocaml/nxml.cmx \
-	genneko.cmx genas3.cmx genjs.cmx genswf8.cmx genswf9.cmx genswf.cmx genphp.cmx gencpp.cmx interp.cmx \
+	genneko.cmx genas3.cmx genjs.cmx genswf8.cmx genswf9.cmx genswf.cmx genphp.cmx gencpp.cmx interp.cmx typer.cmx \
 	main.cmx
 	
 all: haxe.exe
@@ -26,7 +26,7 @@ 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 
+genneko.cmx: type.cmx lexer.cmx common.cmx codegen.cmx ast.cmx ../neko/libs/include/ocaml/binast.cmx ../neko/libs/include/ocaml/nxml.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 
@@ -40,10 +40,10 @@ 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 
+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 
+    lexer.cmx common.cmx codegen.cmx ast.cmx interp.cmx
 interp.cmx: genneko.cmx type.cmx
 
 clean:

ast.ml

@@ -134,7 +134,7 @@ type while_flag =
 	| NormalWhile
 	| DoWhile
 
-type type_path_normal = {
+type type_path = {
 	tpackage : string list;
 	tname : string;
 	tparams : type_param_or_const list;
@@ -151,11 +151,11 @@ and anonymous_field =
 	| AFFun of (string * bool * complex_type) list * complex_type
 
 and complex_type =
-	| CTPath of type_path_normal
+	| CTPath of type_path
 	| CTFunction of complex_type list * complex_type
 	| CTAnonymous of (string * bool option * anonymous_field * pos) list
 	| CTParent of complex_type
-	| CTExtend of type_path_normal * (string * bool option * anonymous_field * pos) list
+	| CTExtend of type_path * (string * bool option * anonymous_field * pos) list
 
 type func = {
 	f_args : (string * bool * complex_type option * expr option) list;
@@ -173,7 +173,7 @@ and expr_def =
 	| EObjectDecl of (string * expr) list
 	| EArrayDecl of expr list
 	| ECall of expr * expr list
-	| ENew of type_path_normal * expr list
+	| ENew of type_path * expr list
 	| EUnop of unop * unop_flag * expr
 	| EVars of (string * complex_type option * expr option) list
 	| EFunction of func
@@ -190,12 +190,12 @@ and expr_def =
 	| EThrow of expr
 	| ECast of expr * complex_type option
 	| EDisplay of expr * bool
-	| EDisplayNew of type_path_normal
+	| EDisplayNew of type_path
 	| ETernary of expr * expr * expr
 
 and expr = expr_def * pos
 
-type type_param = string * type_path_normal list
+type type_param = string * type_path list
 
 type documentation = string option
 
@@ -222,8 +222,8 @@ type class_flag =
 	| HInterface
 	| HExtern
 	| HPrivate
-	| HExtends of type_path_normal
-	| HImplements of type_path_normal
+	| HExtends of type_path
+	| HImplements of type_path
 
 type enum_constructor = string * documentation * metadata * (string * bool * complex_type) list * pos
 
@@ -240,8 +240,8 @@ type type_def =
 	| EClass of (class_flag, (class_field * pos) list) definition
 	| EEnum of (enum_flag, enum_constructor list) definition
 	| ETypedef of (enum_flag, complex_type) definition
-	| EImport of type_path_normal
-	| EUsing of type_path_normal
+	| EImport of type_path
+	| EUsing of type_path
 
 type type_decl = type_def * pos
 

common.ml

@@ -123,6 +123,28 @@ let create v =
 		lines = Lexer.build_line_index();
 	}
 
+let clone com =
+	let t = com.type_api in
+	{ com with type_api = { t with tvoid = t.tvoid } }
+
+let platforms = [
+	Flash;
+	Js;
+	Neko;
+	Flash9;
+	Php;
+	Cpp
+]
+
+let platform_name = function
+	| Cross -> "cross"
+	| Flash -> "flash"
+	| Js -> "js"
+	| Neko -> "neko"
+	| Flash9 -> "flash9"
+	| Php -> "php"
+	| Cpp -> "cpp"
+
 let defined ctx v = PMap.mem v ctx.defines
 
 let define ctx v =
@@ -130,6 +152,13 @@ let define ctx v =
 	let v = String.concat "_" (ExtString.String.nsplit v "-") in
 	ctx.defines <- PMap.add v () ctx.defines
 
+let init_platform com pf =
+	com.platform <- pf;
+	let name = platform_name pf in
+	let forbid acc p = if p = name || PMap.mem p acc then acc else PMap.add p Forbidden acc in
+	com.package_rules <- List.fold_left forbid com.package_rules (List.map platform_name platforms);
+	define com name
+
 let error msg p = raise (Abort (msg,p))
 
 let platform ctx p = ctx.platform = p

doc/install.ml

@@ -146,10 +146,10 @@ let compile() =
 	] in
 	let mlist = [
 		"ast";"lexer";"type";"common";"parser";"typecore";
-		"genxml";"typeload";"codegen";"optimizer";"typer";
+		"genxml";"typeload";"codegen";"optimizer";
 		neko^"/nast";neko^"/binast";neko^"/nxml";
 		"genneko";"genas3";"genjs";"genswf8";"genswf9";"genswf";"genphp";"gencpp";
-		"interp";"main";
+		"interp";"typer";"main";
 	] in
 	let path_str = String.concat " " (List.map (fun s -> "-I " ^ s) paths) in
 	let libs_str ext = " " ^ String.concat " " (List.map (fun l -> l ^ ext) libs) ^ " " in

genneko.ml

@@ -24,6 +24,9 @@ open Common
 
 type context = {
 	com : Common.context;
+	packages : (string list, unit) Hashtbl.t;
+	globals : (string list * string, string) Hashtbl.t;
+	mutable curglobal : int;
 	mutable macros : bool;
 	mutable curclass : string;
 	mutable curmethod : string;
@@ -65,6 +68,18 @@ let pos ctx p =
 		pline = Lexer.find_line_index ctx.com.lines p;
 	}
 
+let gen_global_name ctx path =
+	match path with
+	| [], name -> name
+	| _ ->
+	try
+		Hashtbl.find ctx.globals path
+	with Not_found ->
+		let name = "@G" ^ string_of_int ctx.curglobal in
+		ctx.curglobal <- ctx.curglobal + 1;
+		Hashtbl.add ctx.globals path name;
+		name
+
 let add_local ctx v p =
 	let rec loop flag e =
 		match e.eexpr with
@@ -605,15 +620,17 @@ let gen_enum ctx e =
 	ctx.curclass <- s_type_path e.e_path;
 	ctx.curmethod <- "$init";
 	let p = pos ctx e.e_pos in
-	let path = gen_type_path p (fst e.e_path,snd e.e_path) in
+	let path = gen_type_path p e.e_path in
+	let uname = (EConst (Ident (gen_global_name ctx e.e_path)),p) in
 	(EBlock (
-		(EBinop ("=",path, call p (builtin p "new") [null p]),p) ::
-		(EBinop ("=",field p path "prototype", (EObject [
-			"__enum__" , path;
+		(EBinop ("=",uname, call p (builtin p "new") [null p]),p) ::
+		(EBinop ("=",path, uname),p) ::
+		(EBinop ("=",field p uname "prototype", (EObject [
+			"__enum__" , uname;
 			"__serialize" , ident p "@serialize";
 			"__string" , ident p "@enum_to_string"
 		],p)),p) ::
-		pmap_list (gen_enum_constr ctx path) e.e_constrs @
+		pmap_list (gen_enum_constr ctx uname) e.e_constrs @
 		(match e.e_path with
 		| [] , name -> [EBinop ("=",field p (ident p "@classes") name,ident p name),p]
 		| _ -> [])
@@ -660,16 +677,16 @@ let gen_static_vars ctx t =
 						),p) :: acc
 			) c.cl_ordered_statics []
 
-let gen_package ctx h t =
+let gen_package ctx t =
 	let rec loop acc p =
 		match p with
 		| [] -> []
 		| x :: l ->
 			let path = acc @ [x] in
-			if not (Hashtbl.mem h path) then begin
+			if not (Hashtbl.mem ctx.packages path) then begin
 				let p = pos ctx (match t with TClassDecl c -> c.cl_pos | TEnumDecl e -> e.e_pos | TTypeDecl t -> t.t_pos) in
 				let e = (EBinop ("=",gen_type_path p (acc,x),call p (builtin p "new") [null p]),p) in
-				Hashtbl.add h path ();
+				Hashtbl.add ctx.packages path ();
 				(match acc with
 				| [] ->
 					let reg = (EBinop ("=",field p (ident p "@classes") x,ident p x),p) in
@@ -740,6 +757,9 @@ let generate_libs_init = function
 let new_context com macros =
 	{
 		com = com;
+		globals = Hashtbl.create 0;
+		curglobal = 0;
+		packages = Hashtbl.create 0;
 		macros = macros;
 		curclass = "$boot";
 		curmethod = "$init";
@@ -781,22 +801,26 @@ let header() =
 	) [0;1;2;3;4;5] in
 	List.map (fun (v,e)-> EBinop ("=",ident p v,e),p) inits
 
-let generate com libs =
-	let ctx = new_context com false in
-	let t = Common.timer "neko generation" in
-	let h = Hashtbl.create 0 in
-	let libs = (ENeko (generate_libs_init libs) , { psource = "<header>"; pline = 1; }) in
-	let packs = List.concat (List.map (gen_package ctx h) com.types) in
-	let names = List.fold_left (gen_name ctx) [] com.types in
-	let methods = List.rev (List.fold_left (fun acc t -> gen_type ctx t acc) [] com.types) in
+let build ctx types =
+	let packs = List.concat (List.map (gen_package ctx) types) in
+	let names = List.fold_left (gen_name ctx) [] types in
+	let methods = List.rev (List.fold_left (fun acc t -> gen_type ctx t acc) [] types) in
 	let boot = gen_boot ctx in
 	let inits = List.map (fun (c,e) ->
 		ctx.curclass <- s_type_path c.cl_path;
 		ctx.curmethod <- "__init__";
 		gen_expr ctx e
 	) (List.rev ctx.inits) in
-	let vars = List.concat (List.map (gen_static_vars ctx) com.types) in
-	let e = (EBlock ((header()) @ libs :: packs @ methods @ boot :: names @ inits @ vars), null_pos) in
+	ctx.inits <- [];
+	let vars = List.concat (List.map (gen_static_vars ctx) types) in
+	packs @ methods @ boot :: names @ inits @ vars
+
+let generate com libs =
+	let ctx = new_context com false in
+	let t = Common.timer "neko generation" in
+	let libs = (ENeko (generate_libs_init libs) , { psource = "<header>"; pline = 1; }) in	
+	let el = build ctx com.types in
+	let e = (EBlock ((header()) @ libs :: el), null_pos) in
 	let neko_file = (try Filename.chop_extension com.file with _ -> com.file) ^ ".neko" in
 	let ch = IO.output_channel (open_out_bin neko_file) in
 	let source = Common.defined com "neko_source" in

interp.ml

@@ -19,6 +19,9 @@
 open Nast
 open Unix
 
+(* ---------------------------------------------------------------------- *)
+(* TYPES *)
+
 type value =
 	| VNull
 	| VBool of bool
@@ -62,9 +65,10 @@ type cmp =
 type context = {
 	com : Common.context;
 	gen : Genneko.context;
-	packages : (string list,unit) Hashtbl.t;
 	types : (Type.path,bool) Hashtbl.t;
 	globals : (string, value) Hashtbl.t;
+	prototypes : (string list, vobject) Hashtbl.t;
+	mutable enums : string array array;
 	mutable do_call : value -> value -> value list -> pos -> value;
 	mutable do_string : value -> string;
 	mutable do_loadprim : value -> value -> value;
@@ -89,6 +93,9 @@ exception Continue
 exception Break of value
 exception Return of value
 
+(* ---------------------------------------------------------------------- *)
+(* UTILS *)
+
 let get_ctx_ref = ref (fun() -> assert false)
 let get_ctx() = (!get_ctx_ref)()
 
@@ -184,6 +191,9 @@ let rec get_field_opt o fname =
 		| None -> None
 		| Some p -> get_field_opt p fname
 
+(* ---------------------------------------------------------------------- *)
+(* BUILTINS *)
+
 let builtins =
 	let p = { psource = "<builtin>"; pline = 0 } in
 	let error() =
@@ -502,6 +512,9 @@ let builtins =
 	Hashtbl.add h "exports" (VObject { ofields = Hashtbl.create 0; oproto = None });
 	h
 
+(* ---------------------------------------------------------------------- *)
+(* STD LIBRARY *)
+
 let std_lib =
 	let error() =
 		raise Builtin_error
@@ -859,6 +872,9 @@ let std_lib =
 	List.iter (fun (n,f) -> Hashtbl.add h n f) funcs;
 	h
 
+(* ---------------------------------------------------------------------- *)
+(* EVAL *)
+
 let throw ctx p msg =
 	ctx.stack <- p :: ctx.stack;
 	exc (VString msg)
@@ -1299,6 +1315,9 @@ and call ctx vthis vfun pl p =
 	ctx.stack <- oldstack;
 	ret
 
+(* ---------------------------------------------------------------------- *)
+(* OTHERS *)
+
 let rec to_string ctx n v =
 	if n > 5 then
 		"<...>"
@@ -1393,9 +1412,10 @@ let create com =
 	let ctx = {
 		com = com;
 		gen = Genneko.new_context com true;
-		packages = Hashtbl.create 0;
 		types = Hashtbl.create 0;
+		prototypes = Hashtbl.create 0;
 		globals = Hashtbl.create 0;
+		enums = [||];
 		locals = PMap.empty;
 		stack = [];
 		exc = [];
@@ -1414,28 +1434,43 @@ let create com =
 	List.iter (fun e -> ignore(eval ctx e)) (Genneko.header());
 	ctx
 
-let add_types ctx types =
-	let t = Common.timer "macro execution" in
-	let packs = List.concat (List.map (Genneko.gen_package ctx.gen ctx.packages) types) in
-	let names = List.fold_left (Genneko.gen_name ctx.gen) [] types in
-	let methods = List.rev (List.fold_left (fun acc t -> Genneko.gen_type ctx.gen t acc) [] types) in
-	let boot = Genneko.gen_boot ctx in
-	let inits = List.map (fun (c,e) ->
-		ctx.gen.Genneko.curclass <- Ast.s_type_path c.Type.cl_path;
-		ctx.gen.Genneko.curmethod <- "__init__";
-		Genneko.gen_expr ctx.gen e
-	) (List.rev ctx.gen.Genneko.inits) in
-	let vars = List.concat (List.map (Genneko.gen_static_vars ctx.gen) types) in
-	let e = (EBlock (packs @ methods @ boot :: names @ inits @ vars), null_pos) in
-	(try
-		ignore(eval ctx e);
+let catch_errors ctx f =
+	try
+		f();
 	with Runtime v ->
 		raise (Error (to_string ctx 0 v,List.map make_pos ctx.stack))
-	);
-	t();
 
+let add_types ctx types =
+	let types = List.filter (fun t ->
+		let path = Type.t_path t in
+		if Hashtbl.mem ctx.types path then false else begin
+			Hashtbl.add ctx.types path true;
+			true;
+		end
+	) types in
+	let e = (EBlock (Genneko.build ctx.gen types), null_pos) in
+	catch_errors ctx (fun() -> ignore(eval ctx e))
+
+let get_path ctx path p =
+	let rec loop = function
+		| [] -> assert false
+		| [x] -> (EConst (Ident x),p)
+		| x :: l -> (EField (loop l,x),p)
+	in
+	eval ctx (loop (List.rev path))
 
-open Ast
+let call_path ctx path f vl p =	
+	let p = Genneko.pos ctx.gen p in
+	catch_errors ctx (fun() ->
+		match get_path ctx path p with
+		| VObject o ->
+			let f = get_field o f in
+			call ctx (VObject o) f vl p
+		| _ -> assert false
+	)
+
+(* ---------------------------------------------------------------------- *)
+(* EXPR ENCODING *)
 
 type enum_index =
 	| IExpr
@@ -1446,6 +1481,35 @@ type enum_index =
 	| IType
 	| IField
 
+let enum_name = function
+	| IExpr -> "ExprDef"
+	| IBinop -> "Binop"
+	| IUnop -> "Unop"
+	| IConst -> "Constant"
+	| ITParam -> "TypeParam"
+	| IType -> "ComplexType"
+	| IField -> "FieldType"
+
+let init ctx =
+	let enums = [IExpr;IBinop;IUnop;IConst;ITParam;IType;IField] in
+	let get_enum_proto e =
+		match get_path ctx ["haxe";"macro";enum_name e;"__constructs__"] null_pos with
+		| VObject cst -> 
+			(match get_field cst "__a" with
+				| VArray a -> 
+					Array.map (fun s -> 
+						match s with
+						| VObject s -> (match get_field s "__s" with VString s -> s | _ -> assert false)
+						| _ -> assert false
+					) a
+				| _ -> assert false
+			)
+		| _ -> assert false
+	in
+	ctx.enums <- Array.of_list (List.map get_enum_proto enums)
+
+open Ast
+
 let null f = function
 	| None -> VNull
 	| Some v -> f v
@@ -1453,22 +1517,54 @@ let null f = function
 let encode_pos p =
 	VAbstract (APos p)	
 
-let enc_array l = VArray (Array.of_list l)
+let enc_inst path fields =
+	let h = Hashtbl.create 0 in
+	List.iter (fun (f,v) -> Hashtbl.add h f v) fields;
+	let ctx = get_ctx() in
+	let p = (try Hashtbl.find ctx.prototypes path with Not_found -> try
+		(match get_path ctx (path@["prototype"]) Nast.null_pos with
+		| VObject o -> o
+		| _ -> raise (Runtime VNull))
+	with Runtime _ ->
+		failwith ("Prototype not found " ^ String.concat "." path)
+	) in
+	VObject {
+		ofields = h;
+		oproto = Some p;
+	}
+
+let enc_array l = 
+	let a = Array.of_list l in
+	enc_inst ["Array"] [
+		"__a", VArray a;
+		"length", VInt (Array.length a);
+	]
+
+let enc_string s =
+	enc_inst ["String"] [
+		"__s", VString s;
+		"length", VInt (String.length s)
+	]
 
 let enc_obj l = VObject (obj l)
 
-let enc_enum (i:enum_index) tag pl =
-	let eindex : int = Obj.magic i in
-	enc_array (VInt eindex :: VInt tag :: pl)
+let enc_enum (i:enum_index) index pl =
+	let eindex : int = Obj.magic i in	
+	let etags = (get_ctx()).enums.(eindex) in
+	enc_inst ["haxe";"macro";enum_name i] [
+		"tag", VString etags.(index);
+		"index", VInt index;
+		"args", VArray (Array.of_list pl);
+	]
 
 let encode_const c =
 	let tag, pl = match c with
-	| Int s -> 0, [VString s]
-	| Float s -> 1, [VString s]
-	| String s -> 2, [VString s]
-	| Ident s -> 3, [VString s]
-	| Type s -> 4, [VString s]
-	| Regexp (s,opt) -> 5, [VString s;VString opt]
+	| Int s -> 0, [enc_string s]
+	| Float s -> 1, [enc_string s]
+	| String s -> 2, [enc_string s]
+	| Ident s -> 3, [enc_string s]
+	| Type s -> 4, [enc_string s]
+	| Regexp (s,opt) -> 5, [enc_string s;enc_string opt]
 	in
 	enc_enum IConst tag pl
 
@@ -1511,10 +1607,10 @@ let encode_unop op =
 
 let rec encode_path t =
 	enc_obj [
-		"pack", enc_array (List.map (fun s -> VString s) t.tpackage);
-		"name", VString t.tname;
+		"pack", enc_array (List.map enc_string t.tpackage);
+		"name", enc_string t.tname;
 		"params", enc_array (List.map encode_tparam t.tparams);
-		"sub", null (fun s -> VString s) t.tsub;
+		"sub", null enc_string t.tsub;
 	]
 
 and encode_tparam = function
@@ -1524,17 +1620,17 @@ and encode_tparam = function
 and encode_field (f,pub,field,pos) =
 	let tag, pl = match field with
 		| AFVar t -> 0, [encode_type t]
-		| AFProp (t,get,set) -> 1, [encode_type t; VString get; VString set]
+		| AFProp (t,get,set) -> 1, [encode_type t; enc_string get; enc_string set]
 		| AFFun (pl,t) -> 2, [enc_array (List.map (fun (n,opt,t) ->
 			enc_obj [
-				"name", VString n;
+				"name", enc_string n;
 				"opt", VBool opt;
 				"type", encode_type t
 			]
 		) pl); encode_type t]
 	in
 	enc_obj [
-		"name",VString f;
+		"name",enc_string f;
 		"isPublic",null (fun b -> VBool b) pub;
 		"type", enc_enum IField tag pl;
 		"pos", encode_pos pos;
@@ -1565,14 +1661,14 @@ let encode_expr e =
 			| EBinop (op,e1,e2) ->
 				2, [encode_binop op;loop e1;loop e2]
 			| EField (e,f) ->
-				3, [VString f]
+				3, [enc_string f]
 			| EType (e,f) ->
-				4, [VString f]
+				4, [enc_string f]
 			| EParenthesis e ->
 				5, [loop e]
 			| EObjectDecl fl ->
 				6, [enc_array (List.map (fun (f,e) -> enc_obj [
-					"field",VString f;
+					"field",enc_string f;
 					"expr",loop e;
 				]) fl)]
 			| EArrayDecl el ->
@@ -1586,8 +1682,8 @@ let encode_expr e =
 			| EVars vl ->
 				11, [enc_array (List.map (fun (v,t,eo) ->
 					enc_obj [
-						"name",VString v;
-						"ret",null encode_type t;
+						"name",enc_string v;
+						"type",null encode_type t;
 						"expr",null loop eo;
 					]
 				) vl)]
@@ -1595,7 +1691,7 @@ let encode_expr e =
 				12, [enc_obj [
 					"args", enc_array (List.map (fun (n,opt,t,e) ->
 						enc_obj [
-							"name", VString n;
+							"name", enc_string n;
 							"opt", VBool opt;
 							"type", null encode_type t;
 							"value", null loop e;
@@ -1607,7 +1703,7 @@ let encode_expr e =
 			| EBlock el ->
 				13, [enc_array (List.map loop el)]
 			| EFor (v,e,eloop) ->
-				14, [VString v;loop e;loop eloop]
+				14, [enc_string v;loop e;loop eloop]
 			| EIf (econd,e,eelse) ->
 				15, [loop econd;loop e;null loop eelse]
 			| EWhile (econd,e,flag) ->
@@ -1622,7 +1718,7 @@ let encode_expr e =
 			| ETry (e,catches) ->
 				18, [loop e;enc_array (List.map (fun (v,t,e) ->
 					enc_obj [
-						"name",VString v;
+						"name",enc_string v;
 						"type",encode_type t;
 						"expr",loop e
 					]
@@ -1651,3 +1747,216 @@ let encode_expr e =
 	in
 	loop e
 
+(* ---------------------------------------------------------------------- *)
+(* EXPR DECODING *)
+
+exception Invalid_expr
+
+let opt f v =
+	match v with
+	| VNull -> None
+	| _ -> Some (f v)
+
+let decode_pos = function
+	| VAbstract (APos p) -> p
+	| _ -> raise Invalid_expr
+
+let field v f =
+	match v with
+	| VObject o -> (try Hashtbl.find o.ofields f with Not_found -> VNull)
+	| _ -> raise Invalid_expr
+
+let decode_enum v = 
+	match field v "index", field v "args" with
+	| VInt i, VNull -> i, []
+	| VInt i, VArray a -> i, Array.to_list a
+	| _ -> raise Invalid_expr
+
+let dec_bool = function
+	| VBool b -> b
+	| _ -> raise Invalid_expr
+
+let dec_string v =
+	match field v "__s" with
+	| VString s -> s
+	| _ -> raise Invalid_expr
+
+let dec_array v =
+	match field v "__a", field v "length" with
+	| VArray a, VInt l -> Array.to_list (if Array.length a = l then a else Array.sub a 0 l)
+	| _ -> raise Invalid_expr
+
+let decode_const c =
+	match decode_enum c with
+	| 0, [s] -> Int (dec_string s)
+	| 1, [s] -> Float (dec_string s)
+	| 2, [s] -> String (dec_string s)
+	| 3, [s] -> Ident (dec_string s)
+	| 4, [s] -> Type (dec_string s)
+	| 5, [s;opt] -> Regexp (dec_string s, dec_string opt)
+	| _ -> raise Invalid_expr
+
+let rec decode_op op =
+	match decode_enum op with
+	| 0, [] -> OpAdd
+	| 1, [] -> OpMult
+	| 2, [] -> OpDiv
+	| 3, [] -> OpSub
+	| 4, [] -> OpAssign
+	| 5, [] -> OpEq
+	| 6, [] -> OpNotEq
+	| 7, [] -> OpGt
+	| 8, [] -> OpGte
+	| 9, [] -> OpLt
+	| 10, [] -> OpLte
+	| 11, [] -> OpAnd
+	| 12, [] -> OpOr
+	| 13, [] -> OpXor
+	| 14, [] -> OpBoolAnd
+	| 15, [] -> OpBoolOr
+	| 16, [] -> OpShl
+	| 17, [] -> OpShr
+	| 18, [] -> OpUShr
+	| 19, [] -> OpMod
+	| 20, [op] -> OpAssignOp (decode_op op)
+	| 21, [] -> OpInterval
+	| _ -> raise Invalid_expr
+
+let decode_unop op =
+	match decode_enum op with
+	| 0, [] -> Increment
+	| 1, [] -> Decrement
+	| 2, [] -> Not
+	| 3, [] -> Neg
+	| 4, [] -> NegBits
+	| _ -> raise Invalid_expr
+
+let rec decode_path t =
+	{
+		tpackage = List.map dec_string (dec_array (field t "pack"));
+		tname = dec_string (field t "name");
+		tparams = List.map decode_tparam (dec_array (field t "params"));
+		tsub = opt dec_string (field t "sub");
+	}
+
+and decode_tparam v =
+	match decode_enum v with
+	| 0,[t] -> TPType (decode_type t)
+	| 1,[c] -> TPConst (decode_const c)
+	| _ -> raise Invalid_expr
+
+and decode_field v =
+	let ftype = match decode_enum (field v "type") with
+		| 0, [t] ->
+			AFVar (decode_type t)
+		| 1, [t;get;set] ->
+			AFProp (decode_type t, dec_string get, dec_string set)
+		| 2, [pl;t] -> 
+			let pl = List.map (fun p ->
+				(dec_string (field p "name"),dec_bool (field p "opt"),decode_type (field p "type"))
+			) (dec_array pl) in
+			AFFun (pl, decode_type t)
+		| _ ->
+			raise Invalid_expr
+	in
+	(
+		dec_string (field v "name"),
+		opt dec_bool (field v "isPublic"),
+		ftype,
+		decode_pos (field v "pos")
+	)
+
+and decode_type t =
+	match decode_enum t with
+	| 0, [p] ->
+		CTPath (decode_path p)
+	| 1, [a;r] ->
+		CTFunction (List.map decode_type (dec_array a), decode_type r)
+	| 2, [fl] -> 
+		CTAnonymous (List.map decode_field (dec_array fl))
+	| 3, [t] ->
+		CTParent (decode_type t)
+	| 4, [t;fl] ->
+		CTExtend (decode_path t, List.map decode_field (dec_array fl))
+	| _ ->
+		raise Invalid_expr
+
+let decode_expr v =
+	let rec loop v =
+		(decode (field v "expr"), decode_pos (field v "pos"))
+	and decode e =
+		match decode_enum e with
+		| 0, [c] ->
+			EConst (decode_const c)
+		| 1, [e1;e2] ->
+			EArray (loop e1, loop e2)
+		| 2, [op;e1;e2] ->
+			EBinop (decode_op op, loop e1, loop e2)
+		| 3, [e;f] ->
+			EField (loop e, dec_string f)
+		| 4, [e;f] ->
+			EType (loop e, dec_string f)
+		| 5, [e] ->
+			EParenthesis (loop e)	
+		| 6, [a] ->
+			EObjectDecl (List.map (fun o ->
+				(dec_string (field o "field"), loop (field o "expr"))
+			) (dec_array a))
+		| 7, [a] ->
+			EArrayDecl (List.map loop (dec_array a))
+		| 8, [e;el] ->
+			ECall (loop e,List.map loop (dec_array el))
+		| 9, [t;el] ->
+			ENew (decode_path t,List.map loop (dec_array el))
+		| 10, [op;VBool f;e] ->
+			EUnop (decode_unop op,(if f then Postfix else Prefix),loop e)
+		| 11, [vl] ->
+			EVars (List.map (fun v ->
+				(dec_string (field v "name"),opt decode_type (field v "type"),opt loop (field v "expr"))
+			) (dec_array vl))
+		| 12, [f] ->
+			let f = {
+				f_args = List.map (fun o ->
+					(dec_string (field o "name"),dec_bool (field o "opt"),opt decode_type (field o "type"),opt loop (field o "value"))
+				) (dec_array (field f "args"));
+				f_type = opt decode_type (field f "ret");
+				f_expr = loop (field f "expr");
+			} in
+			EFunction f
+		| 13, [el] ->
+			EBlock (List.map loop (dec_array el))
+		| 14, [v;e1;e2] ->
+			EFor (dec_string v, loop e1, loop e2)
+		| 15, [e1;e2;e3] ->
+			EIf (loop e1, loop e2, opt loop e3)
+		| 16, [e1;e2;VBool flag] ->
+			EWhile (loop e1,loop e2,if flag then NormalWhile else DoWhile)
+		| 17, [e;cases;eo] ->
+			let cases = List.map (fun c ->
+				(List.map loop (dec_array (field c "values")),loop (field c "expr"))
+			) (dec_array cases) in
+			ESwitch (loop e,cases,opt loop eo)
+		| 18, [e;catches] ->
+			let catches = List.map (fun c ->
+				(dec_string (field c "name"),decode_type (field c "type"),loop (field c "expr"))
+			) (dec_array catches) in
+			ETry (loop e, catches) 
+		| 19, [e] ->
+			EReturn (opt loop e)
+		| 20, [] ->
+			EBreak
+		| 21, [] ->
+			EContinue
+		| 22, [e] ->
+			EUntyped (loop e)
+		| 23, [e] ->
+			EThrow (loop e)
+		| 24, [e;t] ->
+			ECast (loop e,opt decode_type t)
+		| 25, [e1;e2;e3] ->
+			ETernary (loop e1,loop e2,loop e3)
+		| _ ->
+			raise Invalid_expr
+	in
+	loop v
+

main.ml

@@ -227,7 +227,6 @@ try
 	let did_something = ref false in
 	let pre_compilation = ref [] in
 	let interp = ref false in
-	let root_packages = ["neko"; "flash"; "flash9"; "js"; "php"; "cpp"] in
 	Common.define com ("haxe_" ^ string_of_int version);
 	com.warning <- message;
 	com.error <- (fun msg p ->
@@ -260,13 +259,10 @@ try
 				let base_path = normalize_path (try executable_path() with _ -> "./") in
 				com.class_path <- [base_path ^ "std/";"";"/"]);
 	com.std_path <- List.filter (fun p -> ExtString.String.ends_with p "std/" || ExtString.String.ends_with p "std\\") com.class_path;
-	let set_platform pf name file =
+	let set_platform pf file =
 		if com.platform <> Cross then failwith "Multiple targets";
-		com.platform <- pf;
+		Common.init_platform com pf;
 		com.file <- file;
-		let forbid acc p = if p = name || PMap.mem p acc then acc else PMap.add p Forbidden acc in
-		com.package_rules <- List.fold_left forbid com.package_rules root_packages;
-		Common.define com name; (* define platform name *)
 		Unix.putenv "__file__" file;
 		Unix.putenv "__platform__" file;
 		if (pf = Flash || pf = Flash9) && file_extension file = "swc" then Common.define com "swc";
@@ -276,26 +272,26 @@ try
 		("-cp",Arg.String (fun path ->
 			com.class_path <- normalize_path path :: com.class_path
 		),"<path> : add a directory to find source files");
-		("-js",Arg.String (set_platform Js "js"),"<file> : compile code to JavaScript file");
-		("-swf",Arg.String (set_platform Flash "flash"),"<file> : compile code to Flash SWF file");
+		("-js",Arg.String (set_platform Js),"<file> : compile code to JavaScript file");
+		("-swf",Arg.String (set_platform Flash),"<file> : compile code to Flash SWF file");
 		("-swf9",Arg.String (fun file ->
-			set_platform Flash "flash" file;
+			set_platform Flash file;
 			if com.flash_version < 9 then com.flash_version <- 9;
 		),"<file> : compile code to Flash9 SWF file");
 		("-as3",Arg.String (fun dir ->
-			set_platform Flash "flash" dir;
+			set_platform Flash dir;
 			if com.flash_version < 9 then com.flash_version <- 9;
 			gen_as3 := true;
 			Common.define com "as3";
 			Common.define com "no_inline";
 		),"<directory> : generate AS3 code into target directory");
-		("-neko",Arg.String (set_platform Neko "neko"),"<file> : compile code to Neko Binary");
+		("-neko",Arg.String (set_platform Neko),"<file> : compile code to Neko Binary");
 		("-php",Arg.String (fun dir ->
 			classes := (["php"],"Boot") :: !classes;
-			set_platform Php "php" dir;
+			set_platform Php dir;
 		),"<directory> : generate PHP code into target directory");
 		("-cpp",Arg.String (fun dir ->
-			set_platform Cpp "cpp" dir;
+			set_platform Cpp dir;
 		),"<directory> : generate C++ code into target directory");
 		("-xml",Arg.String (fun file ->
 			Parser.use_doc := true;
@@ -349,7 +345,7 @@ try
 		),"<file> : add the SWF library to the compiled SWF");
 		("-x", Arg.String (fun file ->
 			let neko_file = file ^ ".n" in
-			set_platform Neko "neko" neko_file;
+			set_platform Neko neko_file;
 			if com.main_class = None then begin
 				let cpath = make_path file in
 				com.main_class <- Some cpath;
@@ -441,7 +437,7 @@ try
 		),"<package:target> : remap a package to another one");
 		("--interp", Arg.Unit (fun() ->
 			Common.define com "macro";
-			set_platform Neko "neko" "";
+			set_platform Neko "";
 			no_output := true;
 			interp := true;
 		),": interpret the program using internal macro system");
@@ -497,7 +493,7 @@ try
 	let ext = (match com.platform with
 		| Cross ->
 			(* no platform selected *)
-			set_platform Cross "cross" "";
+			set_platform Cross "";
 			"?"
 		| Flash | Flash9 ->
 			Common.define com ("flash" ^ string_of_int com.flash_version);

std/haxe/macro/Expr.hx

@@ -109,6 +109,7 @@ enum ComplexType {
 	TFunction( args : Array<ComplexType>, ret : ComplexType );
 	TAnonymous( fields : Array<Field> );
 	TParent( t : ComplexType );
+	TExtend( p : TypePath, fields : Array<Field> );
 }
 
 typedef TypePath = {

typecore.ml

@@ -26,7 +26,7 @@ type typer_globals = {
 	constructs : (path , Ast.access list * Ast.type_param list * Ast.func) Hashtbl.t;
 	doinline : bool;
 	mutable core_api : typer option;
-	mutable macros : typer option;
+	mutable macros : ((unit -> unit) * typer) option;
 	mutable std : module_def;
 	mutable hook_generate : (unit -> unit) list;
 }

typeload.ml

@@ -571,9 +571,9 @@ let type_meta ctx meta =
 let init_core_api ctx c =
 	let ctx2 = (match ctx.g.core_api with
 		| None ->
-			let com = ctx.com in
-			let com = { com with class_path = com.std_path; type_api = { com.type_api with tvoid = com.type_api.tvoid } } in
-			let ctx2 = (!do_create) com in
+			let com2 = Common.clone ctx.com in
+			com2.class_path <- ctx.com.std_path;
+			let ctx2 = (!do_create) com2 in
 			ctx.g.core_api <- Some ctx2;
 			ctx2
 		| Some c ->

typer.ml

@@ -98,6 +98,7 @@ let classify t =
 	| _ -> KOther
 
 let type_field_rec = ref (fun _ _ _ _ _ -> assert false)
+let type_macro_rec = ref (fun _ _ _ _ -> assert false)
 
 (* ---------------------------------------------------------------------- *)
 (* PASS 3 : type expression & check structure *)
@@ -1624,12 +1625,7 @@ and type_call ctx e el p =
 			make_call ctx et (eparam::params) tret p
 		| AKMacro (ethis,f) ->
 			(match ethis.eexpr with
-			| TTypeExpr (TClassDecl c) ->
-				let ctx2 = (match ctx.g.macros with
-					| Some ctx -> ctx
-					| None -> assert false
-				) in
-				assert false
+			| TTypeExpr (TClassDecl c) -> (!type_macro_rec) ctx c f.cf_name el p
 			| _ -> assert false)
 		| acc ->
 			let e = acc_get ctx acc p in
@@ -1903,6 +1899,49 @@ let create com =
 	| _ -> assert false);
 	ctx
 
+(* ---------------------------------------------------------------------- *)
+(* MACROS *)
+
+let type_macro ctx c f el p =
+	let t = Common.timer "macro execution" in
+	let ctx2 = (match ctx.g.macros with
+		| Some (select,ctx) -> 
+			select();
+			ctx
+		| None ->
+			let com2 = Common.clone ctx.com in
+			com2.package_rules <- PMap.empty;
+			List.iter (fun p -> com2.defines <- PMap.remove (platform_name p) com2.defines) platforms;
+			com2.class_path <- List.filter (fun s -> not (ExtString.String.exists s "/_std/")) com2.class_path;
+			com2.class_path <- List.map (fun p -> p ^ "neko" ^ "/_std/") com2.std_path @ com2.class_path;
+			Common.define com2 "macro";
+			Common.init_platform com2 Neko;
+			let ctx2 = (!Typeload.do_create) com2 in
+			let mctx = Interp.create com2 in
+			let macro = ((fun() -> Interp.select mctx), ctx2) in
+			ctx.g.macros <- Some macro;
+			ctx2.g.macros <- Some macro;
+			ctx2.g.core_api <- ctx.g.core_api;
+			ignore(Typeload.load_module ctx2 (["haxe";"macro"],"Expr") p);
+			finalize ctx2;
+			let types = types ctx2 None [] in
+			Interp.add_types mctx types;
+			Interp.init mctx;
+			ctx2
+	) in
+	let mctx = Interp.get_ctx() in
+	let m = (try Hashtbl.find ctx.g.types_module c.cl_path with Not_found -> c.cl_path) in
+	ignore(Typeload.load_module ctx2 m p);
+	finalize ctx2;
+	let types = types ctx2 None [] in
+	Interp.add_types mctx types;
+	let params = Interp.enc_array (List.map Interp.encode_expr el) in
+	let v = Interp.call_path mctx ((fst c.cl_path) @ [snd c.cl_path]) f [params] p in
+	let e = (try Interp.decode_expr v with Interp.Invalid_expr -> error "The macro didn't return a valid expression" p) in
+	t();
+	type_expr ctx e
+
 ;;
 Typeload.do_create := create;
-type_field_rec := type_field
+type_field_rec := type_field;
+type_macro_rec := type_macro;