[hxb] Add actual positions to unbound type parameter warnings (#12281)

* Add actual positions to unbound type parameter warnings

* Catch unbound ttp effects in write_module

(avoids unhandled effect issues for cases I missed)

* Only report each (msg,p) warning once

* Handle unbound type warning positions for abstract this/from/to and typedef

Other instances should be fine, and would be caught by already handled cases or write_module itself

src/compiler/hxb/hxbWriter.ml

@@ -1,9 +1,14 @@
+open Effect
+open Effect.Deep
 open Globals
 open Ast
 open Type
 open HxbData
 open Tanon_identification
 
+type _ Effect.t += UnboundTTP : (string * Globals.pos) Effect.t
+type _ Effect.t += UnboundTTPWithoutPosition : (Globals.pos) Effect.t
+
 let rec binop_index op = match op with
 	| OpAdd -> 0
 	| OpMult -> 1
@@ -425,7 +430,7 @@ type hxb_writer = {
 	mutable field_stack : unit list;
 	mutable wrote_local_type_param : bool;
 	mutable needs_local_context : bool;
-	unbound_ttp : (typed_type_param,unit) IdentityPool.t;
+	unbound_ttp : (string * pos, bool) Hashtbl.t;
 	unclosed_mono : (tmono,unit) IdentityPool.t;
 	t_instance_chunk : Chunk.t;
 }
@@ -1084,17 +1089,35 @@ module HxbWriter = struct
 			| TPHUnbound ->
 				raise Not_found
 		end with Not_found ->
-			(try ignore(IdentityPool.get writer.unbound_ttp ttp) with Not_found -> begin
-				ignore(IdentityPool.add writer.unbound_ttp ttp ());
-				let p = file_pos (Path.UniqueKey.lazy_path writer.current_module.m_extra.m_file) in
-				let msg = Printf.sprintf "Unbound type parameter %s" (s_type_path ttp.ttp_class.cl_path) in
-				writer.warn WUnboundTypeParameter msg p
-			end);
+			let (source, p) = perform UnboundTTP in
+			let msg = Printf.sprintf "Unbound type parameter %s while writing %s" (s_type_path ttp.ttp_class.cl_path) source in
+			if not (Hashtbl.mem writer.unbound_ttp (msg, p)) then begin
+				Hashtbl.add writer.unbound_ttp (msg, p) true;
+				writer.warn WUnboundTypeParameter msg p;
+			end;
 			writer.wrote_local_type_param <- true;
 			Chunk.write_u8 writer.chunk 5;
 			write_path writer ttp.ttp_class.cl_path;
 		end
 
+	and catch_unbound_ttp f (source:string) (p:Globals.pos option) =
+		try_with f () {
+			effc = (fun (type c) (eff : c Effect.t) ->
+				match eff with
+				| UnboundTTP ->
+						Some (fun (k:(c,_) continuation) ->
+							match p with
+							| Some p -> continue k (source,p)
+							| None ->
+									let p = perform UnboundTTPWithoutPosition in
+									continue k (source,p)
+						)
+				| UnboundTTPWithoutPosition when Option.is_some p ->
+						Some (fun (k:(c,_) continuation) -> continue k (Option.get p))
+				| _ -> None
+			)
+		}
+
 	(*
 		simple references:
 			0 - mono
@@ -1165,7 +1188,7 @@ module HxbWriter = struct
 		let write_function_arg (n,o,t) =
 			Chunk.write_string writer.chunk n;
 			Chunk.write_bool writer.chunk o;
-			write_type_instance writer t;
+			catch_unbound_ttp (fun () -> write_type_instance writer t) (Printf.sprintf "function arg `%s`" n) None
 		in
 		let write_inlined_list offset max f_first f_elt l =
 			write_inlined_list writer offset max (Chunk.write_u8 writer.chunk) f_first f_elt l
@@ -1305,12 +1328,12 @@ module HxbWriter = struct
 					let index = IdentityPool.add writer.local_type_parameters ttp () in
 					Chunk.write_uleb128 writer.chunk index
 				);
-				Chunk.write_option writer.chunk ve.v_expr (write_texpr writer fctx);
+				catch_unbound_ttp (fun () -> Chunk.write_option writer.chunk ve.v_expr (write_texpr writer fctx)) "var expression" (Some v.v_pos)
 			);
-			write_type_instance writer v.v_type;
+			catch_unbound_ttp (fun () -> write_type_instance writer v.v_type) "var type" (Some v.v_pos)
 		in
-		let rec loop e =
-			let write_type = match e.eexpr with
+		let rec loop e' =
+			let write_type = match e'.eexpr with
 			(* values 0-19 *)
 			| TConst ct ->
 				begin match ct with
@@ -1318,27 +1341,27 @@ module HxbWriter = struct
 					Chunk.write_u8 writer.chunk 0;
 					true
 				| TThis ->
-					fctx.texpr_this <- Some e;
+					fctx.texpr_this <- Some e';
 					Chunk.write_u8 writer.chunk 1;
 					false;
 				| TSuper ->
 					Chunk.write_u8 writer.chunk 2;
 					true;
-				| TBool false when (ExtType.is_bool (follow_lazy_and_mono e.etype)) ->
+				| TBool false when (ExtType.is_bool (follow_lazy_and_mono e'.etype)) ->
 					Chunk.write_u8 writer.chunk 3;
 					false;
-				| TBool true when (ExtType.is_bool (follow_lazy_and_mono e.etype)) ->
+				| TBool true when (ExtType.is_bool (follow_lazy_and_mono e'.etype)) ->
 					Chunk.write_u8 writer.chunk 4;
 					false;
-				| TInt i32 when (ExtType.is_int (follow_lazy_and_mono e.etype)) ->
+				| TInt i32 when (ExtType.is_int (follow_lazy_and_mono e'.etype)) ->
 					Chunk.write_u8 writer.chunk 5;
 					Chunk.write_i32 writer.chunk i32;
 					false;
-				| TFloat f when (ExtType.is_float (follow_lazy_and_mono e.etype)) ->
+				| TFloat f when (ExtType.is_float (follow_lazy_and_mono e'.etype)) ->
 					Chunk.write_u8 writer.chunk 6;
 					Chunk.write_string writer.chunk f;
 					false;
-				| TString s when (ExtType.is_string (follow_lazy_and_mono e.etype)) ->
+				| TString s when (ExtType.is_string (follow_lazy_and_mono e'.etype)) ->
 					Chunk.write_u8 writer.chunk 7;
 					Chunk.write_string writer.chunk s;
 					false
@@ -1412,7 +1435,8 @@ module HxbWriter = struct
 					declare_var v;
 					Chunk.write_option writer.chunk eo loop;
 				);
-				write_type_instance writer tf.tf_type;
+				if e == e' then write_type_instance writer tf.tf_type
+				else catch_unbound_ttp (fun () -> write_type_instance writer tf.tf_type) "TFunction" (Some e'.epos);
 				loop tf.tf_expr;
 				true;
 			(* texpr compounds 60-79 *)
@@ -1637,8 +1661,10 @@ module HxbWriter = struct
 				true;
 			in
 			if write_type then
-				write_texpr_type_instance writer fctx e.etype;
-			PosWriter.write_pos fctx.pos_writer writer.chunk true 0 e.epos;
+				(* Unbound TTP in top level expr type will be caught be calling site with a better position *)
+				if e == e' then write_texpr_type_instance writer fctx e.etype
+				else catch_unbound_ttp (fun () -> write_texpr_type_instance writer fctx e'.etype) "texpr type" (Some e'.epos);
+			PosWriter.write_pos fctx.pos_writer writer.chunk true 0 e'.epos;
 
 		and loop_el el =
 			Chunk.write_list writer.chunk el loop
@@ -1754,7 +1780,9 @@ module HxbWriter = struct
 					let ltp = List.map fst (IdentityPool.to_list writer.local_type_parameters) in
 					write_type_parameters writer ltp
 				end;
-				Chunk.write_option writer.chunk fctx.texpr_this (fun e -> write_type_instance writer e.etype);
+				Chunk.write_option writer.chunk fctx.texpr_this (fun e ->
+					catch_unbound_ttp (fun () -> write_type_instance writer e.etype) "`this` type" (Some e.epos);
+				);
 				let a = StringPool.finalize fctx.t_pool in
 				Chunk.write_uleb128 writer.chunk a.length;
 				StringDynArray.iter a (fun bytes ->
@@ -1782,7 +1810,7 @@ module HxbWriter = struct
 
 	and write_class_field_data writer (write_expr_immediately : bool) (cf : tclass_field) =
 		let restore = start_temporary_chunk writer 512 in
-		write_type_instance writer cf.cf_type;
+		catch_unbound_ttp (fun () -> write_type_instance writer cf.cf_type) "field type" (Some cf.cf_pos);
 		Chunk.write_uleb128 writer.chunk cf.cf_flags;
 		maybe_write_documentation writer cf.cf_doc;
 		write_field_kind writer cf.cf_kind;
@@ -1793,15 +1821,15 @@ module HxbWriter = struct
 			| Some e when not write_expr_immediately ->
 				Chunk.write_u8 writer.chunk 2;
 				let fctx,close = start_texpr writer e.epos in
-				write_texpr writer fctx e;
-				Chunk.write_option writer.chunk cf.cf_expr_unoptimized (write_texpr writer fctx);
+				catch_unbound_ttp (fun () -> write_texpr writer fctx e) "field expression" (Some cf.cf_pos);
+				catch_unbound_ttp (fun () -> Chunk.write_option writer.chunk cf.cf_expr_unoptimized (write_texpr writer fctx)) "field unoptimized expression" (Some cf.cf_pos);
 				let expr_chunk = close() in
 				Some expr_chunk
 			| Some e ->
 				Chunk.write_u8 writer.chunk 1;
 				let fctx,close = start_texpr writer e.epos in
-				write_texpr writer fctx e;
-				Chunk.write_option writer.chunk cf.cf_expr_unoptimized (write_texpr writer fctx);
+				catch_unbound_ttp (fun () -> write_texpr writer fctx e) "field expression" (Some cf.cf_pos);
+				catch_unbound_ttp (fun () -> Chunk.write_option writer.chunk cf.cf_expr_unoptimized (write_texpr writer fctx)) "field unoptimized expression" (Some cf.cf_pos);
 				let expr_pre_chunk,expr_chunk = close() in
 				Chunk.export_data expr_pre_chunk writer.chunk;
 				Chunk.export_data expr_chunk writer.chunk;
@@ -1895,10 +1923,18 @@ module HxbWriter = struct
 			Chunk.write_u8 writer.chunk 0
 		else begin
 			Chunk.write_u8 writer.chunk 1;
-			write_type_instance writer a.a_this;
+			catch_unbound_ttp (fun () ->
+				write_type_instance writer a.a_this
+			) (Printf.sprintf "underlying type for abstract `%s`" (s_type_path a.a_path)) (Some a.a_pos);
 		end;
-		Chunk.write_list writer.chunk a.a_from (write_type_instance writer);
-		Chunk.write_list writer.chunk a.a_to (write_type_instance writer);
+		let write_from_to source t =
+			let t_path = try s_type_path (t_infos (module_type_of_type t)).mt_path with Exit -> let a = ref [] in s_type a t in
+			catch_unbound_ttp (fun () ->
+				write_type_instance writer t
+			) (Printf.sprintf "`%s` type `%s` for abstract `%s`" source t_path (s_type_path a.a_path)) (Some a.a_pos);
+		in
+		Chunk.write_list writer.chunk a.a_from (write_from_to "from");
+		Chunk.write_list writer.chunk a.a_to (write_from_to "to");
 		Chunk.write_bool writer.chunk a.a_extern;
 		Chunk.write_bool writer.chunk a.a_enum
 
@@ -1943,7 +1979,9 @@ module HxbWriter = struct
 	let write_typedef writer (td : tdef) =
 		select_type writer td.t_path;
 		write_common_module_type writer (Obj.magic td);
-		write_type_instance writer td.t_type
+		catch_unbound_ttp (fun () ->
+			write_type_instance writer td.t_type
+		) (Printf.sprintf "typedef `%s`" (s_type_path td.t_path)) (Some td.t_pos)
 
 	(* Module *)
 
@@ -2101,7 +2139,7 @@ module HxbWriter = struct
 					let close = open_field_scope writer ef.ef_params in
 					Chunk.write_string writer.chunk s;
 					let restore = start_temporary_chunk writer 32 in
-					write_type_instance writer ef.ef_type;
+					catch_unbound_ttp (fun () -> write_type_instance writer ef.ef_type) "enum field type" (Some ef.ef_pos);
 					let t_bytes = restore (fun new_chunk -> Chunk.get_bytes new_chunk) in
 					commit_field_type_parameters writer ef.ef_params;
 					Chunk.write_bytes writer.chunk t_bytes;
@@ -2302,13 +2340,24 @@ let create config warn anon_id =
 		field_stack = [];
 		wrote_local_type_param = false;
 		needs_local_context = false;
-		unbound_ttp = IdentityPool.create ();
+		unbound_ttp = Hashtbl.create 0;
 		unclosed_mono = IdentityPool.create ();
 		t_instance_chunk = Chunk.create EOM cp 32;
 	}
 
 let write_module writer m =
-	HxbWriter.write_module writer m
+	try_with (fun () -> HxbWriter.write_module writer m) () {
+		effc = (fun (type c) (eff : c Effect.t) ->
+			match eff with
+			| UnboundTTP ->
+				let p = file_pos (Path.UniqueKey.lazy_path writer.current_module.m_extra.m_file) in
+				Some (fun (k:(c,_) continuation) -> continue k ("module " ^ (s_type_path m.m_path), p))
+			| UnboundTTPWithoutPosition ->
+				let p = file_pos (Path.UniqueKey.lazy_path writer.current_module.m_extra.m_file) in
+				Some (fun (k:(c,_) continuation) -> continue k p)
+			| _ -> None
+		)
+	}
 
 let get_chunks writer =
 	List.map (fun chunk ->