[server] turn warnings into CBOs

src/compiler/server.ml

@@ -396,11 +396,13 @@ let check_module sctx ctx m p =
 	state
 
 let handle_cache_bound_objects com cbol =
-	List.iter (function
+	DynArray.iter (function
 		| Resource(name,data) ->
 			Hashtbl.replace com.resources name data
 		| IncludeFile(file,position) ->
 			com.include_files <- (file,position) :: com.include_files
+		| Warning(w,msg,p) ->
+			com.warning w [] msg p
 	) cbol
 
 (* Adds module [m] and all its dependencies (recursively) from the cache to the current compilation

src/context/common.ml

@@ -421,6 +421,10 @@ let ignore_error com =
 	if b then com.has_error <- true;
 	b
 
+let module_warning com m w options msg p =
+	DynArray.add m.m_extra.m_cache_bound_objects (Warning(w,msg,p));
+	com.warning w options msg p
+
 (* Defines *)
 
 module Define = Define

src/context/display/deprecationCheck.ml

@@ -7,12 +7,14 @@ type deprecation_context = {
 	com        : Common.context;
 	class_meta : metadata_entry list;
 	field_meta : metadata_entry list;
+	curmod     : module_def;
 }
 
 let create_context com = {
 	com = com;
 	class_meta = [];
 	field_meta = [];
+	curmod = null_module;
 }
 
 let warned_positions = Hashtbl.create 0
@@ -23,7 +25,7 @@ let warn_deprecation dctx s p_usage =
 		Hashtbl.add warned_positions (pkey p_usage) (s,p_usage);
 		if not (is_diagnostics dctx.com) then begin
 			let options = Warning.from_meta (dctx.class_meta @ dctx.field_meta) in
-			dctx.com.warning WDeprecated options s p_usage;
+			module_warning dctx.com dctx.curmod WDeprecated options s p_usage;
 		end
 	end
 
@@ -103,7 +105,7 @@ let run com =
 	let dctx = create_context com in
 	List.iter (fun t -> match t with
 		| TClassDecl c when not (Meta.has Meta.Deprecated c.cl_meta) ->
-			let dctx = {dctx with class_meta = c.cl_meta} in
+			let dctx = {dctx with class_meta = c.cl_meta; curmod = c.cl_module} in
 			(match c.cl_constructor with None -> () | Some cf -> run_on_field dctx cf);
 			(match c.cl_init with None -> () | Some e -> run_on_expr dctx e);
 			List.iter (run_on_field dctx) c.cl_ordered_statics;
@@ -112,11 +114,12 @@ let run com =
 			()
 	) com.types
 
-let check_is com cl_meta cf_meta name meta p =
+let check_is com m cl_meta cf_meta name meta p =
 	let dctx = {
 		com = com;
 		class_meta = cl_meta;
 		field_meta = cf_meta;
+		curmod = m;
 	} in
 	if is_next dctx.com && name = "is" && not (Meta.has Meta.Deprecated meta) then
 		warn_deprecation dctx "Using \"is\" as an identifier is deprecated" p

src/context/typecore.ml

@@ -241,7 +241,11 @@ let pass_name = function
 
 let warning ?(depth=0) ctx w msg p =
 	let options = (Warning.from_meta ctx.curclass.cl_meta) @ (Warning.from_meta ctx.curfield.cf_meta) in
-	ctx.com.warning ~depth w options msg p
+	match Warning.get_mode w options with
+	| WMEnable ->
+		module_warning ctx.com ctx.m.curmod w options msg p
+	| WMDisable ->
+		()
 
 let make_call ctx e el t p = (!make_call_ref) ctx e el t p
 
@@ -751,6 +755,7 @@ let create_deprecation_context ctx = {
 	(DeprecationCheck.create_context ctx.com) with
 	class_meta = ctx.curclass.cl_meta;
 	field_meta = ctx.curfield.cf_meta;
+	curmod = ctx.m.curmod;
 }
 
 (* -------------- debug functions to activate when debugging typer passes ------------------------------- *)

src/core/tFunctions.ml

@@ -166,7 +166,7 @@ let module_extra file sign time kind policy =
 		m_processed = 0;
 		m_deps = PMap.empty;
 		m_kind = kind;
-		m_cache_bound_objects = [];
+		m_cache_bound_objects = DynArray.create ();
 		m_if_feature = [];
 		m_features = Hashtbl.create 0;
 		m_check_policy = policy;
@@ -203,7 +203,7 @@ let null_module = {
 	m_path = [] , "";
 	m_types = [];
 	m_statics = None;
-	m_extra = module_extra "" "" 0. MFake [];
+	m_extra = module_extra "" (Digest.string "") 0. MFake 0 [];
 }
 
 let null_class =

src/core/tType.ml

@@ -60,6 +60,7 @@ type type_param_host =
 type cache_bound_object =
 	| Resource of string * string
 	| IncludeFile of string * string
+	| Warning of WarningList.warning * string * pos
 
 type t =
 	| TMono of tmono
@@ -402,7 +403,7 @@ and module_def_display = {
 
 and module_def_extra = {
 	m_file : Path.UniqueKey.lazy_t;
-	m_sign : string;
+	m_sign : Digest.t;
 	m_display : module_def_display;
 	mutable m_check_policy : module_check_policy list;
 	mutable m_time : float;
@@ -410,9 +411,9 @@ and module_def_extra = {
 	mutable m_added : int;
 	mutable m_checked : int;
 	mutable m_processed : int;
-	mutable m_deps : (int,(string (* sign *) * path)) PMap.t;
+	mutable m_deps : (int,(Digest.t (* sign *) * path)) PMap.t;
 	mutable m_kind : module_kind;
-	mutable m_cache_bound_objects : cache_bound_object list;
+	mutable m_cache_bound_objects : cache_bound_object DynArray.t;
 	mutable m_if_feature : (string * class_field_ref) list;
 	mutable m_features : (string,bool) Hashtbl.t;
 }

src/macro/macroApi.ml

@@ -2088,7 +2088,7 @@ let macro_api ccom get_api =
 			if name = "" then failwith "Empty resource name";
 			Hashtbl.replace (ccom()).resources name data;
 			let m = (get_api()).current_module() in
-			m.m_extra.m_cache_bound_objects <- (Resource(name,data)) :: m.m_extra.m_cache_bound_objects;
+			DynArray.add m.m_extra.m_cache_bound_objects (Resource(name,data));
 			vnull
 		);
 		"get_resources", vfun0 (fun() ->
@@ -2302,7 +2302,7 @@ let macro_api ccom get_api =
 			in
 			(ccom()).include_files <- (file, position) :: (ccom()).include_files;
 			let m = (get_api()).current_module() in
-			m.m_extra.m_cache_bound_objects <- (IncludeFile(file,position)) :: m.m_extra.m_cache_bound_objects;
+			DynArray.add m.m_extra.m_cache_bound_objects (IncludeFile(file,position));
 			vnull
 		);
 		(* Compilation server *)

src/typing/finalization.ml

@@ -112,7 +112,7 @@ let sort_types com (modules : module_lut) =
 		match state p with
 		| Done -> ()
 		| Generating ->
-			com.warning WStaticInitOrder [] ("Warning : maybe loop in static generation of " ^ s_type_path p) (t_infos t).mt_pos;
+			module_warning com (t_infos t).mt_module WStaticInitOrder [] ("Warning : maybe loop in static generation of " ^ s_type_path p) (t_infos t).mt_pos;
 		| NotYet ->
 			Hashtbl.add states p Generating;
 			let t = (match t with

src/typing/typeloadFields.ml

@@ -638,7 +638,7 @@ let create_field_context ctx cctx cff is_display_file display_modifier =
 	fctx
 
 let create_typer_context_for_field ctx cctx fctx cff =
-	DeprecationCheck.check_is ctx.com ctx.curclass.cl_meta cff.cff_meta (fst cff.cff_name) cff.cff_meta (snd cff.cff_name);
+	DeprecationCheck.check_is ctx.com ctx.m.curmod ctx.curclass.cl_meta cff.cff_meta (fst cff.cff_name) cff.cff_meta (snd cff.cff_name);
 	let ctx = {
 		ctx with
 		pass = PBuildClass; (* will be set later to PTypeExpr *)

src/typing/typeloadModule.ml

@@ -65,7 +65,7 @@ module ModuleLevel = struct
 		let decls = ref [] in
 		let statics = ref [] in
 		let check_name name meta also_statics p =
-			DeprecationCheck.check_is com meta [] name meta p;
+			DeprecationCheck.check_is com ctx.m.curmod meta [] name meta p;
 			let error prev_pos =
 				display_error ctx.com ("Name " ^ name ^ " is already defined in this module") p;
 				raise_typing_error ~depth:1 (compl_msg "Previous declaration here") prev_pos;
@@ -195,7 +195,7 @@ module ModuleLevel = struct
 					| None -> ()
 					| Some p ->
 						let options = Warning.from_meta d.d_meta in
-						ctx.com.warning WDeprecatedEnumAbstract options "`@:enum abstract` is deprecated in favor of `enum abstract`" p
+						module_warning ctx.com ctx.m.curmod WDeprecatedEnumAbstract options "`@:enum abstract` is deprecated in favor of `enum abstract`" p
 				end;
 				decls := (TAbstractDecl a, decl) :: !decls;
 				match d.d_data with
@@ -378,7 +378,7 @@ module TypeLevel = struct
 			ef_params = params;
 			ef_meta = c.ec_meta;
 		} in
-		DeprecationCheck.check_is ctx.com e.e_meta f.ef_meta f.ef_name f.ef_meta f.ef_name_pos;
+		DeprecationCheck.check_is ctx.com ctx.m.curmod e.e_meta f.ef_meta f.ef_name f.ef_meta f.ef_name_pos;
 		let cf = class_field_of_enum_field f in
 		if ctx.is_display_file && DisplayPosition.display_position#enclosed_in f.ef_name_pos then
 			DisplayEmitter.display_enum_field ctx e f p;

src/typing/typer.ml

@@ -707,7 +707,7 @@ and type_vars ctx vl p =
 	let vl = List.map (fun ev ->
 		let n = fst ev.ev_name
 		and pv = snd ev.ev_name in
-		DeprecationCheck.check_is ctx.com ctx.curclass.cl_meta ctx.curfield.cf_meta n ev.ev_meta pv;
+		DeprecationCheck.check_is ctx.com ctx.m.curmod ctx.curclass.cl_meta ctx.curfield.cf_meta n ev.ev_meta pv;
 		try
 			let t = Typeload.load_type_hint ctx p ev.ev_type in
 			let e = (match ev.ev_expr with