Replace ad-hoc Cancelled re-raises with specific exception catches; merge development

Co-authored-by: Simn <634365+Simn@users.noreply.github.com>

Author: Copilot

src/compiler/displayOutput.ml

@@ -53,20 +53,10 @@ let handle_syntax_completion com kind subj =
 
 let handle_display_exception_json com dex rh =
 	match dex with
-	| DisplayHover _ | DisplayPositions _ | DisplayFields _ | DisplayPackage _  | DisplaySignatures _ ->
+	| DisplayHover _ | DisplayFields _ ->
 		DisplayPosition.display_position#reset;
 		let ctx = DisplayJson.create_json_context (match dex with DisplayFields _ -> true | _ -> false) in
 		CompilerOutput.send_result_raise rh (DisplayException.to_json ctx dex)
-	| DisplayNoResult ->
-		(match com.display.dms_kind with
-			| DMDefault -> CompilerOutput.send_error_raise rh [jstring "No completion point"]
-			| _ -> CompilerOutput.send_result_raise rh JNull
-		)
-	| ModuleSymbols json ->
-		DisplayPosition.display_position#reset;
-		CompilerOutput.send_result_raise rh json
-	| Metadata _ ->
-		die "Unexpected Metadata display exception" __LOC__
 
 let handle_display_exception com dex =
 	handle_display_exception_json com dex com.request_scope.result_handler

src/compiler/displayProcessing.ml

@@ -76,7 +76,7 @@ let process_display_file com actx =
 				let real = Path.get_real_path (Path.UniqueKey.to_string file_key) in
 				let dpk = match get_module_path_from_file_path com real with
 				| Some path ->
-					if com.display.dms_kind = DMPackage then DisplayException.raise_package (fst path);
+					if com.display.dms_kind = DMPackage then DisplayException.send_package_raise com (fst path);
 					let dpk = match ExtString.String.nsplit (snd path) "." with
 						| [name;"macro"] ->
 							(* If we have a .macro.hx path, don't add the file to classes because the compiler won't find it.
@@ -135,9 +135,8 @@ let load_display_module_in_macro tctx display_file_dot_path clear = match displa
 			let _ = MacroContext.load_macro_module (MacroContext.get_macro_context tctx) tctx.com cpath true p in
 			Finalization.finalize mctx;
 			Some mctx
-		with DisplayException.DisplayException _ | Parser.TypePath _ | Globals.Cancelled | DisplayJson.JsonCompleted as exc ->
-			raise exc
-		| _ ->
+		with Error.Fatal_error _ | Error.Error _ | Failure _ | Not_found
+		| Lexer.Error _ | Parser.Error _ | Typecore.Forbid_package _ | Typecore.WithTypeError _ ->
 			None
 		end
 	| None ->
@@ -204,7 +203,7 @@ let handle_display_after_typing com tctx display_file_dot_path =
 		(* If we didn't find a completion point, load the display file in macro mode. *)
 		if com.part_scope.parser_state.display_module_has_macro_defines then
 			ignore(load_display_module_in_macro tctx display_file_dot_path true);
-		raise (DisplayException.DisplayException DisplayNoResult)
+		DisplayException.send_no_result_raise com
 		end
 	end else
 		false
@@ -248,7 +247,7 @@ let process_global_display_mode com tctx =
 					acc
 			) [] l
 		in
-		DisplayException.raise_module_symbols (DocumentSymbols.Printer.json_of_module_symbols com symbols filter)
+		DisplayException.send_module_symbols_raise com (DocumentSymbols.Printer.json_of_module_symbols com symbols filter)
 	| _ -> ()
 
 let handle_display_after_finalization com tctx display_file_dot_path =

src/context/commonCache.ml

@@ -15,8 +15,7 @@ class lib_build_task cs file ftime lib = object(self)
 				try begin match lib#build path p with
 				| Some r -> Hashtbl.add h path r
 				| None -> ()
-				end with Globals.Cancelled as e -> raise e
-				| _ ->
+				end with Error.Fatal_error _ | Error.Error _ | Failure _ | Not_found | Invalid_argument _ ->
 					()
 			end
 		) lib#list_modules;

src/context/display/display.ml

@@ -90,6 +90,5 @@ let get_import_status ctx path =
 	try
 		let mt' = ctx.g.do_load_type_def ctx null_pos (mk_type_path ([],snd path)) in
 		if path <> (t_infos mt').mt_path then Shadowed else Imported
-	with Globals.Cancelled as e -> raise e
-	| _ ->
+	with Not_found | Error.Fatal_error _ | Error.Error _ | Failure _ ->
 		Unimported

src/context/display/displayEmitter.ml

@@ -20,7 +20,7 @@ let symbol_of_module_type = function
 
 let display_alias ctx name t p = match ctx.com.display.dms_kind with
 	| DMDefinition | DMTypeDefinition ->
-		raise_positions [p];
+		DisplayException.send_positions_raise ctx.com [p];
 	| DMUsage _ | DMImplementation ->
 		ReferencePosition.set (name,p,SKOther)
 	| DMHover ->
@@ -34,9 +34,9 @@ let display_module_type ctx mt p = match ctx.com.display.dms_kind with
 		begin match mt with
 		| TClassDecl c when Meta.has Meta.CoreApi c.cl_meta ->
 			let c' = ctx.g.do_load_core_class ctx c in
-			raise_positions [c.cl_name_pos;c'.cl_name_pos]
+			DisplayException.send_positions_raise ctx.com [c.cl_name_pos;c'.cl_name_pos]
 		| _ ->
-			raise_positions [(t_infos mt).mt_name_pos];
+			DisplayException.send_positions_raise ctx.com [(t_infos mt).mt_name_pos];
 		end
 	| DMUsage _ | DMImplementation ->
 		let infos = t_infos mt in
@@ -81,7 +81,7 @@ let raise_position_of_type ctx t =
 	let mt =
 		let rec follow_null t =
 			match t with
-				| TMono r -> (match r.tm_type with None -> raise_positions [null_pos] | Some t -> follow_null t)
+				| TMono r -> (match r.tm_type with None -> DisplayException.send_positions_raise ctx.com [null_pos] | Some t -> follow_null t)
 				| TLazy f -> follow_null (lazy_type f)
 				| TAbstract({a_path = [],"Null"},[t]) -> follow_null t
 				| TDynamic _ -> ctx.g.t_dynamic_def
@@ -90,12 +90,12 @@ let raise_position_of_type ctx t =
 		try
 			Type.module_type_of_type (follow_null t)
 		with
-			Exit -> raise_positions [null_pos]
+			Exit -> DisplayException.send_positions_raise ctx.com [null_pos]
 	in
-	raise_positions [(t_infos mt).mt_name_pos]
+	DisplayException.send_positions_raise ctx.com [(t_infos mt).mt_name_pos]
 
 let display_variable ctx v p = match ctx.com.display.dms_kind with
-	| DMDefinition -> raise_positions [v.v_pos]
+	| DMDefinition -> DisplayException.send_positions_raise ctx.com [v.v_pos]
 	| DMTypeDefinition -> raise_position_of_type ctx v.v_type
 	| DMUsage _ -> ReferencePosition.set (v.v_name,v.v_pos,SKVariable v)
 	| DMHover ->
@@ -104,7 +104,7 @@ let display_variable ctx v p = match ctx.com.display.dms_kind with
 	| _ -> ()
 
 let display_field ctx origin scope cf p = match ctx.com.display.dms_kind with
-	| DMDefinition -> raise_positions [cf.cf_name_pos]
+	| DMDefinition -> DisplayException.send_positions_raise ctx.com [cf.cf_name_pos]
 	| DMTypeDefinition -> raise_position_of_type ctx cf.cf_type
 	| DMUsage _ | DMImplementation ->
 		let name,kind = match cf.cf_name,origin with
@@ -135,7 +135,7 @@ let maybe_display_field ctx origin scope cf p =
 	if display_position#enclosed_in p then display_field ctx origin scope cf p
 
 let display_enum_field ctx en ef p = match ctx.com.display.dms_kind with
-	| DMDefinition -> raise_positions [ef.ef_name_pos]
+	| DMDefinition -> DisplayException.send_positions_raise ctx.com [ef.ef_name_pos]
 	| DMTypeDefinition -> raise_position_of_type ctx ef.ef_type
 	| DMUsage _ -> ReferencePosition.set (ef.ef_name,ef.ef_name_pos,SKEnumField ef)
 	| DMHover ->

src/context/display/displayException.ml

@@ -1,19 +1,15 @@
 open Globals
 open Ast
 open DisplayTypes
+open DisplayTypes.DisplayMode
 open CompletionItem
 open Type
 open Genjson
 
 exception DisplayException of display_exception_kind
 
-let raise_module_symbols s = raise (DisplayException(ModuleSymbols s))
-let raise_metadata s = raise (DisplayException(Metadata s))
-let raise_signatures l isig iarg kind = raise (DisplayException(DisplaySignatures((l,isig,iarg,kind))))
 let raise_hover item expected p = raise (DisplayException(DisplayHover({hitem = item;hpos = p;hexpected = expected})))
-let raise_positions pl = raise (DisplayException(DisplayPositions pl))
 let raise_fields ckl cr subj = raise (DisplayException(DisplayFields({fitems = ckl;fkind = cr;fsubject = subj})))
-let raise_package sl = raise (DisplayException(DisplayPackage sl))
 
 (* global state *)
 let last_completion_result = ref (Array.make 0 (CompletionItem.make (ITModule ([],"")) None))
@@ -160,26 +156,6 @@ let arg_index signatures signature_index param_index =
 
 let to_json ctx de =
 	match de with
-	| ModuleSymbols _
-	| Metadata _ -> die "" __LOC__
-	| DisplaySignatures(sigs,isig,iarg,kind) ->
-		(* We always want full info for signatures *)
-		let ctx = Genjson.create_context GMFull in
-		let fsig ((_,signature),doc) =
-			let fl = CompletionType.generate_function' ctx signature in
-			let fl = (match doc with None -> fl | Some d -> ("documentation",jstring (gen_doc_text d)) :: fl) in
-			jobject fl
-		in
-		let sigkind = match kind with
-			| SKCall -> 0
-			| SKArrayAccess -> 1
-		in
-		jobject [
-			"activeSignature",jint isig;
-			"activeParameter",jint (arg_index sigs isig iarg);
-			"signatures",jlist fsig sigs;
-			"kind",jint sigkind;
-		]
 	| DisplayHover hover ->
 		let named_source_kind = function
 			| WithType.FunctionArgument name -> (0, name)
@@ -218,11 +194,51 @@ let to_json ctx de =
 			"item",CompletionItem.to_json ctx None hover.hitem;
 			"expected",expected;
 		]
-	| DisplayPositions pl ->
-		jarray (List.map generate_pos_as_location pl)
 	| DisplayFields r ->
 		fields_to_json ctx r.fitems r.fkind r.fsubject
-	| DisplayPackage pack ->
-		jarray (List.map jstring pack)
-	| DisplayNoResult ->
-		jnull
+
+let send_json_result_raise (com:Common.context) json =
+	let rh = com.request_scope.result_handler in
+	CompilerOutput.send_result_raise rh json
+
+let send_module_symbols_raise com s =
+	DisplayPosition.display_position#reset;
+	send_json_result_raise com s
+
+let send_hover_raise com item expected p =
+	DisplayPosition.display_position#reset;
+	let ctx = Genjson.create_context GMFull in
+	send_json_result_raise com (to_json ctx (DisplayHover({hitem = item;hpos = p;hexpected = expected})))
+
+let send_signatures_raise com sigs isig iarg kind =
+	DisplayPosition.display_position#reset;
+	let ctx = Genjson.create_context GMFull in
+	let fsig ((_,signature),doc) =
+		let fl = CompletionType.generate_function' ctx signature in
+		let fl = (match doc with None -> fl | Some d -> ("documentation",jstring (gen_doc_text d)) :: fl) in
+		jobject fl
+	in
+	let sigkind = match kind with
+		| SKCall -> 0
+		| SKArrayAccess -> 1
+	in
+	send_json_result_raise com (jobject [
+		"activeSignature",jint isig;
+		"activeParameter",jint (arg_index sigs isig iarg);
+		"signatures",jlist fsig sigs;
+		"kind",jint sigkind;
+	])
+
+let send_positions_raise com pl =
+	DisplayPosition.display_position#reset;
+	send_json_result_raise com (jarray (List.map generate_pos_as_location pl))
+
+let send_package_raise com sl =
+	DisplayPosition.display_position#reset;
+	send_json_result_raise com (jarray (List.map jstring sl))
+
+let send_no_result_raise (com:Common.context) =
+	let rh = com.request_scope.result_handler in
+	match com.display.dms_kind with
+	| DMDefault -> CompilerOutput.send_error_raise rh [jstring "No completion point"]
+	| _ -> CompilerOutput.send_result_raise rh jnull

src/context/display/displayFields.ml

@@ -381,8 +381,7 @@ let handle_missing_field_raise ctx tthis i mode with_type pfield =
 					begin try
 						let e = type_expr ctx e WithType.value in
 						e.etype
-					with Globals.Cancelled as e -> raise e
-					| _ ->
+					with Error.Fatal_error _ | Error.Error _ | Typecore.Forbid_package _ | Failure _ ->
 						mk_mono()
 					end
 				| _ -> mk_mono()
@@ -394,8 +393,7 @@ let handle_missing_field_raise ctx tthis i mode with_type pfield =
 				begin try
 					let e = type_expr ctx e WithType.value in
 					e.etype
-				with Globals.Cancelled as e -> raise e
-				| _ ->
+				with Error.Fatal_error _ | Error.Error _ | Typecore.Forbid_package _ | Failure _ ->
 					raise Exit
 				end
 			| _ -> raise Exit
@@ -412,8 +410,7 @@ let handle_missing_field_raise ctx tthis i mode with_type pfield =
 					(name,false,e.etype)
 				) el in
 				(TFun(tl,tret),Method MethNormal)
-			with Globals.Cancelled as e -> raise e
-			| _ ->
+			with Error.Fatal_error _ | Error.Error _ | Typecore.Forbid_package _ | Failure _ ->
 				raise Exit
 			end
 		| MGet ->

src/context/display/displayPath.ml

@@ -155,16 +155,15 @@ module TypePathHandler = struct
 				) en.e_constrs fields
 			in
 			Some fields
-		with Globals.Cancelled | DisplayException.DisplayException _ | Parser.TypePath _ as e ->
-			raise e
-		| _ ->
+		with Error.Fatal_error _ | Error.Error _ | Failure _ | Not_found
+		| Lexer.Error _ | Parser.Error _ | Typecore.Forbid_package _ ->
 			Error.abort ("Could not load module " ^ (s_type_path (p,c))) null_pos
 end
 
 let resolve_position_by_path ctx path p =
 	let mt = ctx.g.do_load_type_def ctx p path in
 	let p = (t_infos mt).mt_pos in
-	raise_positions [p]
+	DisplayException.send_positions_raise ctx.com [p]
 
 let handle_path_display ctx path p =
 	let class_field c name =
@@ -192,7 +191,7 @@ let handle_path_display ctx path p =
 			   which might not even exist anyway. *)
 			let mt = ctx.g.do_load_module ctx (sl,s) p in
 			let p = file_pos (Path.UniqueKey.lazy_path mt.m_extra.m_file) in
-			raise_positions [p]
+			DisplayException.send_positions_raise ctx.com [p]
 		| (IDKModule(sl,s),_),DMHover ->
 			let m = ctx.g.do_load_module ctx (sl,s) p in
 			begin try

src/context/display/displayToplevel.ml

@@ -49,8 +49,7 @@ let maybe_resolve_macro_field ctx t c cf =
 		let (tl,tr,c,cf) = ctx.g.do_load_macro ctx false c.cl_path cf.cf_name null_pos in
 		let t = perform_type_voodoo t tl tr in
 		t,{cf with cf_type = t}
-	with Globals.Cancelled as e -> raise e
-	| _ ->
+	with Exit | Not_found | Error.Fatal_error _ | Error.Error _ | Failure _ ->
 		t,cf
 
 let exclude : string list ref = ref []
@@ -158,7 +157,7 @@ let init_or_update_server cs com timer_name =
 		try
 			ignore(cc#find_file file_key);
 		with Not_found ->
-			try ignore(TypeloadParse.parse_module_file com file_path null_pos) with Globals.Cancelled as e -> raise e | _ -> ()
+			try ignore(TypeloadParse.parse_module_file com file_path null_pos) with Lexer.Error _ | Parser.Error _ | Failure _ | Error.Error _ | Error.Fatal_error _ -> ()
 	) removed_files;
 	DynArray.iter (Hashtbl.remove removed_files) removed_removed_files
 

src/context/display/findReferences.ml

@@ -133,7 +133,7 @@ let find_references com with_definition =
 			if c <> 0 then c else compare p1.pmin p2.pmin
 		) usages
 	in
-	DisplayException.raise_positions usages
+	DisplayException.send_positions_raise com usages
 
 let find_implementations com name pos kind =
 	let symbols,relations = Timer.time com.timer_ctx ["display";"implementations";"collect"] (Statistics.collect_statistics com [SFPos pos]) false in
@@ -153,9 +153,9 @@ let find_implementations com name pos kind =
 		) usages
 	) () in
 	Display.ReferencePosition.reset();
-	DisplayException.raise_positions usages
+	DisplayException.send_positions_raise com usages
 
 let find_implementations com =
 	let name,pos,kind = Display.ReferencePosition.get () in
 	if pos <> null_pos then find_implementations com name pos kind
-	else DisplayException.raise_positions []
+	else DisplayException.send_positions_raise com []