Procházet zdrojové kódy

[macros] cache load_macro results in common context (closes #5198)

Dan Korostelev před 9 roky
rodič
revize
b0708e1ece
2 změnil soubory, kde provedl 30 přidání a 24 odebrání
  1. 2 0
      src/typing/common.ml
  2. 28 24
      src/typing/typer.ml

+ 2 - 0
src/typing/common.ml

@@ -182,6 +182,7 @@ type context = {
 	mutable run_command : string -> int;
 	file_lookup_cache : (string,string option) Hashtbl.t;
 	parser_cache : (string,(type_def * pos) list) Hashtbl.t;
+	cached_macros : (path * string,((string * bool * t) list * t * tclass * Type.tclass_field)) Hashtbl.t;
 	mutable stored_typed_exprs : (int, texpr) PMap.t;
 	(* output *)
 	mutable file : string;
@@ -789,6 +790,7 @@ let create version s_version args =
 		};
 		file_lookup_cache = Hashtbl.create 0;
 		stored_typed_exprs = PMap.empty;
+		cached_macros = Hashtbl.create 0;
 		memory_marker = memory_marker;
 		parser_cache = Hashtbl.create 0;
 	}

+ 28 - 24
src/typing/typer.ml

@@ -4968,30 +4968,34 @@ let load_macro ctx display cpath f p =
 		| name :: pack when name.[0] >= 'A' && name.[0] <= 'Z' -> (List.rev pack,name), Some (snd cpath)
 		| _ -> cpath, None
 	) in
-	(* Temporarily enter display mode while typing the macro. *)
-	if display then mctx.com.display <- ctx.com.display;
-	let m = (try Hashtbl.find ctx.g.types_module cpath with Not_found -> cpath) in
-	let mloaded = Typeload.load_module mctx m p in
-	api.Interp.current_macro_module <- (fun() -> mloaded);
-	mctx.m <- {
-		curmod = mloaded;
-		module_types = [];
-		module_using = [];
-		module_globals = PMap.empty;
-		wildcard_packages = [];
-		module_imports = [];
-	};
-	add_dependency ctx.m.curmod mloaded;
-	let mt = Typeload.load_type_def mctx p { tpackage = fst cpath; tname = snd cpath; tparams = []; tsub = sub } in
-	let cl, meth = (match mt with
-		| TClassDecl c ->
-			finalize mctx;
-			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 meth = (match follow meth.cf_type with TFun (args,ret) -> args,ret,cl,meth | _ -> error "Macro call should be a method" p) in
-	mctx.com.display <- DMNone;
-	if not ctx.in_macro then flush_macro_context mint ctx;
+	let meth = try Hashtbl.find mctx.com.cached_macros (cpath,f) with Not_found ->
+		(* Temporarily enter display mode while typing the macro. *)
+		if display then mctx.com.display <- ctx.com.display;
+		let m = (try Hashtbl.find ctx.g.types_module cpath with Not_found -> cpath) in
+		let mloaded = Typeload.load_module mctx m p in
+		api.Interp.current_macro_module <- (fun() -> mloaded);
+		mctx.m <- {
+			curmod = mloaded;
+			module_types = [];
+			module_using = [];
+			module_globals = PMap.empty;
+			wildcard_packages = [];
+			module_imports = [];
+		};
+		add_dependency ctx.m.curmod mloaded;
+		let mt = Typeload.load_type_def mctx p { tpackage = fst cpath; tname = snd cpath; tparams = []; tsub = sub } in
+		let cl, meth = (match mt with
+			| TClassDecl c ->
+				finalize mctx;
+				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 meth = (match follow meth.cf_type with TFun (args,ret) -> args,ret,cl,meth | _ -> error "Macro call should be a method" p) in
+		mctx.com.display <- DMNone;
+		if not ctx.in_macro then flush_macro_context mint ctx;
+		Hashtbl.add mctx.com.cached_macros (cpath,f) meth;
+		meth
+	in
 	t();
 	let call args =
 		let t = macro_timer ctx (s_type_path cpath ^ "." ^ f) in