added macro interp caching (fixed issue #691)

common.ml

@@ -191,6 +191,7 @@ module Define = struct
 		| UseNekoc
 		| UseRttiDoc
 		| Vcproj
+		| NoMacroCache
 		| Last (* must be last *)
 
 	let infos = function
@@ -229,6 +230,7 @@ module Define = struct
 		| NoPatternMatching -> ("no_pattern_matching","Disable pattern matching")
 		| NoInline -> ("no_inline","Disable inlining")
 		| NoRoot -> ("no_root","GenCS internal")
+		| NoMacroCache -> ("no_macro_cache","Disable macro context caching")
 		| NoSwfCompress -> ("no_swf_compress","Disable SWF output compression")
 		| NoTraces -> ("no_traces","Disable all trace calls")
 		| PhpPrefix -> ("php_prefix","Compiled with --php-prefix")

interp.ml

@@ -122,9 +122,8 @@ type callstack = {
 }
 
 type context = {
-	com : Common.context;
 	gen : Genneko.context;
-	types : (Type.path,bool) Hashtbl.t;
+	types : (Type.path,int) Hashtbl.t;
 	prototypes : (string list, vobject) Hashtbl.t;
 	fields_cache : (int,string) Hashtbl.t;
 	mutable error : bool;
@@ -214,7 +213,7 @@ let make_pos p =
 	}
 
 let warn ctx msg p =
-	ctx.com.Common.warning msg (make_pos p)
+	(ctx.curapi.get_com()).Common.warning msg (make_pos p)
 
 let rec pop ctx n =
 	if n > 0 then begin
@@ -1618,7 +1617,7 @@ let std_lib =
 			VBool (Sys.word_size = 64)
 		);
 		"sys_command", Fun1 (fun cmd ->
-			VInt ((get_ctx()).com.run_command (vstring cmd))
+			VInt (((get_ctx()).curapi.get_com()).run_command (vstring cmd))
 		);
 		"sys_exit", Fun1 (fun code ->
 			exit (vint code);
@@ -2516,7 +2515,7 @@ let rec eval ctx (e,p) =
 	| ECall ((EConst (Builtin "delay_call"),_),[EConst (Int index),_]) ->
 		let f = DynArray.get ctx.delayed index in
 		let fbuild = ref None in
-		let old = { ctx with com = ctx.com } in
+		let old = { ctx with gen = ctx.gen } in
 		let compile_delayed_call() =
 			let oldl, oldc, oldb, olde = ctx.locals_map, ctx.locals_count, ctx.locals_barrier, ctx.locals_env in
 			ctx.locals_map <- old.locals_map;
@@ -3274,7 +3273,6 @@ let create com api =
 		"loadmodule",VFunction (Fun2 (fun a b -> assert false));
 	] in
 	let ctx = {
-		com = com;
 		gen = Genneko.new_context com 2 true;
 		types = Hashtbl.create 0;
 		error = false;
@@ -3314,11 +3312,18 @@ let create com api =
 	List.iter (fun e -> ignore((eval ctx e)())) (Genneko.header());
 	ctx
 
+let has_old_version ctx t =
+	let inf = Type.t_infos t in
+	try
+		Hashtbl.find ctx.types inf.mt_path <> inf.mt_module.m_id
+	with Not_found ->
+		false
+
 let add_types ctx types ready =
 	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;
+			Hashtbl.add ctx.types path (Type.t_infos t).mt_module.m_id;
 			true;
 		end
 	) types in

typer.ml

@@ -3121,15 +3121,58 @@ let make_macro_api ctx p =
 		);
 	}
 
-let flush_macro_context mctx ctx =
+let macro_interp_cache = ref None
+
+let rec init_macro_interp ctx2 mctx =
+	let p = Ast.null_pos in
+	ignore(Typeload.load_module ctx2 (["haxe";"macro"],"Expr") p);
+	ignore(Typeload.load_module ctx2 (["haxe";"macro"],"Type") p);
+	if flush_macro_context mctx ctx2 != mctx then assert false;
+	Interp.init mctx;
+	if not (Common.defined ctx2.com Define.NoMacroCache) then macro_interp_cache := Some mctx
+
+and flush_macro_context mctx ctx =
 	finalize ctx;
 	let _, types, modules = generate ctx in
 	ctx.com.types <- types;
 	ctx.com.Common.modules <- modules;
+	(* if one of the type we are using has been modified, we need to create a new macro context from scratch *)
+	let mctx = if List.exists (Interp.has_old_version mctx) types then begin
+		let ctx2 = (match ctx.g.macros with None -> assert false | Some (_,ctx2) -> ctx2) in
+		let com2 = ctx2.com in
+		let mctx = Interp.create com2 (make_macro_api ctx Ast.null_pos) in
+		let macro = ((fun() -> Interp.select mctx), ctx2) in
+		ctx.g.macros <- Some macro;
+		ctx2.g.macros <- Some macro;
+		init_macro_interp ctx2 mctx;
+		mctx
+	end else mctx in
 	(* we should maybe ensure that all filters in Main are applied. Not urgent atm *)
 	Interp.add_types mctx types (Codegen.post_process [Codegen.captured_vars ctx.com; Codegen.rename_local_vars ctx.com]);
-	Codegen.post_process_end()
-
+	Codegen.post_process_end();
+	mctx
+	
+let create_macro_interp ctx ctx2 =
+	let com2 = ctx2.com in
+	let mctx, init = (match !macro_interp_cache with
+		| None ->
+			let mctx = Interp.create com2 (make_macro_api ctx Ast.null_pos) in
+			mctx, (fun() -> init_macro_interp ctx2 mctx)
+		| Some mctx ->
+			mctx, (fun() -> ())
+	) in
+	let on_error = com2.error in
+	com2.error <- (fun e p ->
+		Interp.set_error (Interp.get_ctx()) true;
+		macro_interp_cache := None;
+		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 *)
+	init()
+	
 let get_macro_context ctx p =
 	let api = make_macro_api ctx p in
 	match ctx.g.macros with
@@ -3152,17 +3195,7 @@ let get_macro_context ctx p =
 		Common.define com2 Define.Macro;
 		Common.init_platform com2 Neko;
 		let ctx2 = ctx.g.do_create com2 in
-		let mctx = Interp.create com2 api 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);
-		ignore(Typeload.load_module ctx2 (["haxe";"macro"],"Type") p);
-		flush_macro_context mctx ctx2;
-		Interp.init mctx;
+		create_macro_interp ctx ctx2;
 		api, ctx2
 
 let load_macro ctx cpath f p =
@@ -3192,7 +3225,7 @@ let load_macro ctx cpath f p =
 	) in
 	let meth = (match follow meth.cf_type with TFun (args,ret) -> args,ret,cl,meth | _ -> error "Macro call should be a method" p) in
 	let in_macro = ctx.in_macro in
-	if not in_macro then flush_macro_context mctx ctx2;
+	let mctx = if in_macro then mctx else flush_macro_context mctx ctx2 in
 	t();
 	let call args =
 		let t = macro_timer ctx (s_type_path cpath ^ "." ^ f) in