Update some type/module resolution + cleanup

src/compiler/hxb/hxbRestore.ml

@@ -7,7 +7,6 @@ class hxb_restore
 = object(self)
 
 	method find (path : path) =
-		(* ServerMessage.debug_msg (Printf.sprintf "[1] Find %s from hxb" (s_type_path path)); *)
 		try begin
 			let m = com.module_lut#find path in
 			(match m.m_extra.m_cache_state with
@@ -16,25 +15,18 @@ class hxb_restore
 			)
 		end with
 		| Not_found ->
-			(* ServerMessage.debug_msg (Printf.sprintf "[2] Find %s from hxb" (s_type_path path)); *)
 			match cc#find_module_opt path with
 			| Some m -> m
 			| None ->
-				(* ServerMessage.debug_msg (Printf.sprintf "[3] Find %s from hxb" (s_type_path path)); *)
 				begin match cc#get_hxb_module path with
 					| None -> raise Not_found
 					| Some { mc_extra = { m_cache_state = MSBad reason }} -> raise (Bad_module (path, reason))
 					| Some mc -> self#load mc
 				end
 
 	method load (mc : module_cache) =
-		(* ServerMessage.debug_msg (Printf.sprintf "[1] Load %s from hxb" (s_type_path mc.mc_path)); *)
 		let reader = new HxbReader.hxb_reader (self#make_module mc) self#add_module self#resolve_type (fun () -> ()) in
-		try
-			let m = reader#read (IO.input_bytes mc.mc_bytes) true null_pos in
-			(* ServerMessage.debug_msg (Printf.sprintf "[2] Loaded %s from hxb" (s_type_path mc.mc_path)); *)
-			m
-		with
+		try reader#read (IO.input_bytes mc.mc_bytes) true null_pos with
 		| Bad_module (path, reason) ->
 			ServerMessage.skipping_dep com "" (path,(Printer.s_module_skip_reason reason));
 			com.module_lut#remove mc.mc_path;
@@ -54,17 +46,12 @@ class hxb_restore
 
 	method resolve_type (pack : string list) (mname : string) (tname : string) =
 		let path = (pack,mname) in
-		(* ServerMessage.debug_msg (Printf.sprintf "  resolve type %s (%b)" (s_type_path path) (com.module_lut#mem path)); *)
 		try
-			let m = self#find path in
+			let m = try self#find path with Not_found -> print_endline "cannot find module"; raise Not_found in
 			List.find (fun t -> snd (t_path t) = tname) m.m_types
 		with
-		| Bad_module (_, reason) ->
-			ServerMessage.debug_msg (Printf.sprintf "  error resolving type %s (bad)" (s_type_path path));
-			raise (Bad_module (path, reason))
-		| Not_found ->
-			ServerMessage.debug_msg (Printf.sprintf "  error resolving type %s (not found)" (s_type_path path));
-			raise Not_found
+			| Bad_module (_, reason) -> raise (Bad_module (path, reason))
+			| Not_found -> raise Not_found
 
 	method make_module (mc : module_cache) (path : path) (file : string) =
 		{
@@ -85,3 +72,8 @@ end
 let find (cc : CompilationCache.context_cache) (com : Common.context) (path : path) =
 	let loader = new hxb_restore cc com in
 	loader#find path
+
+let find_type (cc : CompilationCache.context_cache) (com : Common.context) (path : path) =
+	let m = find cc com path in
+	List.find (fun t -> snd (t_path t) = (snd path)) m.m_types
+

src/compiler/serverMessage.ml

@@ -29,7 +29,6 @@ type server_message_options = {
 	mutable print_message : bool;
 	mutable print_socket_message : bool;
 	mutable print_uncaught_error : bool;
-	mutable print_new_context : bool;
 }
 
 let config = {
@@ -58,7 +57,6 @@ let config = {
 	print_message = false;
 	print_socket_message = false;
 	print_uncaught_error = false;
-	print_new_context = false;
 }
 
 let sign_string com =
@@ -71,7 +69,7 @@ let debug_msg msg =
 	if config.print_debug then print_endline msg
 
 let compiler_stage com =
-	if config.print_compiler_stage then print_endline (Printf.sprintf "%scompiler stage: %s" (sign_string com) (s_compiler_stage com.stage))
+	if config.print_compiler_stage then print_endline (Printf.sprintf "compiler stage: %s" (s_compiler_stage com.stage))
 
 let added_directory com tabs dir =
 	if config.print_added_directory then print_endline (Printf.sprintf "%sadded directory %s" (sign_string com) dir)
@@ -196,8 +194,7 @@ let enable_all () =
 	config.print_stats <- true;
 	config.print_message <- true;
 	config.print_socket_message <- true;
-	config.print_uncaught_error <- true;
-	config.print_new_context <- true
+	config.print_uncaught_error <- true
 
 let set_by_name name value = match name with
 	| "debug" -> config.print_debug <- value
@@ -224,5 +221,4 @@ let set_by_name name value = match name with
 	| "message" -> config.print_message <- value;
 	| "socketMessage" -> config.print_socket_message <- value;
 	| "uncaughtError" -> config.print_uncaught_error <- value;
-	| "newContext" -> config.print_new_context <- value;
 	| _ -> raise Not_found

src/context/common.ml

@@ -1040,7 +1040,9 @@ let rec has_feature com f =
 		| field :: cl :: pack ->
 			let r = (try
 				let path = List.rev pack, cl in
-				(match List.find (fun t -> t_path t = path && not (Meta.has Meta.RealPath (t_infos t).mt_meta)) com.types with
+				(* (match List.find (fun t -> t_path t = path && not (Meta.has Meta.RealPath (t_infos t).mt_meta)) com.types with *)
+				let m = com.module_lut#find (com.type_to_module#find path) in
+				(match List.find (fun t -> snd (t_path t) = (snd path)) m.m_types with
 				| t when field = "*" ->
 					not (has_dce com) ||
 					(match t with TAbstractDecl a -> Meta.has Meta.ValueUsed a.a_meta | _ -> Meta.has Meta.Used (t_infos t).mt_meta)

src/context/commonCache.ml

@@ -74,7 +74,7 @@ let rec cache_context cs com =
 	let sign = Define.get_signature com.defines in
 	let cache_module m =
 		(* If we have a signature mismatch, look-up cache for module. Physical equality check is fine as a heueristic. *)
-		let cc = if m.m_extra.m_sign == sign then cc else cs#get_context m.m_extra.m_sign in
+		let cc = if m.m_extra.m_sign = sign then cc else cs#get_context m.m_extra.m_sign in
 		(* assert (m.m_extra.m_sign = sign); *)
 		cc#cache_module m.m_path m;
 	in
@@ -90,6 +90,7 @@ let rec clear_cache cs com =
 	com.module_lut#clear;
 	com.stored_typed_exprs#clear;
 	com.module_nonexistent_lut#clear;
+	(* Hashtbl.clear com.features; *)
 	(* com.type_to_module#clear; *)
 
 	match com.get_macros() with

src/core/define.ml

@@ -106,23 +106,26 @@ let raw_define ctx k =
 let define ctx k =
 	raw_define_value ctx (get_define_key k) "1"
 
+let get_signature_raw def =
+	let defines = PMap.foldi (fun k v acc ->
+		(* don't make much difference between these special compilation flags *)
+		match String.concat "_" (ExtString.String.nsplit k "-") with
+		(* If we add something here that might be used in conditional compilation it should be added to
+			 Parser.parse_macro_ident as well (issue #5682).
+			 Note that we should removed flags like use_rtti_doc here.
+		*)
+		| "display" | "use_rtti_doc" | "macro_times" | "display_details" | "no_copt" | "display_stdin"
+		| "message.reporting" | "message.log_file" | "message.log_format" | "message.no_color"
+		| "dump" | "dump_dependencies" | "dump_ignore_var_ids" -> acc
+		| _ -> (k ^ "=" ^ v) :: acc
+	) def.values [] in
+	String.concat "@" (List.sort compare defines)
+
 let get_signature def =
 	match def.defines_signature with
 	| Some s -> s
 	| None ->
-		let defines = PMap.foldi (fun k v acc ->
-			(* don't make much difference between these special compilation flags *)
-			match String.concat "_" (ExtString.String.nsplit k "-") with
-			(* If we add something here that might be used in conditional compilation it should be added to
-			   Parser.parse_macro_ident as well (issue #5682).
-			   Note that we should removed flags like use_rtti_doc here.
-			*)
-			| "display" | "use_rtti_doc" | "macro_times" | "display_details" | "no_copt" | "display_stdin"
-			| "message.reporting" | "message.log_file" | "message.log_format" | "message.no_color"
-			| "dump" | "dump_dependencies" | "dump_ignore_var_ids" -> acc
-			| _ -> (k ^ "=" ^ v) :: acc
-		) def.values [] in
-		let str = String.concat "@" (List.sort compare defines) in
+		let str = get_signature_raw def in
 		(* Printf.eprintf "Defines: %s\n" str; *)
 		let s = Digest.string str in
 		def.defines_signature <- Some s;

src/filters/exceptions.ml

@@ -597,8 +597,9 @@ let insert_save_stacks tctx =
 		(fun e -> e)
 	else
 		let native_stack_trace_cls =
-			let tp = mk_type_path (["haxe"],"NativeStackTrace") in
-			match Typeload.load_type_def tctx null_pos tp with
+			(* let tp = mk_type_path (["haxe"],"NativeStackTrace") in *)
+			(* match Typeload.load_type_def tctx null_pos tp with *)
+			match HxbRestore.find_type (CommonCache.get_cache tctx.com) tctx.com (["haxe"], "NativeStackTrace") with
 			| TClassDecl cls -> cls
 			| TAbstractDecl { a_impl = Some cls } -> cls
 			| _ -> raise_typing_error "haxe.NativeStackTrace is expected to be a class or an abstract" null_pos

src/typing/typeloadModule.ml

@@ -309,9 +309,9 @@ module ModuleLevel = struct
 						| ParseError(_,(msg,p),_) -> Parser.error msg p
 					in
 					List.iter (fun (d,p) -> match d with EImport _ | EUsing _ -> () | _ -> raise_typing_error "Only import and using is allowed in import.hx files" p) r;
-					let m_import = make_import_module path r in
-					add_module ctx m_import p;
-					add_dependency m m_import;
+					let mimport = make_import_module path r in
+					add_module ctx mimport p;
+					add_dependency m mimport;
 					r
 				end else begin
 					let r = [] in
@@ -849,32 +849,33 @@ and load_hxb_module ctx path p =
 		close_in ch;
 		raise e
 
-and load_module' ctx g m p =
+and load_module' ctx g mpath p =
 	try
 		(* Check current context *)
-		ctx.com.module_lut#find m
+		ctx.com.module_lut#find mpath
 	with Not_found ->
 		(* Check cache *)
-		match !type_module_hook ctx m p with
+		match !type_module_hook ctx mpath p with
 		| Some m ->
+			ctx.com.module_lut#add mpath m;
 			m
 		(* Try loading from hxb first, then from source *)
-		| None -> try load_hxb_module ctx m p with Not_found ->
-			let raise_not_found () = raise_error_msg (Module_not_found m) p in
-			if ctx.com.module_nonexistent_lut#mem m then raise_not_found();
+		| None -> try load_hxb_module ctx mpath p with Not_found ->
+			let raise_not_found () = raise_error_msg (Module_not_found mpath) p in
+			if ctx.com.module_nonexistent_lut#mem mpath then raise_not_found();
 			if ctx.g.load_only_cached_modules then raise_not_found();
 			let is_extern = ref false in
 			let file, decls = try
 				(* Try parsing *)
-				TypeloadParse.parse_module ctx m p
+				TypeloadParse.parse_module ctx mpath p
 			with Not_found ->
 				(* Nothing to parse, try loading extern type *)
 				let rec loop = function
 					| [] ->
-						ctx.com.module_nonexistent_lut#add m true;
+						ctx.com.module_nonexistent_lut#add mpath true;
 						raise_not_found()
 					| (file,load) :: l ->
-						match load m p with
+						match load mpath p with
 						| None -> loop l
 						| Some (_,a) -> file, a
 				in
@@ -883,7 +884,7 @@ and load_module' ctx g m p =
 			in
 			let is_extern = !is_extern in
 			try
-				type_module ctx m file ~is_extern decls p
+				type_module ctx mpath file ~is_extern decls p
 			with Forbid_package (inf,pl,pf) when p <> null_pos ->
 				raise (Forbid_package (inf,p::pl,pf))