Răsfoiți Sursa

refactoring + allow @:build for enums

Nicolas Cannasse 15 ani în urmă
părinte
comite
0a3cd961d0
12 a modificat fișierele cu 311 adăugiri și 289 ștergeri
  1. 1 1
      ast.ml
  2. 14 15
      codegen.ml
  3. 9 19
      common.ml
  4. 1 1
      genas3.ml
  5. 1 1
      genswf.ml
  6. 8 8
      genswf9.ml
  7. 2 2
      genxml.ml
  8. 11 6
      main.ml
  9. 7 7
      optimizer.ml
  10. 9 2
      typecore.ml
  11. 60 28
      typeload.ml
  12. 188 199
      typer.ml

+ 1 - 1
ast.ml

@@ -270,7 +270,7 @@ let punion p p2 =
 
 let s_type_path (p,s) = match p with [] -> s | _ -> String.concat "." p ^ "." ^ s
 
-let s_parse_path s = 
+let parse_path s = 
 	match List.rev (ExtString.String.nsplit s ".") with
 	| [] -> failwith "Invalid empty path"
 	| x :: l -> List.rev l, x

+ 14 - 15
codegen.ml

@@ -33,13 +33,13 @@ let fcall e name el ret p =
 	mk (TCall (field e name ft p,el)) ret p
 
 let string com str p =
-	mk (TConst (TString str)) com.type_api.tstring p
+	mk (TConst (TString str)) com.basic.tstring p
 
 let binop op a b t p =
 	mk (TBinop (op,a,b)) t p
 
 let index com e index t p =
-	mk (TArray (e,mk (TConst (TInt (Int32.of_int index))) com.type_api.tint p)) t p
+	mk (TArray (e,mk (TConst (TInt (Int32.of_int index))) com.basic.tint p)) t p
 
 let concat e1 e2 =
 	let e = (match e1.eexpr, e2.eexpr with
@@ -174,7 +174,7 @@ let rec build_generic ctx c p tl =
 			match t with
 			| TInst ({ cl_kind = KGeneric } as c2,tl2) ->
 				(* maybe loop, or generate cascading generics *)
-				let _, _, f = ctx.api.build_instance (TClassDecl c2) p in
+				let _, _, f = ctx.g.do_build_instance ctx (TClassDecl c2) p in
 				f (List.map build_type tl2)
 			| _ ->
 				try List.assq t subst with Not_found -> Type.map build_type t
@@ -262,7 +262,7 @@ let extend_xml_proxy ctx c t file p =
 (* BUILD META DATA OBJECT *)
 
 let build_metadata com t =
-	let api = com.type_api in
+	let api = com.basic in
 	let p, meta, fields, statics = (match t with
 		| TClassDecl c ->
 			let fields = List.map (fun f -> f.cf_name,f.cf_meta()) (c.cl_ordered_fields @ (match c.cl_constructor with None -> [] | Some f -> [{ f with cf_name = "_" }])) in
@@ -357,11 +357,11 @@ let on_generate ctx t =
 			| ":native",[{ eexpr = TConst (TString name) } as e] ->				
 				meta := (":real",[{ e with eexpr = TConst (TString (s_type_path c.cl_path)) }]) :: !meta;
 				c.cl_meta <- (fun() -> !meta);
-				c.cl_path <- s_parse_path name;
+				c.cl_path <- parse_path name;
 			| _ -> ()
 		) (!meta);
 		if has_rtti c && not (PMap.mem "__rtti" c.cl_statics) then begin
-			let f = mk_field "__rtti" ctx.api.tstring in
+			let f = mk_field "__rtti" ctx.t.tstring in
 			let str = Genxml.gen_type_string ctx.com t in
 			f.cf_expr <- Some (mk (TConst (TString str)) f.cf_type c.cl_pos);
 			c.cl_ordered_statics <- f :: c.cl_ordered_statics;
@@ -464,7 +464,7 @@ let rec local_usage f e =
 	This way, each value is captured independantly.
 *)
 
-let block_vars ctx e =
+let block_vars com e =
 
 	let uid = ref 0 in
 	let gen_unique() =
@@ -472,7 +472,7 @@ let block_vars ctx e =
 		"$t" ^ string_of_int !uid;
 	in
 
-	let t = ctx.type_api in
+	let t = com.basic in
 
 	let rec mk_init v vt vtmp pos =
 		let at = t.tarray vt in
@@ -556,7 +556,7 @@ let block_vars ctx e =
 					v, o, vt
 			) f.tf_args in
 			let e = { e with eexpr = TFunction { f with tf_args = fargs; tf_expr = !fexpr } } in
-			(match ctx.platform with
+			(match com.platform with
 			| Cpp -> e
 			| _ ->
 				let args = List.map (fun (v,t) -> v, None, t) vars in
@@ -634,7 +634,7 @@ let block_vars ctx e =
 	local_usage collect_vars e;
 	if PMap.is_empty !used then e else wrap !used e
 	in
-	match ctx.platform with
+	match com.platform with
 	| Neko | Php | Cross -> e
 	| Cpp -> all_vars e
 	| _ -> out_loop e
@@ -806,7 +806,7 @@ type stack_context = {
 }
 
 let stack_context_init com stack_var exc_var pos_var tmp_var use_add p =
-	let t = com.type_api in
+	let t = com.basic in
 	let st = t.tarray t.tstring in
 	let stack_e = mk (TLocal stack_var) st p in
 	let exc_e = mk (TLocal exc_var) st p in
@@ -1015,7 +1015,7 @@ let rec is_volatile t =
 
 let set_default ctx a c t p =
 	let ve = mk (TLocal a) t p in
-	mk (TIf (mk (TBinop (OpEq,ve,mk (TConst TNull) t p)) ctx.type_api.tbool p, mk (TBinop (OpAssign,ve,mk (TConst c) t p)) t p,None)) ctx.type_api.tvoid p
+	mk (TIf (mk (TBinop (OpEq,ve,mk (TConst TNull) t p)) ctx.basic.tbool p, mk (TBinop (OpAssign,ve,mk (TConst c) t p)) t p,None)) ctx.basic.tvoid p
 
 let bytes_serialize data =
 	let b64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789%:" in
@@ -1103,7 +1103,7 @@ let dump_types com =
 	{ var $t = <e>; if( Std.is($t,<t>) ) $t else throw "Class cast error"; }
 *)
 let default_cast ?(vtmp="$t") com e texpr t p =
-	let api = com.type_api in
+	let api = com.basic in
 	let mk_texpr = function
 		| TClassDecl c -> TAnon { a_fields = PMap.empty; a_status = ref (Statics c) }
 		| TEnumDecl e -> TAnon { a_fields = PMap.empty; a_status = ref (EnumStatics e) }
@@ -1112,8 +1112,7 @@ let default_cast ?(vtmp="$t") com e texpr t p =
 	let var = mk (TVars [(vtmp,e.etype,Some e)]) api.tvoid p in
 	let vexpr = mk (TLocal vtmp) e.etype p in
 	let texpr = mk (TTypeExpr texpr) (mk_texpr texpr) p in
-	let std = (match (api.load_module ([],"Std") p).mtypes with [std] -> std | _ -> assert false) in
-	(*Typeload.load_type_def ctx p { tpackage = []; tname = "Std"; tparams = []; tsub = None } in *)
+	let std = (try List.find (fun t -> t_path t = ([],"Std")) com.types with Not_found -> assert false) in
 	let std = mk (TTypeExpr std) (mk_texpr std) p in
 	let is = mk (TField (std,"is")) (tfun [t_dynamic;t_dynamic] api.tbool) p in
 	let is = mk (TCall (is,[vexpr;texpr])) api.tbool p in

+ 9 - 19
common.ml

@@ -34,8 +34,7 @@ type platform =
 
 type pos = Ast.pos
 
-type context_type_api = {
-	(* basic types *)
+type basic_types = {
 	mutable tvoid : t;
 	mutable tint : t;
 	mutable tfloat : t;
@@ -43,13 +42,6 @@ type context_type_api = {
 	mutable tnull : t -> t;
 	mutable tstring : t;
 	mutable tarray : t -> t;
-	(* api *)
-	mutable load_module : path -> pos -> module_def;
-	mutable build_instance : module_type -> pos -> ((string * t) list * path * (t list -> t));
-	mutable on_generate : module_type -> unit;
-	mutable get_type_module : module_type -> module_def;
-	mutable optimize : texpr -> texpr;
-	mutable load_extern_type : (path -> pos -> Ast.package) list;
 }
 
 type context = {
@@ -67,15 +59,17 @@ type context = {
 	mutable error : string -> pos -> unit;
 	mutable warning : string -> pos -> unit;
 	mutable js_namespace : string option;
+	mutable load_extern_type : (path -> pos -> Ast.package option) list; (* allow finding types which are not in sources *)
 	(* output *)
 	mutable file : string;
 	mutable flash_version : int;
+	mutable modules : Type.module_def list;
 	mutable types : Type.module_type list;
 	mutable resources : (string,string) Hashtbl.t;
 	mutable php_front : string option;
 	mutable swf_libs : (string * (unit -> Swf.swf) * (unit -> ((string list * string),As3hl.hl_class) Hashtbl.t)) list;
 	(* typing *)
-	mutable type_api : context_type_api;
+	mutable basic : basic_types;
 	mutable lines : Lexer.line_index;
 }
 
@@ -98,14 +92,16 @@ let create v =
 		package_rules = PMap.empty;
 		file = "";
 		types = [];
+		modules = [];
 		flash_version = 8;
 		resources = Hashtbl.create 0;
 		php_front = None;
 		swf_libs = [];
 		js_namespace = None;
+		load_extern_type = [];
 		warning = (fun _ _ -> assert false);
 		error = (fun _ _ -> assert false);
-		type_api = {
+		basic = {
 			tvoid = m;
 			tint = m;
 			tfloat = m;
@@ -113,19 +109,13 @@ let create v =
 			tnull = (fun _ -> assert false);
 			tstring = m;
 			tarray = (fun _ -> assert false);
-			load_module = (fun _ _ -> assert false);
-			build_instance = (fun _ _ -> assert false);
-			on_generate = (fun _ -> ());
-			get_type_module = (fun _ -> assert false);
-			optimize = (fun _ -> assert false);
-			load_extern_type = [];
 		};
 		lines = Lexer.build_line_index();
 	}
 
 let clone com =
-	let t = com.type_api in
-	{ com with type_api = { t with tvoid = t.tvoid } }
+	let t = com.basic in
+	{ com with basic = { t with tvoid = t.tvoid } }
 
 let platforms = [
 	Flash;

+ 1 - 1
genas3.ml

@@ -451,7 +451,7 @@ and gen_expr ctx e =
 	| TEnumField (en,s) ->
 		print ctx "%s.%s" (s_path ctx true en.e_path e.epos) (s_ident s)
 	| TArray ({ eexpr = TLocal "__global__" },{ eexpr = TConst (TString s) }) ->
-		let path = Ast.s_parse_path s in
+		let path = Ast.parse_path s in
 		spr ctx (s_path ctx false path e.epos)
 	| TArray (e1,e2) ->
 		gen_value ctx e1;

+ 1 - 1
genswf.ml

@@ -750,7 +750,7 @@ let merge com file priority (h1,tags1) (h2,tags2) =
 		| TSetBgColor _ -> priority
 		| TExport el when !nframe = 0 && com.flash_version >= 9 ->
 			let el = List.filter (fun e ->
-				let path = s_parse_path e.exp_name in
+				let path = parse_path e.exp_name in
 				List.exists (fun t -> t_path t = path) com.types
 			) el in
 			classes := !classes @ List.map (fun e -> { f9_cid = Some e.exp_id; f9_classname = e.exp_name }) el;

+ 8 - 8
genswf9.ml

@@ -686,7 +686,7 @@ let begin_fun ctx args tret el stat p =
 	)
 
 let empty_method ctx p =
-	let f = begin_fun ctx [] ctx.com.type_api.tvoid [] true p in
+	let f = begin_fun ctx [] ctx.com.basic.tvoid [] true p in
 	write ctx HRetVoid;
 	f()
 
@@ -777,7 +777,7 @@ let gen_access ctx e (forset : 'a) : 'a access =
 				VCast (id,classify ctx e.etype)
 		)
 	| TArray ({ eexpr = TLocal "__global__" },{ eexpr = TConst (TString s) }) ->
-		let path = s_parse_path s in
+		let path = parse_path s in
 		let id = type_path ctx path in
 		if is_set forset then write ctx HGetGlobalScope;
 		VGlobal id
@@ -1782,10 +1782,10 @@ let generate_class ctx c =
 			else
 				generate_construct ctx {
 					tf_args = [];
-					tf_type = ctx.com.type_api.tvoid;
+					tf_type = ctx.com.basic.tvoid;
 					tf_expr = {
 						eexpr = TBlock [];
-						etype = ctx.com.type_api.tvoid;
+						etype = ctx.com.basic.tvoid;
 						epos = null_pos;
 					}
 				} c
@@ -1872,7 +1872,7 @@ let generate_class ctx c =
 
 let generate_enum ctx e meta =
 	let name_id = type_path ctx e.e_path in
-	let api = ctx.com.type_api in
+	let api = ctx.com.basic in
 	let f = begin_fun ctx [("tag",None,api.tstring);("index",None,api.tint);("params",None,mk_mono())] api.tvoid [ethis] false e.e_pos in
 	let tag_id = ident "tag" in
 	let index_id = ident "index" in
@@ -1981,7 +1981,7 @@ let generate_inits ctx =
 	(* define flash.Boot.init method *)
 	write ctx HGetGlobalScope;
 	write ctx (HGetProp (type_path ctx (["flash"],"Boot")));
-	let finit = begin_fun ctx [] ctx.com.type_api.tvoid [] true null_pos in
+	let finit = begin_fun ctx [] ctx.com.basic.tvoid [] true null_pos in
 	List.iter (fun t ->
 		match t with
 		| TClassDecl c ->
@@ -2007,7 +2007,7 @@ let generate_type ctx t =
 			None
 		else
 			let hlc = generate_class ctx c in
-			let init = begin_fun ctx [] ctx.com.type_api.tvoid [ethis] false c.cl_pos in
+			let init = begin_fun ctx [] ctx.com.basic.tvoid [ethis] false c.cl_pos in
 			generate_class_init ctx c hlc;
 			if c.cl_path = (["flash"],"Boot") then generate_inits ctx;
 			write ctx HRetVoid;
@@ -2023,7 +2023,7 @@ let generate_type ctx t =
 		else
 			let meta = Codegen.build_metadata ctx.com t in
 			let hlc = generate_enum ctx e meta in
-			let init = begin_fun ctx [] ctx.com.type_api.tvoid [ethis] false e.e_pos in
+			let init = begin_fun ctx [] ctx.com.basic.tvoid [ethis] false e.e_pos in
 			generate_enum_init ctx e hlc meta;
 			write ctx HRetVoid;
 			Some (init(), {

+ 2 - 2
genxml.ml

@@ -52,7 +52,7 @@ let gen_arg_name (name,opt,_) =
 let cpath c =
 	let rec loop = function
 		| [] -> c.cl_path
-		| (":real",[{ eexpr = TConst (TString s) }]) :: _ -> s_parse_path s
+		| (":real",[{ eexpr = TConst (TString s) }]) :: _ -> parse_path s
 		| _ :: l -> loop l
 	in
 	loop (c.cl_meta())
@@ -125,7 +125,7 @@ let rec exists f c =
 			| Some (csup,_) -> exists f csup
 
 let gen_type_decl com t =
-	let m = com.type_api.get_type_module t in
+	let m = (try List.find (fun m -> List.memq t m.mtypes) com.modules with Not_found -> { mpath = t_path t; mtypes = [t] }) in
 	match t with
 	| TClassDecl c ->
 		let stats = List.map (gen_field ["static","1"]) c.cl_ordered_statics in

+ 11 - 6
main.ml

@@ -339,8 +339,12 @@ try
 		("-swf-lib",Arg.String (fun file ->
 			let getSWF = Genswf.parse_swf com file in
 			let extract = Genswf.extract_data getSWF in
-			let build cl p = Genswf.build_class com (Hashtbl.find (extract()) cl) file in
-			com.type_api.load_extern_type <- com.type_api.load_extern_type @ [build];
+			let build cl p = 
+				match (try Some (Hashtbl.find (extract()) cl) with Not_found -> None) with
+				| None -> None
+				| Some c -> Some (Genswf.build_class com c file)
+			in
+			com.load_extern_type <- com.load_extern_type @ [build];
 			com.swf_libs <- (file,getSWF,extract) :: com.swf_libs
 		),"<file> : add the SWF library to the compiled SWF");
 		("-x", Arg.String (fun file ->
@@ -378,7 +382,7 @@ try
 			close_in ch;
 			excludes := (List.map (fun l ->
 				let l = ExtString.String.strip l in
-				if l = "" then ([],"") else Ast.s_parse_path l
+				if l = "" then ([],"") else Ast.parse_path l
 			) lines) @ !excludes;
 		),"<filename> : don't generate code for classes listed in this file");
 		("-prompt", Arg.Unit (fun() -> prompt := true),": prompt on error");
@@ -518,14 +522,15 @@ try
 		if com.verbose then print_endline ("Classpath : " ^ (String.concat ";" com.class_path));
 		let t = Common.timer "typing" in
 		Typecore.type_expr_ref := (fun ctx e need_val -> Typer.type_expr ~need_val ctx e);
-		Typecore.build_inheritance := Codegen.on_inherit;
 		let ctx = Typer.create com in
-		List.iter (fun cpath -> ignore(com.type_api.load_module cpath Ast.null_pos)) (List.rev !classes);
+		List.iter (fun cpath -> ignore(ctx.Typecore.g.Typecore.do_load_module ctx cpath Ast.null_pos)) (List.rev !classes);
 		Typer.finalize ctx;
 		t();
 		if !has_error then do_exit();
 		if !no_output then com.platform <- Cross;
-		com.types <- Typer.types ctx com.main_class (!excludes);
+		let types, modules = Typer.generate ctx com.main_class (!excludes) in
+		com.types <- types;
+		com.modules <- modules;
 		com.lines <- Lexer.build_line_index();
 		let filters = [
 			Codegen.check_local_vars_init;

+ 7 - 7
optimizer.ml

@@ -168,7 +168,7 @@ let type_inline ctx cf f ethis params tret p =
 		| _ -> Type.map_expr inline_params e
 	in
 	let e = (if PMap.is_empty subst then e else inline_params e) in
-	let init = (match vars with [] -> None | l -> Some (mk (TVars (List.rev l)) ctx.api.tvoid p)) in
+	let init = (match vars with [] -> None | l -> Some (mk (TVars (List.rev l)) ctx.t.tvoid p)) in
 	if Common.defined ctx.com "js" && (init <> None || !has_vars) then
 		None
 	else
@@ -200,8 +200,8 @@ let type_inline ctx cf f ethis params tret p =
 (* LOOPS *)
 
 let optimize_for_loop ctx i e1 e2 p =
-	let t_void = ctx.api.tvoid in
-	let t_int = ctx.api.tint in
+	let t_void = ctx.t.tvoid in
+	let t_int = ctx.t.tint in
 	let lblock el = Some (mk (TBlock el) t_void p) in
 	match e1.eexpr, follow e1.etype with
 	| TNew ({ cl_path = ([],"IntIter") },[],[i1;i2]) , _ ->
@@ -239,7 +239,7 @@ let optimize_for_loop ctx i e1 e2 p =
 			lblock [
 				mk (TVars [tmp,i1.etype,Some i1]) t_void p;
 				mk (TWhile (
-					mk (TBinop (OpLt, etmp, i2)) ctx.api.tbool p,
+					mk (TBinop (OpLt, etmp, i2)) ctx.t.tbool p,
 					block,
 					NormalWhile
 				)) t_void p;
@@ -248,7 +248,7 @@ let optimize_for_loop ctx i e1 e2 p =
 			lblock [
 				mk (TVars [tmp,i1.etype,Some i1;max,i2.etype,Some i2]) t_void p;
 				mk (TWhile (
-					mk (TBinop (OpLt, etmp, mk (TLocal max) i2.etype p)) ctx.api.tbool p,
+					mk (TBinop (OpLt, etmp, mk (TLocal max) i2.etype p)) ctx.t.tbool p,
 					block,
 					NormalWhile
 				)) t_void p;
@@ -275,7 +275,7 @@ let optimize_for_loop ctx i e1 e2 p =
 		lblock [
 			mk (TVars (ivar :: avars)) t_void p;
 			mk (TWhile (
-				mk (TBinop (OpLt, iexpr, mk (TField (arr,"length")) t_int p)) ctx.api.tbool p,
+				mk (TBinop (OpLt, iexpr, mk (TField (arr,"length")) t_int p)) ctx.t.tbool p,
 				block,
 				NormalWhile
 			)) t_void p;
@@ -295,7 +295,7 @@ let optimize_for_loop ctx i e1 e2 p =
 		lblock [
 			mk (TVars [cell,tcell,Some (mk (TField (e1,"head")) tcell p)]) t_void p;
 			mk (TWhile (
-				mk (TBinop (OpNotEq, cexpr, mk (TConst TNull) tcell p)) ctx.api.tbool p,
+				mk (TBinop (OpNotEq, cexpr, mk (TConst TNull) tcell p)) ctx.t.tbool p,
 				block,
 				NormalWhile
 			)) t_void p

+ 9 - 2
typecore.ml

@@ -29,12 +29,20 @@ type typer_globals = {
 	mutable macros : ((unit -> unit) * typer) option;
 	mutable std : module_def;
 	mutable hook_generate : (unit -> unit) list;
+	(* api *)
+	do_inherit : typer -> Type.tclass -> Ast.pos -> Ast.class_flag -> bool;
+	do_create : Common.context -> typer;
+	do_macro : typer -> path -> string -> Ast.expr list -> Ast.pos -> Ast.expr option;
+	do_load_module : typer -> path -> pos -> module_def;
+	do_generate : typer -> module_type -> unit;
+	do_optimize : typer -> texpr -> texpr;
+	do_build_instance : typer -> module_type -> pos -> ((string * t) list * path * (t list -> t));
 }
 
 and typer = {
 	(* shared *)
 	com : context;
-	mutable api : context_type_api;
+	mutable t : basic_types;
 	g : typer_globals;
 	(* per-module *)
 	current : module_def;
@@ -73,7 +81,6 @@ type error_msg =
 exception Error of error_msg * pos
 
 let type_expr_ref : (typer -> Ast.expr -> bool -> texpr) ref = ref (fun _ _ _ -> assert false)
-let build_inheritance : (typer -> Type.tclass -> Ast.pos -> Ast.class_flag -> bool) ref = ref (fun _ _ _ _ -> true)
 
 let unify_error_msg ctx = function
 	| Cannot_unify (t1,t2) ->

+ 60 - 28
typeload.ml

@@ -21,8 +21,6 @@ open Type
 open Common
 open Typecore
 
-let do_create = ref (fun com -> assert false)
-
 (* make sure we don't access metadata at load time *)
 let has_meta m (ml:Ast.metadata) =
 	List.exists (fun(m2,_) -> m = m2) ml
@@ -32,20 +30,20 @@ let type_constant ctx c p =
 	| Int s ->
 		if String.length s > 10 && String.sub s 0 2 = "0x" then error "Invalid hexadecimal integer" p;
 		(try
-			mk (TConst (TInt (Int32.of_string s))) ctx.api.tint p
+			mk (TConst (TInt (Int32.of_string s))) ctx.t.tint p
 		with
-			_ -> mk (TConst (TFloat s)) ctx.api.tfloat p)
-	| Float f -> mk (TConst (TFloat f)) ctx.api.tfloat p
-	| String s -> mk (TConst (TString s)) ctx.api.tstring p
-	| Ident "true" -> mk (TConst (TBool true)) ctx.api.tbool p
-	| Ident "false" -> mk (TConst (TBool false)) ctx.api.tbool p
-	| Ident "null" -> mk (TConst TNull) (ctx.api.tnull (mk_mono())) p
+			_ -> mk (TConst (TFloat s)) ctx.t.tfloat p)
+	| Float f -> mk (TConst (TFloat f)) ctx.t.tfloat p
+	| String s -> mk (TConst (TString s)) ctx.t.tstring p
+	| Ident "true" -> mk (TConst (TBool true)) ctx.t.tbool p
+	| Ident "false" -> mk (TConst (TBool false)) ctx.t.tbool p
+	| Ident "null" -> mk (TConst TNull) (ctx.t.tnull (mk_mono())) p
 	| _ -> assert false
 
 let type_function_param ctx t e opt p =
 	match e with
 	| None ->
-		if opt then ctx.api.tnull t, Some (EConst (Ident "null"),p) else t, None
+		if opt then ctx.t.tnull t, Some (EConst (Ident "null"),p) else t, None
 	| Some e ->
 		t, Some e
 
@@ -58,6 +56,13 @@ let type_static_var ctx t e p =
 	| TType ({ t_path = ([],"UInt") },[]) -> { e with etype = t }
 	| _ -> e
 
+let apply_macro ctx path el p =	
+	let cpath, meth = (match List.rev (ExtString.String.nsplit path ".") with
+		| meth :: name :: pack -> (List.rev pack,name), meth
+		| _ -> error "Invalid macro path" p
+	) in
+	ctx.g.do_macro ctx cpath meth el p
+
 (** since load_type_def and load_instance are used in PASS2, they should not access the structure of a type **)
 
 (*
@@ -74,7 +79,7 @@ let rec load_type_def ctx p t =
 	with
 		Not_found ->
 			let next() =
-				let m = ctx.api.load_module (t.tpackage,t.tname) p in
+				let m = ctx.g.do_load_module ctx (t.tpackage,t.tname) p in
 				let tpath = (t.tpackage,tname) in
 				try
 					List.find (fun t -> not (t_private t) && t_path t = tpath) m.mtypes
@@ -108,7 +113,7 @@ let rec load_instance ctx t p allow_no_params =
 		if t.tparams <> [] then error ("Class type parameter " ^ t.tname ^ " can't have parameters") p;
 		pt
 	with Not_found ->
-		let types , path , f = ctx.api.build_instance (load_type_def ctx p t) p in
+		let types , path , f = ctx.g.do_build_instance ctx (load_type_def ctx p t) p in
 		if allow_no_params && t.tparams = [] then
 			f (List.map (fun (name,t) ->
 				match follow t with
@@ -269,7 +274,7 @@ let t_iterator ctx =
 *)
 let load_type_opt ?(opt=false) ctx p t =
 	let t = (match t with None -> mk_mono() | Some t -> load_complex_type ctx p t) in
-	if opt then ctx.api.tnull t else t
+	if opt then ctx.t.tnull t else t
 
 (* ---------------------------------------------------------------------- *)
 (* Structure check *)
@@ -461,7 +466,7 @@ let set_heritance ctx c herits p =
 		| HImplements t -> HImplements (resolve_imports t)
 		| h -> h
 	) herits in
-	List.iter loop (List.filter ((!build_inheritance) ctx c p) herits)
+	List.iter loop (List.filter (ctx.g.do_inherit ctx c p) herits)
 
 let type_type_params ctx path p (n,flags) =
 	let c = mk_class (fst path @ [snd path],n) p in
@@ -485,7 +490,7 @@ let type_function ctx args ret static constr f p =
 			| None -> None
 			| Some e ->
 				let p = pos e in
-				let e = ctx.api.optimize (type_expr ctx e true) in
+				let e = ctx.g.do_optimize ctx (type_expr ctx e true) in
 				unify ctx e.etype t p;
 				match e.eexpr with
 				| TConst c -> Some c
@@ -513,7 +518,7 @@ let type_function ctx args ret static constr f p =
 	if have_ret then
 		(try return_flow ctx e with Exit -> ())
 	else
-		unify ctx ret ctx.api.tvoid p;
+		unify ctx ret ctx.t.tvoid p;
 	let rec loop e =
 		match e.eexpr with
 		| TCall ({ eexpr = TConst TSuper },_) -> raise Exit
@@ -573,7 +578,7 @@ let init_core_api ctx c =
 		| None ->
 			let com2 = Common.clone ctx.com in
 			com2.class_path <- ctx.com.std_path;
-			let ctx2 = (!do_create) com2 in
+			let ctx2 = ctx.g.do_create com2 in
 			ctx.g.core_api <- Some ctx2;
 			ctx2
 		| Some c ->
@@ -608,7 +613,7 @@ let init_core_api ctx c =
 				(match follow f.cf_type, follow f2.cf_type with
 				| TFun (pl1,_), TFun (pl2,_) ->
 					if List.length pl1 != List.length pl2 then assert false;
-					List.iter2 (fun (n1,_,_) (n2,_,_) -> 
+					List.iter2 (fun (n1,_,_) (n2,_,_) ->
 						if n1 <> n2 then error ("Method parameter name '" ^ n2 ^ "' should be '" ^ n1 ^ "'") p;
 					) pl1 pl2;
 				| _ -> ());
@@ -732,13 +737,21 @@ let init_class ctx c p herits fields meta =
 			if inline && c.cl_interface then error "You can't declare inline methods in interfaces" p;
 			let is_macro = (is_macro && stat) || has_meta ":macro" meta in
 			if is_macro && not stat then error "Only static methods can be macros" p;
-			let f = if not is_macro then f else begin
+			let f = if not is_macro then
+				f
+			else if in_macro then
 				let texpr = CTPath { tpackage = ["haxe";"macro"]; tname = "Expr"; tparams = []; tsub = None } in
-				{ f with 
+				{
+					f_type = (match f.f_type with None -> Some texpr | t -> t); 
 					f_args = List.map (fun (a,o,t,e) -> a,o,(match t with None -> Some texpr | _ -> t),e) f.f_args;
-					f_expr = if in_macro then f.f_expr else (EReturn (Some (EConst (Ident "null"),p)),p);
+					f_expr = f.f_expr;
 				}
-			end in
+			else {
+				f_type = None;
+				f_args = [];
+				f_expr = (EBlock [],p)
+			}
+			in
 			let parent = (if not stat then get_parent c name else None) in
 			let dynamic = List.mem ADynamic access || (match parent with Some { cf_kind = Method MethDynamic } -> true | _ -> false) in
 			if inline && dynamic then error "You can't have both 'inline' and 'dynamic'" p;
@@ -1011,7 +1024,7 @@ let type_module ctx m tdecls loadp =
 	let ctx = {
 		com = ctx.com;
 		g = ctx.g;
-		api = ctx.api;
+		t = ctx.t;
 		curclass = ctx.curclass;
 		tthis = ctx.tthis;
 		ret = ctx.ret;
@@ -1065,7 +1078,7 @@ let type_module ctx m tdecls loadp =
 		| EImport t ->
 			(match t.tsub with
 			| None ->
-				let md = ctx.api.load_module (t.tpackage,t.tname) p in
+				let md = ctx.g.do_load_module ctx (t.tpackage,t.tname) p in
 				let types = List.filter (fun t -> not (t_private t)) md.mtypes in
 				ctx.local_types <- ctx.local_types @ types
 			| Some _ ->
@@ -1075,7 +1088,7 @@ let type_module ctx m tdecls loadp =
 		| EUsing t ->
 			(match t.tsub with
 			| None ->
-				let md = ctx.api.load_module (t.tpackage,t.tname) p in
+				let md = ctx.g.do_load_module ctx (t.tpackage,t.tname) p in
 				let types = List.filter (fun t -> not (t_private t)) md.mtypes in
 				ctx.local_using <- ctx.local_using @ (List.map (resolve_typedef ctx) types);
 			| Some _ ->
@@ -1090,6 +1103,22 @@ let type_module ctx m tdecls loadp =
 			let et = TEnum (e,List.map snd e.e_types) in
 			let names = ref [] in
 			let index = ref 0 in
+			let rec loop = function
+				| (":build",[EConst (String s),p]) :: _ ->
+					(match apply_macro ctx s [] p with
+					| None -> error "Enum build failure" p
+					| Some (EArrayDecl el,_) ->
+						List.map (fun (e,p) ->
+							match e with
+							| EConst (Ident i) | EConst (Type i) -> i, None, [], [], p							
+							| _ -> error "Invalid constructor" p
+						) el
+					| _ -> error "Build macro must return an array" p
+					)
+				| _ :: l -> loop l
+				| [] -> []
+			in
+			let extra = loop d.d_meta in
 			List.iter (fun (c,doc,meta,t,p) ->
 				if c = "name" && Common.defined ctx.com "js" then error "This identifier cannot be used in Javascript" p;
 				let t = (match t with
@@ -1113,7 +1142,7 @@ let type_module ctx m tdecls loadp =
 				} e.e_constrs;
 				incr index;
 				names := c :: !names;
-			) d.d_data;
+			) (d.d_data @ extra);
 			e.e_names <- List.rev !names;
 		| ETypedef d ->
 			let t = get_tdef d.d_name in
@@ -1200,8 +1229,11 @@ let load_module ctx m p =
 			with Not_found ->
 				let rec loop = function
 					| [] -> raise (Error (Module_not_found m,p))
-					| load :: l -> try snd (load m p) with Not_found -> loop l
+					| load :: l -> 
+						match load m p with
+						| None -> loop l
+						| Some (_,a) -> a
 				in
-				loop ctx.api.load_extern_type
+				loop ctx.com.load_extern_type
 			) in
 			type_module ctx m decls p

+ 188 - 199
typer.ml

@@ -98,7 +98,6 @@ 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 *)
@@ -372,8 +371,8 @@ let field_access ctx mode f t e p =
 			else
 				AKExpr (make_call ctx (mk (TField (e,m)) (tfun [] t) p) [] t p)
 		| AccResolve ->
-			let fstring = mk (TConst (TString f.cf_name)) ctx.api.tstring p in
-			let tresolve = tfun [ctx.api.tstring] t in
+			let fstring = mk (TConst (TString f.cf_name)) ctx.t.tstring p in
+			let tresolve = tfun [ctx.t.tstring] t in
 			AKExpr (make_call ctx (mk (TField (e,"resolve")) tresolve p) [fstring] t p)
 		| AccNever ->
 			AKNo f.cf_name
@@ -407,12 +406,12 @@ let type_ident ctx i is_type p mode =
 	match i with
 	| "true" ->
 		if mode = MGet then
-			AKExpr (mk (TConst (TBool true)) ctx.api.tbool p)
+			AKExpr (mk (TConst (TBool true)) ctx.t.tbool p)
 		else
 			AKNo i
 	| "false" ->
 		if mode = MGet then
-			AKExpr (mk (TConst (TBool false)) ctx.api.tbool p)
+			AKExpr (mk (TConst (TBool false)) ctx.t.tbool p)
 		else
 			AKNo i
 	| "this" ->
@@ -544,7 +543,7 @@ let rec type_field ctx e i p mode =
 			| Some t ->
 				let t = apply_params c.cl_types params t in
 				if mode = MGet && PMap.mem "resolve" c.cl_fields then
-					AKExpr (make_call ctx (mk (TField (e,"resolve")) (tfun [ctx.api.tstring] t) p) [Typeload.type_constant ctx (String i) p] t p)
+					AKExpr (make_call ctx (mk (TField (e,"resolve")) (tfun [ctx.t.tstring] t) p) [Typeload.type_constant ctx (String i) p] t p)
 				else
 					AKExpr (mk (TField (e,i)) t p)
 			| None ->
@@ -653,10 +652,10 @@ let unify_int ctx e k =
 	in
 	match k with
 	| KUnk | KDyn when maybe_dynamic_mono() ->
-		unify ctx e.etype ctx.api.tfloat e.epos;
+		unify ctx e.etype ctx.t.tfloat e.epos;
 		false
 	| _ ->
-		unify ctx e.etype ctx.api.tint e.epos;
+		unify ctx e.etype ctx.t.tint e.epos;
 		true
 
 let rec type_binop ctx op e1 e2 p =
@@ -700,7 +699,7 @@ let rec type_binop ctx op e1 e2 p =
 			unify ctx get.etype t p;
 			l();
 			mk (TBlock [
-				mk (TVars [v,e.etype,Some e]) ctx.api.tvoid p;
+				mk (TVars [v,e.etype,Some e]) ctx.t.tvoid p;
 				make_call ctx (mk (TField (ev,m)) (tfun [t] t) p) [get] t p
 			]) t p
 		| AKInline _ | AKUsing _ | AKMacro _ ->
@@ -708,24 +707,26 @@ let rec type_binop ctx op e1 e2 p =
 	| _ ->
 	let e1 = type_expr ctx e1 in
 	let e2 = type_expr ctx e2 in
+	let tint = ctx.t.tint in
+	let tfloat = ctx.t.tfloat in
 	let mk_op t = mk (TBinop (op,e1,e2)) t p in
 	match op with
 	| OpAdd ->
 		mk_op (match classify e1.etype, classify e2.etype with
 		| KInt , KInt ->
-			ctx.api.tint
+			tint
 		| KFloat , KInt
 		| KInt, KFloat
 		| KFloat, KFloat ->
-			ctx.api.tfloat
+			tfloat
 		| KUnk , KInt ->
-			if unify_int ctx e1 KUnk then ctx.api.tint else ctx.api.tfloat
+			if unify_int ctx e1 KUnk then tint else tfloat
 		| KUnk , KFloat
 		| KUnk , KString  ->
 			unify ctx e1.etype e2.etype e1.epos;
 			e1.etype
 		| KInt , KUnk ->
-			if unify_int ctx e2 KUnk then ctx.api.tint else ctx.api.tfloat
+			if unify_int ctx e2 KUnk then tint else tfloat
 		| KFloat , KUnk
 		| KString , KUnk ->
 			unify ctx e2.etype e1.etype e2.epos;
@@ -739,13 +740,13 @@ let rec type_binop ctx op e1 e2 p =
 		| KUnk , KUnk ->
 			let ok1 = unify_int ctx e1 KUnk in
 			let ok2 = unify_int ctx e2 KUnk in
-			if ok1 && ok2 then ctx.api.tint else ctx.api.tfloat
+			if ok1 && ok2 then tint else tfloat
 		| KParam t1, KParam t2 when t1 == t2 ->
 			t1
 		| KParam t, KInt | KInt, KParam t ->
 			t
 		| KParam _, KFloat | KFloat, KParam _ | KParam _, KParam _ ->
-			ctx.api.tfloat
+			tfloat
 		| KParam _, _
 		| _, KParam _
 		| KOther, _
@@ -759,7 +760,7 @@ let rec type_binop ctx op e1 e2 p =
 	| OpShl
 	| OpShr
 	| OpUShr ->
-		let i = ctx.api.tint in
+		let i = tint in
 		unify ctx e1.etype i e1.epos;
 		unify ctx e2.etype i e2.epos;
 		mk_op i
@@ -767,28 +768,28 @@ let rec type_binop ctx op e1 e2 p =
 	| OpMult
 	| OpDiv
 	| OpSub ->
-		let result = ref (if op = OpDiv then ctx.api.tfloat else ctx.api.tint) in
+		let result = ref (if op = OpDiv then tfloat else tint) in
 		(match classify e1.etype, classify e2.etype with
 		| KFloat, KFloat ->
-			result := ctx.api.tfloat
+			result := tfloat
 		| KParam t1, KParam t2 when t1 == t2 ->
 			if op <> OpDiv then result := t1
 		| KParam _, KParam _ ->
-			result := ctx.api.tfloat
+			result := tfloat
 		| KParam t, KInt | KInt, KParam t ->
 			if op <> OpDiv then result := t
 		| KParam _, KFloat | KFloat, KParam _ ->
-			result := ctx.api.tfloat
+			result := tfloat
 		| KFloat, k ->
 			ignore(unify_int ctx e2 k);
-			result := ctx.api.tfloat
+			result := tfloat
 		| k, KFloat ->
 			ignore(unify_int ctx e1 k);
-			result := ctx.api.tfloat
+			result := tfloat
 		| k1 , k2 ->
 			let ok1 = unify_int ctx e1 k1 in
 			let ok2 = unify_int ctx e2 k2 in
-			if not ok1 || not ok2  then result := ctx.api.tfloat;
+			if not ok1 || not ok2  then result := tfloat;
 		);
 		mk_op !result
 	| OpEq
@@ -797,7 +798,7 @@ let rec type_binop ctx op e1 e2 p =
 			unify_raise ctx e1.etype e2.etype p
 		with
 			Error (Unify _,_) -> unify ctx e2.etype e1.etype p);
-		mk_op ctx.api.tbool
+		mk_op ctx.t.tbool
 	| OpGt
 	| OpGte
 	| OpLt
@@ -828,18 +829,17 @@ let rec type_binop ctx op e1 e2 p =
 			let pr = print_context() in
 			error ("Cannot compare " ^ s_type pr e1.etype ^ " and " ^ s_type pr e2.etype) p
 		);
-		mk_op ctx.api.tbool
+		mk_op ctx.t.tbool
 	| OpBoolAnd
 	| OpBoolOr ->
-		let b = ctx.api.tbool in
+		let b = ctx.t.tbool in
 		unify ctx e1.etype b p;
 		unify ctx e2.etype b p;
 		mk_op b
 	| OpInterval ->
-		let i = ctx.api.tint in
 		let t = Typeload.load_core_type ctx "IntIter" in
-		unify ctx e1.etype i e1.epos;
-		unify ctx e2.etype i e2.epos;
+		unify ctx e1.etype tint e1.epos;
+		unify ctx e2.etype tint e2.epos;
 		mk (TNew ((match t with TInst (c,[]) -> c | _ -> assert false),[],[e1;e2])) t p
 	| OpAssign
 	| OpAssignOp _ ->
@@ -851,20 +851,20 @@ and type_unop ctx op flag e p =
 	let access e =
 		let t = (match op with
 		| Not ->
-			unify ctx e.etype ctx.api.tbool e.epos;
-			ctx.api.tbool
+			unify ctx e.etype ctx.t.tbool e.epos;
+			ctx.t.tbool
 		| Increment
 		| Decrement
 		| Neg
 		| NegBits ->
 			if set then check_assign ctx e;
 			(match classify e.etype with
-			| KFloat -> ctx.api.tfloat
+			| KFloat -> ctx.t.tfloat
 			| KParam t ->
-				unify ctx e.etype ctx.api.tfloat e.epos;
+				unify ctx e.etype ctx.t.tfloat e.epos;
 				t
 			| k ->
-				if unify_int ctx e k then ctx.api.tint else ctx.api.tfloat)
+				if unify_int ctx e k then ctx.t.tint else ctx.t.tfloat)
 		) in
 		match op, e.eexpr with
 		| Neg , TConst (TInt i) -> mk (TConst (TInt (Int32.neg i))) t p
@@ -891,7 +891,7 @@ and type_unop ctx op flag e p =
 			unify ctx get.etype t p;
 			l();
 			mk (TBlock [
-				mk (TVars [v,e.etype,Some e]) ctx.api.tvoid p;
+				mk (TVars [v,e.etype,Some e]) ctx.t.tvoid p;
 				make_call ctx (mk (TField (ev,m)) (tfun [t] t) p) [get] t p
 			]) t p
 		| Postfix ->
@@ -902,14 +902,14 @@ and type_unop ctx op flag e p =
 			unify ctx get.etype t p;
 			l();
 			mk (TBlock [
-				mk (TVars [v,e.etype,Some e; v2,t,Some get]) ctx.api.tvoid p;
+				mk (TVars [v,e.etype,Some e; v2,t,Some get]) ctx.t.tvoid p;
 				make_call ctx (mk (TField (ev,m)) (tfun [plusone.etype] t) p) [plusone] t p;
 				ev2
 			]) t p
 
 and type_switch ctx e cases def need_val p =
 	let e = type_expr ctx e in
-	let t = ref (if need_val then mk_mono() else ctx.api.tvoid) in
+	let t = ref (if need_val then mk_mono() else ctx.t.tvoid) in
 	let rec lookup_enum l =
 		match l with
 		| [] -> None
@@ -944,13 +944,13 @@ and type_switch ctx e cases def need_val p =
 		if need_val then begin
 			try
 				(match e.eexpr with
-				| TBlock [{ eexpr = TConst TNull }] -> t := ctx.api.tnull !t;
+				| TBlock [{ eexpr = TConst TNull }] -> t := ctx.t.tnull !t;
 				| _ -> ());
 				unify_raise ctx e.etype (!t) e.epos;
-				if is_null e.etype then t := ctx.api.tnull !t;
+				if is_null e.etype then t := ctx.t.tnull !t;
 			with Error (Unify _,_) -> try
 				unify_raise ctx (!t) e.etype e.epos;
-				t := if is_null !t then ctx.api.tnull e.etype else e.etype;
+				t := if is_null !t then ctx.t.tnull e.etype else e.etype;
 			with Error (Unify _,_) ->
 				(* will display the error *)
 				unify ctx e.etype (!t) e.epos;
@@ -985,7 +985,7 @@ and type_switch ctx e cases def need_val p =
 		) el in
 		if el = [] then error "Case must match at least one expression" (pos e2);
 		let e2 = (match fst e2 with
-			| EBlock [] -> mk (TConst TNull) ctx.api.tvoid (pos e2)
+			| EBlock [] -> mk (TConst TNull) ctx.t.tvoid (pos e2)
 			| _ -> type_expr ctx ~need_val e2
 		) in
 		locals();
@@ -1134,7 +1134,7 @@ and type_access ctx e p mode =
 	| EArray (e1,e2) ->
 		let e1 = type_expr ctx e1 in
 		let e2 = type_expr ctx e2 in
-		unify ctx e2.etype ctx.api.tint e2.epos;
+		unify ctx e2.etype ctx.t.tint e2.epos;
 		let rec loop et =
 			match follow et with
 			| TInst ({ cl_array_access = Some t; cl_types = pl },tl) ->
@@ -1145,7 +1145,7 @@ and type_access ctx e p mode =
 				t
 			| _ ->
 				let pt = mk_mono() in
-				let t = ctx.api.tarray pt in
+				let t = ctx.t.tarray pt in
 				unify ctx e1.etype t e1.epos;
 				pt
 		in
@@ -1158,7 +1158,7 @@ and type_expr ctx ?(need_val=true) (e,p) =
 	match e with
 	| EField ((EConst (String s),p),"code") ->
 		if UTF8.length s <> 1 then error "String must be a single UTF8 char" p;
-		mk (TConst (TInt (Int32.of_int (UChar.code (UTF8.get s 0))))) ctx.api.tint p
+		mk (TConst (TInt (Int32.of_int (UChar.code (UTF8.get s 0))))) ctx.t.tint p
 	| EField _
 	| EType _
 	| EArray _
@@ -1166,8 +1166,8 @@ and type_expr ctx ?(need_val=true) (e,p) =
 	| EConst (Type _) ->
 		acc_get ctx (type_access ctx e p MGet) p
 	| EConst (Regexp (r,opt)) ->
-		let str = mk (TConst (TString r)) ctx.api.tstring p in
-		let opt = mk (TConst (TString opt)) ctx.api.tstring p in
+		let str = mk (TConst (TString r)) ctx.t.tstring p in
+		let opt = mk (TConst (TString opt)) ctx.t.tstring p in
 		let t = Typeload.load_core_type ctx "EReg" in
 		mk (TNew ((match t with TInst (c,[]) -> c | _ -> assert false),[],[str;opt])) t p
 	| EConst c ->
@@ -1195,7 +1195,7 @@ and type_expr ctx ?(need_val=true) (e,p) =
 		let l = loop l in
 		locals();
 		let rec loop = function
-			| [] -> ctx.api.tvoid
+			| [] -> ctx.t.tvoid
 			| [e] -> e.etype
 			| _ :: l -> loop l
 		in
@@ -1222,7 +1222,7 @@ and type_expr ctx ?(need_val=true) (e,p) =
 			(match e.eexpr with
 			| TConst TNull when not !is_null ->
 				is_null := true;
-				t := ctx.api.tnull !t;
+				t := ctx.t.tnull !t;
 			| _ -> ());
 			(try
 				unify_raise ctx e.etype (!t) e.epos;
@@ -1233,7 +1233,7 @@ and type_expr ctx ?(need_val=true) (e,p) =
 				t := t_dynamic);
 			e
 		) el in
-		mk (TArrayDecl el) (ctx.api.tarray !t) p
+		mk (TArrayDecl el) (ctx.t.tarray !t) p
 	| EVars vl ->
 		let vl = List.map (fun (v,t,e) ->
 			try
@@ -1254,7 +1254,7 @@ and type_expr ctx ?(need_val=true) (e,p) =
 					let v = add_local ctx v t in
 					v , t, None
 		) vl in
-		mk (TVars vl) ctx.api.tvoid p
+		mk (TVars vl) ctx.t.tvoid p
 	| EFor (i,e1,e2) ->
 		let e1 = type_expr ctx e1 in
 		let old_loop = ctx.in_loop in
@@ -1286,7 +1286,7 @@ and type_expr ctx ?(need_val=true) (e,p) =
 					)
 				) in
 				let e2 = type_expr ~need_val:false ctx e2 in
-				mk (TFor (i,pt,e1,e2)) ctx.api.tvoid p
+				mk (TFor (i,pt,e1,e2)) ctx.t.tvoid p
 		) in
 		ctx.in_loop <- old_loop;
 		old_locals();
@@ -1295,52 +1295,52 @@ and type_expr ctx ?(need_val=true) (e,p) =
 		type_expr ctx ~need_val (EIf (e1,e2,Some e3),p)
 	| EIf (e,e1,e2) ->
 		let e = type_expr ctx e in
-		unify ctx e.etype ctx.api.tbool e.epos;
+		unify ctx e.etype ctx.t.tbool e.epos;
 		let e1 = type_expr ctx ~need_val e1 in
 		(match e2 with
 		| None ->
 			if need_val then begin
-				let t = ctx.api.tnull e1.etype in
+				let t = ctx.t.tnull e1.etype in
 				mk (TIf (e,e1,Some (null t p))) t p
 			end else
-				mk (TIf (e,e1,None)) ctx.api.tvoid p
+				mk (TIf (e,e1,None)) ctx.t.tvoid p
 		| Some e2 ->
 			let e2 = type_expr ctx ~need_val e2 in
-			let t = if not need_val then ctx.api.tvoid else (try
+			let t = if not need_val then ctx.t.tvoid else (try
 				(match e1.eexpr, e2.eexpr with
-				| _ , TConst TNull -> ctx.api.tnull e1.etype
-				| TConst TNull, _ -> ctx.api.tnull e2.etype
+				| _ , TConst TNull -> ctx.t.tnull e1.etype
+				| TConst TNull, _ -> ctx.t.tnull e2.etype
 				| _  ->
 					unify_raise ctx e1.etype e2.etype p;
-					if is_null e1.etype then ctx.api.tnull e2.etype else e2.etype)
+					if is_null e1.etype then ctx.t.tnull e2.etype else e2.etype)
 			with
 				Error (Unify _,_) ->
 					unify ctx e2.etype e1.etype p;
-					if is_null e2.etype then ctx.api.tnull e1.etype else e1.etype
+					if is_null e2.etype then ctx.t.tnull e1.etype else e1.etype
 			) in
 			mk (TIf (e,e1,Some e2)) t p)
 	| EWhile (cond,e,NormalWhile) ->
 		let old_loop = ctx.in_loop in
 		let cond = type_expr ctx cond in
-		unify ctx cond.etype ctx.api.tbool cond.epos;
+		unify ctx cond.etype ctx.t.tbool cond.epos;
 		ctx.in_loop <- true;
 		let e = type_expr ~need_val:false ctx e in
 		ctx.in_loop <- old_loop;
-		mk (TWhile (cond,e,NormalWhile)) ctx.api.tvoid p
+		mk (TWhile (cond,e,NormalWhile)) ctx.t.tvoid p
 	| EWhile (cond,e,DoWhile) ->
 		let old_loop = ctx.in_loop in
 		ctx.in_loop <- true;
 		let e = type_expr ~need_val:false ctx e in
 		ctx.in_loop <- old_loop;
 		let cond = type_expr ctx cond in
-		unify ctx cond.etype ctx.api.tbool cond.epos;
-		mk (TWhile (cond,e,DoWhile)) ctx.api.tvoid p
+		unify ctx cond.etype ctx.t.tbool cond.epos;
+		mk (TWhile (cond,e,DoWhile)) ctx.t.tvoid p
 	| ESwitch (e,cases,def) ->
 		type_switch ctx e cases def need_val p
 	| EReturn e ->
 		let e , t = (match e with
 			| None ->
-				let v = ctx.api.tvoid in
+				let v = ctx.t.tvoid in
 				unify ctx v ctx.ret p;
 				None , v
 			| Some e ->
@@ -1378,7 +1378,7 @@ and type_expr ctx ?(need_val=true) (e,p) =
 			if PMap.mem name ctx.locals then error ("Local variable " ^ name ^ " is preventing usage of this type here") e.epos;
 			v , t , e
 		) catches in
-		mk (TTry (e1,catches)) (if not need_val then ctx.api.tvoid else e1.etype) p
+		mk (TTry (e1,catches)) (if not need_val then ctx.t.tvoid else e1.etype) p
 	| EThrow e ->
 		let e = type_expr ctx e in
 		mk (TThrow e) (mk_mono()) p
@@ -1544,7 +1544,7 @@ and type_call ctx e el p =
 	match e, el with
 	| (EConst (Ident "trace"),p) , e :: el ->
 		if Common.defined ctx.com "no_traces" then
-			null ctx.api.tvoid p
+			null ctx.t.tvoid p
 		else
 		let params = (match el with [] -> [] | _ -> ["customParams",(EArrayDecl el , p)]) in
 		let infos = mk_infos ctx p params in
@@ -1606,7 +1606,7 @@ and type_call ctx e el p =
 			) in
 			el , TInst (c,params)
 		) in
-		mk (TCall (mk (TConst TSuper) t sp,el)) ctx.api.tvoid p
+		mk (TCall (mk (TConst TSuper) t sp,el)) ctx.t.tvoid p
 	| _ ->
 		(match e with
 		| EField ((EConst (Ident "super"),_),_) , _ | EType ((EConst (Ident "super"),_),_) , _ -> ctx.in_super_call <- true
@@ -1628,28 +1628,9 @@ and type_call ctx e el p =
 		| AKMacro (ethis,f) ->
 			(match ethis.eexpr with
 			| TTypeExpr (TClassDecl c) ->
-				let expr = Typeload.load_instance ctx { tpackage = ["haxe";"macro"]; tname = "Expr"; tparams = []; tsub = None}  p false in
-				let nargs = (match follow f.cf_type with
-				| TFun (args,ret) ->
-					unify ctx ret expr p;
-					(match args with
-					| [(_,_,t)] ->
-						(try
-							unify_raise ctx t expr p;
-							Some 1
-						with Error (Unify _,_) ->
-							unify ctx t (ctx.api.tarray expr) p;
-							None)
-					| _ ->
-						List.iter (fun (_,_,t) -> unify ctx t expr p) args;
-						Some (List.length args))
-				| _ ->
-					assert false
-				) in
-				(match nargs with
-				| Some n -> if List.length el <> n then error ("This macro requires " ^ string_of_int n ^ " arguments") p
-				| None -> ());
-				(!type_macro_rec) ctx c f.cf_name el (nargs = None) p
+				(match ctx.g.do_macro ctx c.cl_path f.cf_name el p with
+				| None -> type_expr ctx (EConst (Ident "null"),p)
+				| Some e -> type_expr ctx e)				
 			| _ -> assert false)
 		| acc ->
 			let e = acc_get ctx acc p in
@@ -1685,30 +1666,14 @@ let rec finalize ctx =
 		List.iter (fun f -> f()) l;
 		finalize ctx
 
-let get_type_module ctx t =
-	let mfound = ref ctx.current in
-	try
-		Hashtbl.iter (fun _ m ->
-			if List.mem t m.mtypes then begin
-				mfound := m;
-				raise Exit;
-			end;
-		) ctx.g.modules;
-		(* @Main, other generated classes ? *)
-		{
-			mtypes = [t];
-			mpath = t_path t;
-		}
-	with
-		Exit -> !mfound
-
 type state =
 	| Generating
 	| Done
 	| NotYet
 
-let types ctx main excludes =
+let generate ctx main excludes =
 	let types = ref [] in
+	let modules = ref [] in
 	let states = Hashtbl.create 0 in
 	let state p = try Hashtbl.find states p with Not_found -> NotYet in
 	let statics = ref PMap.empty in
@@ -1721,7 +1686,7 @@ let types ctx main excludes =
 			prerr_endline ("Warning : maybe loop in static generation of " ^ s_type_path p);
 		| NotYet ->
 			Hashtbl.add states p Generating;
-			ctx.api.on_generate t;
+			ctx.g.do_generate ctx t;
 			let t = (match t with
 			| TClassDecl c ->
 				walk_class p c;
@@ -1804,7 +1769,7 @@ let types ctx main excludes =
 		) c.cl_statics
 
 	in
-	Hashtbl.iter (fun _ m -> List.iter loop m.mtypes) ctx.g.modules;
+	Hashtbl.iter (fun _ m -> modules := m :: !modules; List.iter loop m.mtypes) ctx.g.modules;
 	(match main with
 	| None -> ()
 	| Some cl ->
@@ -1839,19 +1804,116 @@ let types ctx main excludes =
 		c.cl_ordered_statics <- f :: c.cl_ordered_statics;
 		types := TClassDecl c :: !types
 	);
-	List.rev !types
+	List.rev !types, List.rev !modules
+
+(* ---------------------------------------------------------------------- *)
+(* MACROS *)
+
+let type_macro ctx cpath 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;
+			com2.main_class <- None;			
+			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 = ctx.g.do_create com2 in
+			let mctx = Interp.create com2 in
+			let on_error = com2.error in
+			com2.error <- (fun e p -> Interp.set_error mctx true; on_error e p);
+			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; // causes some issues because of optional args and Null type in Flash9 *)
+			ignore(Typeload.load_module ctx2 (["haxe";"macro"],"Expr") p);
+			finalize ctx2;
+			let types, _ = generate 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 cpath with Not_found -> cpath) in
+	ignore(Typeload.load_module ctx2 m p);
+	let meth = (match Typeload.load_instance ctx2 { tpackage = fst cpath; tname = snd cpath; tparams = []; tsub = None } p true with
+		| TInst (c,_) -> (try PMap.find f c.cl_statics with Not_found -> error ("Method " ^ f ^ " not found on class " ^ s_type_path cpath) p)
+		| _ -> error "Macro should be called on a class" p
+	) in
+	let expr = Typeload.load_instance ctx2 { tpackage = ["haxe";"macro"]; tname = "Expr"; tparams = []; tsub = None} p false in
+	let nargs = (match follow meth.cf_type with
+		| TFun (args,ret) ->
+			unify ctx2 ret expr p;
+			(match args with
+			| [(_,_,t)] ->
+				(try
+					unify_raise ctx2 t expr p;
+					Some 1
+				with Error (Unify _,_) ->
+					unify ctx2 t (ctx2.t.tarray expr) p;
+					None)
+			| _ ->
+				List.iter (fun (_,_,t) -> unify ctx2 t expr p) args;
+				Some (List.length args))
+		| _ ->
+			assert false
+	) in
+	(match nargs with
+	| Some n -> if List.length el <> n then error ("This macro requires " ^ string_of_int n ^ " arguments") p
+	| None -> ());
+	let call() =
+		let el = List.map Interp.encode_expr el in
+		match Interp.call_path mctx ((fst cpath) @ [snd cpath]) f (if nargs = None then [Interp.enc_array el] else el) p with
+		| None -> None
+		| Some v -> Some (try Interp.decode_expr v with Interp.Invalid_expr -> error "The macro didn't return a valid expression" p)
+	in
+	let e = (if Common.defined ctx.com "macro" then begin
+		(*
+			this is super-tricky : we can't evaluate a macro inside a macro because we might trigger some cycles.
+			So instead, we generate a haxe.macro.Context.delayedCalled(i) expression that will only evaluate the
+			macro if/when it is called.
+
+			The tricky part is that the whole delayed-evaluation process has to use the same contextual informations
+			as if it was evaluated now.
+		*)
+		let ctx = {
+			ctx with locals = ctx.locals;
+		} in
+		let pos = Interp.alloc_delayed mctx (fun() ->
+			(* remove $delay_call calls from the stack *)
+			Interp.unwind_stack mctx;
+			match call() with
+			| None -> raise Interp.Abort
+			| Some e -> Interp.eval mctx (Genneko.gen_expr mctx.Interp.gen (type_expr ctx e))
+		) in
+		let e = (EConst (Ident "__dollar__delay_call"),p) in
+		Some (EUntyped (ECall (e,[EConst (Int (string_of_int pos)),p]),p),p)
+	end else begin
+		finalize ctx2;
+		let types, _ = generate ctx2 None [] in
+		Interp.add_types mctx types;
+		call()
+	end) in
+	t();
+	e
 
 (* ---------------------------------------------------------------------- *)
 (* TYPER INITIALIZATION *)
 
-let create com =
+let rec create com =
 	let empty =	{
 		mpath = [] , "";
 		mtypes = [];
 	} in
 	let ctx = {
 		com = com;
-		api = com.type_api;
+		t = com.basic;
 		g = {
 			core_api = None;
 			macros = None;
@@ -1862,6 +1924,13 @@ let create com =
 			doinline = not (Common.defined com "no_inline");
 			hook_generate = [];
 			std = empty;
+			do_inherit = Codegen.on_inherit;
+			do_create = create;
+			do_macro = type_macro;
+			do_load_module = Typeload.load_module;
+			do_generate = Codegen.on_generate;
+			do_optimize = Optimizer.reduce_expression;
+			do_build_instance = Codegen.build_instance;
 		};
 		untyped = false;
 		in_constructor = false;
@@ -1883,11 +1952,6 @@ let create com =
 		opened = [];
 		param_type = None;
 	} in
-	ctx.api.load_module <- Typeload.load_module ctx;
-	ctx.api.build_instance <- Codegen.build_instance ctx;
-	ctx.api.on_generate <- Codegen.on_generate ctx;
-	ctx.api.get_type_module <- get_type_module ctx;
-	ctx.api.optimize <- Optimizer.reduce_expression ctx;
 	ctx.g.std <- (try
 		Typeload.load_module ctx ([],"StdTypes") null_pos
 	with
@@ -1897,106 +1961,31 @@ let create com =
 		match t with
 		| TEnumDecl e ->
 			(match snd e.e_path with
-			| "Void" -> ctx.api.tvoid <- TEnum (e,[])
-			| "Bool" -> ctx.api.tbool <- TEnum (e,[])
+			| "Void" -> ctx.t.tvoid <- TEnum (e,[])
+			| "Bool" -> ctx.t.tbool <- TEnum (e,[])
 			| _ -> ())
 		| TClassDecl c ->
 			(match snd c.cl_path with
-			| "Float" -> ctx.api.tfloat <- TInst (c,[])
-			| "Int" -> ctx.api.tint <- TInst (c,[])
+			| "Float" -> ctx.t.tfloat <- TInst (c,[])
+			| "Int" -> ctx.t.tint <- TInst (c,[])
 			| _ -> ())
 		| TTypeDecl td ->
 			(match snd td.t_path with
 			| "Null" ->
 				let f9 = platform com Flash9 in
 				let cpp = platform com Cpp in
-				ctx.api.tnull <- if not (f9 || cpp) then (fun t -> t) else (fun t -> if is_nullable t then TType (td,[t]) else t);
+				ctx.t.tnull <- if not (f9 || cpp) then (fun t -> t) else (fun t -> if is_nullable t then TType (td,[t]) else t);
 			| _ -> ());
 	) ctx.g.std.mtypes;
 	let m = Typeload.load_module ctx ([],"String") null_pos in
 	(match m.mtypes with
-	| [TClassDecl c] -> ctx.api.tstring <- TInst (c,[])
+	| [TClassDecl c] -> ctx.t.tstring <- TInst (c,[])
 	| _ -> assert false);
 	let m = Typeload.load_module ctx ([],"Array") null_pos in
 	(match m.mtypes with
-	| [TClassDecl c] -> ctx.api.tarray <- (fun t -> TInst (c,[t]))
+	| [TClassDecl c] -> ctx.t.tarray <- (fun t -> TInst (c,[t]))
 	| _ -> assert false);
 	ctx
 
-(* ---------------------------------------------------------------------- *)
-(* MACROS *)
-
-let type_macro ctx c f el array 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 on_error = com2.error in
-			com2.error <- (fun e p -> Interp.set_error mctx true; on_error e p);
-			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; // causes some issues because of optional args and Null type in Flash9 *)
-			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);
-	let call() =
-		let el = List.map Interp.encode_expr el in
-		match Interp.call_path mctx ((fst c.cl_path) @ [snd c.cl_path]) f (if array then [Interp.enc_array el] else el) p with
-		| None -> None
-		| Some v -> Some (try Interp.decode_expr v with Interp.Invalid_expr -> error "The macro didn't return a valid expression" p)
-	in
-	let e = (if Common.defined ctx.com "macro" then begin
-		(*
-			this is super-tricky : we can't evaluate a macro inside a macro because we might trigger some cycles.
-			So instead, we generate a haxe.macro.Context.delayedCalled(i) expression that will only evaluate the
-			macro if/when it is called.
-
-			The tricky part is that the whole delayed-evaluation process has to use the same contextual informations
-			as if it was evaluated now.
-		*)
-		let ctx = {
-			ctx with locals = ctx.locals;
-		} in
-		let pos = Interp.alloc_delayed mctx (fun() ->
-			(* remove $delay_call calls from the stack *)
-			Interp.unwind_stack mctx;
-			match call() with
-			| None -> raise Interp.Abort
-			| Some e -> Interp.eval mctx (Genneko.gen_expr mctx.Interp.gen (type_expr ctx e))
-		) in
-		let e = (EConst (Ident "__dollar__delay_call"),p) in
-		(EUntyped (ECall (e,[EConst (Int (string_of_int pos)),p]),p),p)
-	end else begin
-		finalize ctx2;
-		let types = types ctx2 None [] in
-		Interp.add_types mctx types;
-		match call() with
-		| None -> (EConst (Ident "null"),p)
-		| Some e -> e
-	end) in
-	t();
-	type_expr ctx e
-
 ;;
-Typeload.do_create := create;
 type_field_rec := type_field;
-type_macro_rec := type_macro;