Optimize Common.find_file for memory (#8202)

* readdir

* cleanup

* fix

* cache readdir

* fix for ocaml > 4.04

* don't iterate cached directories again

* test Module.macro.hx without Module.hx

* Compiler.flushDiskCache()

* make existing/absent HAXE_STD_PATH env var consistent wrt order of "" and std lib class paths

* fix windows?

* more reliable fix

* path separator is expected to be "/" on every OS
see #3348

* minor opt

src/compiler/main.ml

@@ -361,19 +361,19 @@ let get_std_class_paths () =
 			let lib_path = Filename.concat prefix_path "lib" in
 			let share_path = Filename.concat prefix_path "share" in
 			[
+				"";
 				Path.add_trailing_slash (Filename.concat lib_path "haxe/std");
 				Path.add_trailing_slash (Filename.concat lib_path "haxe/extraLibs");
 				Path.add_trailing_slash (Filename.concat share_path "haxe/std");
 				Path.add_trailing_slash (Filename.concat share_path "haxe/extraLibs");
 				Path.add_trailing_slash (Filename.concat base_path "std");
-				Path.add_trailing_slash (Filename.concat base_path "extraLibs");
-				""
+				Path.add_trailing_slash (Filename.concat base_path "extraLibs")
 			]
 		else
 			[
+				"";
 				Path.add_trailing_slash (Filename.concat base_path "std");
-				Path.add_trailing_slash (Filename.concat base_path "extraLibs");
-				""
+				Path.add_trailing_slash (Filename.concat base_path "extraLibs")
 			]
 
 let rec process_params create pl =

src/context/common.ml

@@ -189,6 +189,7 @@ type context = {
 	mutable get_macros : unit -> context option;
 	mutable run_command : string -> int;
 	file_lookup_cache : (string,string option) Hashtbl.t;
+	readdir_cache : (string,(string array) option) Hashtbl.t;
 	parser_cache : (string,(type_def * pos) list) Hashtbl.t;
 	module_to_file : (path,string) Hashtbl.t;
 	cached_macros : (path * string,(((string * bool * t) list * t * tclass * Type.tclass_field) * module_def)) Hashtbl.t;
@@ -467,6 +468,7 @@ let create version s_version args =
 			tarray = (fun _ -> assert false);
 		};
 		file_lookup_cache = Hashtbl.create 0;
+		readdir_cache = Hashtbl.create 0;
 		module_to_file = Hashtbl.create 0;
 		stored_typed_exprs = PMap.empty;
 		cached_macros = Hashtbl.create 0;
@@ -485,6 +487,7 @@ let clone com =
 		main_class = None;
 		features = Hashtbl.create 0;
 		file_lookup_cache = Hashtbl.create 0;
+		readdir_cache = Hashtbl.create 0;
 		parser_cache = Hashtbl.create 0;
 		module_to_file = Hashtbl.create 0;
 		callbacks = new compiler_callbacks;
@@ -617,6 +620,10 @@ let platform ctx p = ctx.platform = p
 let platform_name_macro com =
 	if defined com Define.Macro then "macro" else platform_name com.platform
 
+let normalize_dir_separator path =
+	if is_windows then String.map (fun c -> if c = '/' then '\\' else c) path
+	else path
+
 let find_file ctx f =
 	try
 		(match Hashtbl.find ctx.file_lookup_cache f with
@@ -625,20 +632,63 @@ let find_file ctx f =
 	with Exit ->
 		raise Not_found
 	| Not_found ->
+		let remove_extension file =
+			try String.sub file 0 (String.rindex file '.')
+			with Not_found -> file
+		in
+		let extension file =
+			try
+				let dot_pos = String.rindex file '.' in
+				String.sub file dot_pos (String.length file - dot_pos)
+			with Not_found -> file
+		in
+		let f_dir = Filename.dirname f
+		and platform_ext = "." ^ (platform_name_macro ctx)
+		and is_core_api = defined ctx Define.CoreApi in
 		let rec loop had_empty = function
 			| [] when had_empty -> raise Not_found
 			| [] -> loop true [""]
 			| p :: l ->
 				let file = p ^ f in
-				if Sys.file_exists file then begin
-					(try
-						let ext = String.rindex file '.' in
-						let file_pf = String.sub file 0 (ext + 1) ^ platform_name_macro ctx ^ String.sub file ext (String.length file - ext) in
-						if not (defined ctx Define.CoreApi) && Sys.file_exists file_pf then file_pf else file
-					with Not_found ->
-						file)
-				end else
+				let dir = Filename.dirname file in
+				if Hashtbl.mem ctx.readdir_cache dir then
 					loop (had_empty || p = "") l
+				else begin
+					let found = ref "" in
+					let dir_listing =
+						try Some (Sys.readdir dir);
+						with Sys_error _ -> None
+					in
+					Hashtbl.add ctx.readdir_cache dir dir_listing;
+					let normalized_f = normalize_dir_separator f in
+					Option.may
+						(Array.iter (fun file_name ->
+							let current_f = if f_dir = "." then file_name else f_dir ^ "/" ^ file_name in
+							let pf,current_f =
+								if is_core_api then false,current_f
+								else begin
+									let ext = extension current_f in
+									let pf_ext = extension (remove_extension current_f) in
+									if platform_ext = pf_ext then
+										true,(remove_extension (remove_extension current_f)) ^ ext
+									else
+										false,current_f
+								end
+							in
+							let is_cached = Hashtbl.mem ctx.file_lookup_cache current_f in
+							if is_core_api || pf || not is_cached then begin
+								let full_path = if dir = "." then file_name else dir ^ "/" ^ file_name in
+								if is_cached then
+									Hashtbl.remove ctx.file_lookup_cache current_f;
+								Hashtbl.add ctx.file_lookup_cache current_f (Some full_path);
+								if normalize_dir_separator current_f = normalized_f then
+									found := full_path;
+							end
+						))
+						dir_listing;
+					if !found <> "" then !found
+					else loop (had_empty || p = "") l
+				end
 		in
 		let r = (try Some (loop false ctx.class_path) with Not_found -> None) in
 		Hashtbl.add ctx.file_lookup_cache f r;

src/macro/macroApi.ml

@@ -1682,6 +1682,12 @@ let macro_api ccom get_api =
 			);
 			vnull
 		);
+		"flush_disk_cache", vfun0 (fun () ->
+			let com = (get_api()).get_com() in
+			Hashtbl.clear com.file_lookup_cache;
+			Hashtbl.clear com.readdir_cache;
+			vnull
+		);
 		"get_pos_infos", vfun1 (fun p ->
 			let p = decode_pos p in
 			encode_obj ["min",vint p.Globals.pmin;"max",vint p.Globals.pmax;"file",encode_string p.Globals.pfile]
@@ -1793,6 +1799,7 @@ let macro_api ccom get_api =
 			| None ->
 				());
 			Hashtbl.clear com.file_lookup_cache;
+			Hashtbl.clear com.readdir_cache;
 			vnull
 		);
 		"add_native_lib", vfun1 (fun file ->

std/haxe/macro/Compiler.hx

@@ -452,6 +452,16 @@ class Compiler {
 		return @:privateAccess Context.load(f, nargs);
 	}
 	#end
+
+	/**
+		Clears cached results of file lookups
+	**/
+	public static function flushDiskCache() {
+		#if (neko || eval)
+		load("flush_disk_cache", 0)();
+		#end
+	}
+
 	#end
 
 	#if (js || lua || macro)

tests/misc/projects/Issue8202/Builder.macro.hx

@@ -0,0 +1,12 @@
+import haxe.macro.Context;
+import haxe.macro.Expr;
+
+class Builder {
+	macro static public function build():Array<Field> {
+		var fields = Context.getBuildFields();
+		fields.push((macro class Dummy {
+			static function generated() {}
+		}).fields[0]);
+		return fields;
+	}
+}

tests/misc/projects/Issue8202/Main.hx

@@ -0,0 +1,6 @@
+@:build(Builder.build())
+class Main {
+	public static function main() {
+		generated();
+	}
+}

tests/misc/projects/Issue8202/compile.hxml

@@ -0,0 +1 @@
+-main Main