Browse Source

Reduce the amount of modules that depend on version.ml. (#12007)

* Reduce the amount of modules that depend on version.ml.

* Better match old behavior for safe_compile.
Zeta 6 months ago
parent
commit
18105b5bd3

+ 2 - 2
src/compiler/args.ml

@@ -43,7 +43,7 @@ let process_args arg_spec =
 let parse_args com =
 	let usage = Printf.sprintf
 		"Haxe Compiler %s - (C)2005-2024 Haxe Foundation\nUsage: haxe%s <target> [options] [hxml files and dot paths...]\n"
-		s_version_full (if Sys.os_type = "Win32" then ".exe" else "")
+		(s_version_full com.version) (if Sys.os_type = "Win32" then ".exe" else "")
 	in
 	let actx = {
 		classes = [([],"Std")];
@@ -154,7 +154,7 @@ let parse_args com =
 			com.debug <- true;
 		),"","add debug information to the compiled code");
 		("Miscellaneous",["--version"],["-version"],Arg.Unit (fun() ->
-			raise (Helper.HelpMessage s_version_full);
+			raise (Helper.HelpMessage (s_version_full com.version));
 		),"","print version and exit");
 		("Miscellaneous", ["-h";"--help"], ["-help"], Arg.Unit (fun () ->
 			raise (Arg.Help "")

+ 19 - 2
src/compiler/compiler.ml

@@ -230,7 +230,7 @@ module Setup = struct
 	let setup_common_context ctx =
 		let com = ctx.com in
 		ctx.com.print <- ctx.comm.write_out;
-		Common.define_value com Define.HaxeVer (Printf.sprintf "%.3f" (float_of_int Globals.version /. 1000.));
+		Common.define_value com Define.HaxeVer (Printf.sprintf "%.3f" (float_of_int version /. 1000.));
 		Common.raw_define com "haxe3";
 		Common.raw_define com "haxe4";
 		Common.raw_define com "haxe5";
@@ -419,6 +419,10 @@ let compile ctx actx callbacks =
 		) (List.rev actx.cmds)
 	end
 
+let make_ice_message com msg backtrace = 
+		let ver = (s_version_full com.version) in
+		let os_type = if Sys.unix then "unix" else "windows" in
+		Printf.sprintf "%s\nHaxe: %s; OS type: %s;\n%s" msg ver os_type backtrace
 let compile_safe ctx f =
 	let com = ctx.com in
 try
@@ -446,6 +450,12 @@ with
 		handle_diagnostics ctx msg null_pos DKCompilerMessage;
 	| Failure msg when not Helper.is_debug_run ->
 		error ctx ("Error: " ^ msg) null_pos
+	| Globals.Ice (msg,backtrace) when is_diagnostics com ->
+		let s = make_ice_message com msg backtrace in
+		handle_diagnostics ctx s null_pos DKCompilerMessage 
+	| Globals.Ice (msg,backtrace) when not Helper.is_debug_run ->
+		let s = make_ice_message com msg backtrace in
+		error ctx ("Error: " ^ s) null_pos
 	| Helper.HelpMessage msg ->
 		print_endline msg
 	| Parser.TypePath (p,c,is_import,pos) ->
@@ -517,7 +527,14 @@ let compile_ctx callbacks ctx =
 		catch_completion_and_exit ctx callbacks run
 
 let create_context comm cs compilation_step params = {
-	com = Common.create compilation_step cs version params (DisplayTypes.DisplayMode.create !Parser.display_mode);
+	com = Common.create compilation_step cs {
+		version = version;
+		major = version_major;
+		minor = version_minor;
+		revision = version_revision;
+		pre = version_pre;
+		extra = Version.version_extra;
+	} params (DisplayTypes.DisplayMode.create !Parser.display_mode);
 	messages = [];
 	has_next = false;
 	has_error = false;

+ 1 - 2
src/compiler/hxb/hxbReader.ml

@@ -2079,8 +2079,7 @@ class hxb_reader
 			^ "Attach the following information:"
 		in
 		let backtrace = Printexc.raw_backtrace_to_string backtrace in
-		let s = Printf.sprintf "%s\nHaxe: %s\n%s" msg s_version_full backtrace in
-		failwith s
+		raise (Globals.Ice (msg, backtrace))
 
 	method private read_chunk_data kind =
 		let path = String.concat "_" (ExtLib.String.nsplit (s_type_path mpath) ".") in

+ 1 - 2
src/compiler/hxb/hxbWriter.ml

@@ -452,8 +452,7 @@ module HxbWriter = struct
 			^ "Attach the following information:"
 		in
 		let backtrace = Printexc.raw_backtrace_to_string backtrace in
-		let s = Printf.sprintf "%s\nHaxe: %s\n%s" msg s_version_full backtrace in
-		failwith s
+		raise (Globals.Ice (msg, backtrace))
 
 	let in_nested_scope writer = match writer.field_stack with
 		| [] -> false (* can happen for cl_init and in EXD *)

+ 2 - 2
src/context/common.ml

@@ -356,7 +356,7 @@ type context = {
 	is_macro_context : bool;
 	mutable json_out : json_api option;
 	(* config *)
-	version : int;
+	version : compiler_version;
 	mutable args : string list;
 	mutable display : DisplayTypes.DisplayMode.settings;
 	mutable debug : bool;
@@ -968,7 +968,7 @@ let init_platform com =
 	end;
 	(* Set the source header, unless the user has set one already or the platform sets a custom one *)
 	if not (defined com Define.SourceHeader) && (com.platform <> Hl) then
-		define_value com Define.SourceHeader ("Generated by Haxe " ^ s_version_full);
+		define_value com Define.SourceHeader ("Generated by Haxe " ^ (s_version_full com.version));
 	let forbid acc p = if p = name || PMap.mem p acc then acc else PMap.add p Forbidden acc in
 	com.package_rules <- List.fold_left forbid com.package_rules ("java" :: (List.map platform_name platforms));
 	update_platform_config com;

+ 5 - 5
src/context/display/displayJson.ml

@@ -179,11 +179,11 @@ let handler =
 			hctx.send_result (JObject [
 				"methods",jarray methods;
 				"haxeVersion",jobject [
-					"major",jint version_major;
-					"minor",jint version_minor;
-					"patch",jint version_revision;
-					"pre",(match version_pre with None -> jnull | Some pre -> jstring pre);
-					"build",(match Version.version_extra with None -> jnull | Some(_,build) -> jstring build);
+					"major",jint hctx.com.version.major;
+					"minor",jint hctx.com.version.minor;
+					"patch",jint hctx.com.version.revision;
+					"pre",(match hctx.com.version.pre with None -> jnull | Some pre -> jstring pre);
+					"build",(match hctx.com.version.extra with None -> jnull | Some(_,build) -> jstring build);
 				];
 				"protocolVersion",jobject [
 					"major",jint 0;

+ 16 - 6
src/core/globals.ml

@@ -24,6 +24,15 @@ type platform =
 	| Eval
 	| CustomTarget of string
 
+type compiler_version = {
+	version: int;
+	major: int;
+	minor: int;
+	revision: int;
+	pre: string option;
+	extra: (string * string) option;
+}
+
 let version = 5000
 let version_major = version / 1000
 let version_minor = (version mod 1000) / 100
@@ -135,14 +144,17 @@ let s_version =
 	let pre = Option.map_default (fun pre -> "-" ^ pre) "" version_pre in
 	Printf.sprintf "%d.%d.%d%s" version_major version_minor version_revision pre
 
-let s_version_full =
-	match Version.version_extra with
+let s_version_full v =
+	match v.extra with
 		| Some (_,build) -> s_version ^ "+" ^ build
 		| _ -> s_version
 
 
 let patch_string_pos p s = { p with pmin = p.pmax - String.length s }
 
+(* msg * backtrace *)
+exception Ice of string * string
+
 (**
 	Terminates compiler process and prints user-friendly instructions about filing an issue.
 	Usage: `die message __LOC__`, where `__LOC__` is a built-in ocaml constant
@@ -163,10 +175,8 @@ let die ?p msg ml_loc =
 		try snd (ExtString.String.split backtrace "\n")
 		with ExtString.Invalid_string -> backtrace
 	in
-	let ver = s_version_full
-	and os_type = if Sys.unix then "unix" else "windows" in
-	let s = Printf.sprintf "%s\nHaxe: %s; OS type: %s;\n%s\n%s" msg ver os_type ml_loc backtrace in
-	failwith s
+	let backtrace = ml_loc ^ "\n" ^ backtrace in
+	raise (Ice (msg,backtrace))
 
 let dump_callstack () =
 	print_endline (Printexc.raw_backtrace_to_string (Printexc.get_callstack 200))

+ 1 - 1
src/generators/gctx.ml

@@ -22,7 +22,7 @@ type t = {
 	basic : basic_types;
 	debug : bool;
 	file : string;
-	version : int;
+	version : compiler_version;
 	features : (string,bool) Hashtbl.t;
 	modules : Type.module_def list;
 	main : context_main;

+ 3 - 3
src/generators/genhl.ml

@@ -4296,9 +4296,9 @@ let generate com =
 		let gnames = Array.make (Array.length code.globals) "" in
 		PMap.iter (fun n i -> gnames.(i) <- n) ctx.cglobals.map;
 		if not (Gctx.defined com Define.SourceHeader) then begin
-			let version_major = com.version / 1000 in
-			let version_minor = (com.version mod 1000) / 100 in
-			let version_revision = (com.version mod 100) in
+			let version_major = com.version.major in
+			let version_minor = com.version.minor in
+			let version_revision = com.version.revision in
 			Gctx.define_value com Define.SourceHeader (Printf.sprintf "Generated by HLC %d.%d.%d (HL v%d)" version_major version_minor version_revision code.version);
 		end;
 		Hl2c.write_c com com.file code gnames;

+ 1 - 1
src/generators/genswf.ml

@@ -207,7 +207,7 @@ let build_swc_catalog com types =
 	let x = node "swc" ["xmlns","http://www.adobe.com/flash/swccatalog/9"] [
 		node "versions" [] [
 			node "swc" ["version","1.2"] [];
-			node "haxe" ["version",Printf.sprintf "%d.%.2d" (com.version/10000) (com.version mod 10000)] [];
+			node "haxe" ["version",Printf.sprintf "%d.%.2d" (com.Gctx.version.version/10000) (com.version.version mod 10000)] [];
 		];
 		node "features" [] [
 			node "feature-script-deps" [] [];

+ 1 - 1
src/generators/hl2c.ml

@@ -1463,7 +1463,7 @@ let write_c com file (code:code) gnames =
 	let bnames = Array.map (fun b -> "bytes$" ^ short_digest (Digest.to_hex (Digest.bytes b))) code.bytes in
 
 	let ctx = {
-		version = com.Gctx.version;
+		version = com.Gctx.version.version;
 		out = Buffer.create 1024;
 		tabs = "";
 		hlcode = code;

+ 1 - 1
src/macro/macroApi.ml

@@ -2238,7 +2238,7 @@ let macro_api ccom get_api =
 		"get_configuration", vfun0 (fun() ->
 			let com = ccom() in
 			encode_obj [
-				"version", vint com.version;
+				"version", vint com.version.version;
 				"args", encode_array (List.map encode_string com.args);
 				"debug", vbool com.debug;
 				"verbose", vbool com.verbose;