[hxb] better handle going from non-macro to macro context

src/compiler/compilationCache.ml

@@ -144,17 +144,28 @@ class cache = object(self)
 
 	(* contexts *)
 
+	method create_context sign =
+		let cache = new context_cache (Hashtbl.length contexts) sign in
+		context_list <- cache :: context_list;
+		Hashtbl.add contexts sign cache;
+		cache
+
+	method get_or_create_context sign =
+		match Hashtbl.find_opt contexts sign with
+		| None -> self#create_context sign
+		| Some cache -> cache
+
 	method get_context sign =
 		try
 			Hashtbl.find contexts sign
 		with Not_found ->
-			let cache = new context_cache (Hashtbl.length contexts) sign in
-			context_list <- cache :: context_list;
-			Hashtbl.add contexts sign cache;
-			cache
+			trace_call_stack ();
+			assert false
 
 	method add_info sign desc platform class_path defines =
-		let cc = self#get_context sign in
+		(* TODO context should probably already exist at this point? *)
+		(* let cc = self#get_context sign in *)
+		let cc = self#get_or_create_context sign in
 		let jo = JObject [
 			"index",JInt cc#get_index;
 			"desc",JString desc;

src/compiler/server.ml

@@ -221,7 +221,20 @@ let get_changed_directories sctx (ctx : Typecore.typer) =
 	dirs
 
 let find_or_restore_module cs sign ctx path =
-	HxbRestore.find cs sign ctx.Typecore.com path
+	let com = ctx.Typecore.com in
+	(* Use macro context if needed *)
+	let com = if sign <> (CommonCache.get_cache_sign com) then
+		(match com.get_macros() with
+			| None ->
+					ignore(MacroContext.get_macro_context ctx);
+					Option.get (com.get_macros())
+			| Some com -> com)
+		else com
+	in
+	assert (sign = (CommonCache.get_cache_sign com));
+	(* Make sure cache is created *)
+	ignore(CommonCache.get_cache com);
+	HxbRestore.find cs sign com path
 
 (* Checks if module [m] can be reused from the cache and returns None in that case. Otherwise, returns
    [Some m'] where [m'] is the module responsible for [m] not being reusable. *)

src/context/common.ml

@@ -20,6 +20,7 @@ open Extlib_leftovers
 open Ast
 open Type
 open Globals
+open Lookup
 open Define
 open NativeLibraries
 open Warning
@@ -292,68 +293,6 @@ type report_mode =
 	| RMDiagnostics of Path.UniqueKey.t list
 	| RMStatistics
 
-class virtual ['key,'value] lookup = object(self)
-	method virtual add : 'key -> 'value -> unit
-	method virtual remove : 'key -> unit
-	method virtual find : 'key -> 'value
-	method virtual iter : ('key -> 'value -> unit) -> unit
-	method virtual fold : 'acc . ('key -> 'value -> 'acc -> 'acc) -> 'acc -> 'acc
-	method virtual mem : 'key -> bool
-	method virtual clear : unit
-end
-
-class ['key,'value] pmap_lookup = object(self)
-	inherit ['key,'value] lookup
-	val mutable lut : ('key,'value) PMap.t = PMap.empty
-
-	method add (key : 'key) (value : 'value) =
-		lut <- PMap.add key value lut
-
-	method remove (key : 'key) =
-		lut <- PMap.remove key lut
-
-	method find (key : 'key) : 'value =
-		PMap.find key lut
-
-	method iter (f : 'key -> 'value -> unit) =
-		PMap.iter f lut
-
-	method fold : 'acc . ('key -> 'value -> 'acc -> 'acc) -> 'acc -> 'acc = fun f acc ->
-		PMap.foldi f lut acc
-
-	method mem (key : 'key) =
-		PMap.mem key lut
-
-	method clear =
-		lut <- PMap.empty
-end
-
-class ['key,'value] hashtbl_lookup = object(self)
-	inherit ['key,'value] lookup
-	val lut : ('key,'value) Hashtbl.t = Hashtbl.create 0
-
-	method add (key : 'key) (value : 'value) =
-		Hashtbl.replace lut key value
-
-	method remove (key : 'key) =
-		Hashtbl.remove lut key
-
-	method find (key : 'key) : 'value =
-		Hashtbl.find lut key
-
-	method iter (f : 'key -> 'value -> unit) =
-		Hashtbl.iter f lut
-
-	method fold : 'acc . ('key -> 'value -> 'acc -> 'acc) -> 'acc -> 'acc = fun f acc ->
-		Hashtbl.fold f lut acc
-
-	method mem (key : 'key) =
-		Hashtbl.mem lut key
-
-	method clear =
-		Hashtbl.clear lut
-end
-
 type context = {
 	compilation_step : int;
 	mutable stage : compiler_stage;

src/context/commonCache.ml

@@ -65,7 +65,7 @@ let handle_native_lib com lib =
 let get_cache com = match com.Common.cache with
 	| None ->
 		let sign = Define.get_signature com.defines in
-		com.cs#get_context sign
+		com.cs#get_or_create_context sign
 	| Some cache ->
 		cache
 

src/context/lookup.ml

@@ -0,0 +1,63 @@
+
+class virtual ['key,'value] lookup = object(self)
+	method virtual add : 'key -> 'value -> unit
+	method virtual remove : 'key -> unit
+	method virtual find : 'key -> 'value
+	method virtual iter : ('key -> 'value -> unit) -> unit
+	method virtual fold : 'acc . ('key -> 'value -> 'acc -> 'acc) -> 'acc -> 'acc
+	method virtual mem : 'key -> bool
+	method virtual clear : unit
+end
+
+class ['key,'value] pmap_lookup = object(self)
+	inherit ['key,'value] lookup
+	val mutable lut : ('key,'value) PMap.t = PMap.empty
+
+	method add (key : 'key) (value : 'value) =
+		lut <- PMap.add key value lut
+
+	method remove (key : 'key) =
+		lut <- PMap.remove key lut
+
+	method find (key : 'key) : 'value =
+		PMap.find key lut
+
+	method iter (f : 'key -> 'value -> unit) =
+		PMap.iter f lut
+
+	method fold : 'acc . ('key -> 'value -> 'acc -> 'acc) -> 'acc -> 'acc = fun f acc ->
+		PMap.foldi f lut acc
+
+	method mem (key : 'key) =
+		PMap.mem key lut
+
+	method clear =
+		lut <- PMap.empty
+end
+
+class ['key,'value] hashtbl_lookup = object(self)
+	inherit ['key,'value] lookup
+	val lut : ('key,'value) Hashtbl.t = Hashtbl.create 0
+
+	method add (key : 'key) (value : 'value) =
+		Hashtbl.replace lut key value
+
+	method remove (key : 'key) =
+		Hashtbl.remove lut key
+
+	method find (key : 'key) : 'value =
+		Hashtbl.find lut key
+
+	method iter (f : 'key -> 'value -> unit) =
+		Hashtbl.iter f lut
+
+	method fold : 'acc . ('key -> 'value -> 'acc -> 'acc) -> 'acc -> 'acc = fun f acc ->
+		Hashtbl.fold f lut acc
+
+	method mem (key : 'key) =
+		Hashtbl.mem lut key
+
+	method clear =
+		Hashtbl.clear lut
+end
+

src/context/typecore.ml

@@ -20,6 +20,7 @@
 open Globals
 open Ast
 open Common
+open Lookup
 open Type
 open Error
 open Resolution

src/core/define.ml

@@ -121,6 +121,8 @@ let get_signature_raw def =
 	) def.values [] in
 	String.concat "@" (List.sort compare defines)
 
+let digest_tbl = Hashtbl.create 0
+
 let get_signature def =
 	match def.defines_signature with
 	| Some s -> s
@@ -129,8 +131,12 @@ let get_signature def =
 		(* Printf.eprintf "Defines: %s\n" str; *)
 		let s = Digest.string str in
 		def.defines_signature <- Some s;
+		Hashtbl.add digest_tbl s str;
 		s
 
+let retrieve_defines sign =
+	try Hashtbl.find digest_tbl sign with Not_found -> "[cannot find defines for sign %s]" ^ sign
+
 let deprecation_lut =
 	let h = Hashtbl.create 0 in
 	List.iter (fun (name,reason) ->

src/typing/finalization.ml

@@ -1,5 +1,6 @@
 open Globals
 open Common
+open Lookup
 open Type
 open Error
 open TyperBase

src/typing/typeloadModule.ml

@@ -43,6 +43,14 @@ let field_of_static_definition d p =
 		cff_kind = d.d_data;
 	}
 
+let do_add_module com m =
+	let sign = CommonCache.get_cache_sign com in
+	if m.m_extra.m_sign <> sign then begin
+		trace (Printf.sprintf "Adding module %s with a different sign!" (s_type_path m.m_path));
+		trace (Define.retrieve_defines sign);
+		trace (Define.retrieve_defines m.m_extra.m_sign);
+	end else com.module_lut#add m.m_path m;
+
 module ModuleLevel = struct
 	let make_module ctx mpath file =
 		let m = {
@@ -56,7 +64,8 @@ module ModuleLevel = struct
 
 	let add_module ctx m p =
 		List.iter (TypeloadCheck.check_module_types ctx m p) m.m_types;
-		ctx.com.module_lut#add m.m_path m
+		(* ctx.com.module_lut#add m.m_path m *)
+		do_add_module ctx.com m
 
 	(*
 		Build module structure : should be atomic - no type loading is possible
@@ -785,7 +794,8 @@ let type_types_into_module ctx m tdecls p =
 *)
 let type_module ctx mpath file ?(dont_check_path=false) ?(is_extern=false) tdecls p =
 	let m = ModuleLevel.make_module ctx mpath file in
-	ctx.com.module_lut#add m.m_path m;
+	(* ctx.com.module_lut#add m.m_path m; *)
+	do_add_module ctx.com m;
 	let tdecls = ModuleLevel.handle_import_hx ctx m tdecls p in
 	let ctx = type_types_into_module ctx m tdecls p in
 	if is_extern then m.m_extra.m_kind <- MExtern else if not dont_check_path then Typecore.check_module_path ctx m.m_path p;
@@ -809,7 +819,8 @@ let rec get_reader ctx =
 	in
 
 	let add_module m =
-		ctx.com.module_lut#add m.m_path m
+		(* ctx.com.module_lut#add m.m_path m *)
+		do_add_module ctx.com m;
 	in
 
 	let flush_fields () =
@@ -861,7 +872,8 @@ and load_module' ctx g mpath p =
 		(* Check cache *)
 		match !type_module_hook ctx mpath p with
 		| Some m ->
-			ctx.com.module_lut#add mpath m;
+			(* ctx.com.module_lut#add mpath m; *)
+			do_add_module ctx.com m;
 			m
 		(* Try loading from hxb first, then from source *)
 		| None -> try load_hxb_module ctx mpath p with Not_found ->

src/typing/typer.ml

@@ -22,6 +22,7 @@ open DisplayTypes.DisplayMode
 open DisplayTypes.CompletionResultKind
 open CompletionItem.ClassFieldOrigin
 open Common
+open Lookup
 open Type
 open Typecore
 open Resolution