2
0
Эх сурвалжийг харах

More work towards unified native libraries (#8645)

* [cli] add --native-lib and --native-lib-extern

closes #3469
see #7450
closes #8080

* two-pass native library handling

* don't write to stderr because that fucks up the comp server

* handle extern libs differently

Both Java and C# need access to all libs in java_libs/net_libs in order to implement their `lookup` functions.

* hold back on --native-lib CLI argument for now
Simon Krajewski 6 жил өмнө
parent
commit
a8a8d7e4a5

+ 4 - 3
src/codegen/dotnet.ml

@@ -496,7 +496,7 @@ let convert_ilmethod ctx p m is_explicit_impl =
 			| Some ilcls when not (List.mem SInterface ilcls.cflags.tdf_semantics) ->
 			| Some ilcls when not (List.mem SInterface ilcls.cflags.tdf_semantics) ->
 				(AOverride,null_pos) :: acc
 				(AOverride,null_pos) :: acc
 			| None when ctx.ncom.verbose ->
 			| None when ctx.ncom.verbose ->
-				prerr_endline ("(net-lib) A referenced assembly for path " ^ ilpath_s path ^ " was not found");
+				print_endline ("(net-lib) A referenced assembly for path " ^ ilpath_s path ^ " was not found");
 				acc
 				acc
 			| _ -> acc
 			| _ -> acc
 	in
 	in
@@ -1211,7 +1211,7 @@ class net_library com name file_path std = object(self)
 		if std then self#add_flag FlagIsStd
 		if std then self#add_flag FlagIsStd
 end
 end
 
 
-let add_net_lib com file std =
+let add_net_lib com file std extern =
 	let real_file = if Sys.file_exists file then
 	let real_file = if Sys.file_exists file then
 		file
 		file
 	else try Common.find_file com file with
 	else try Common.find_file com file with
@@ -1220,6 +1220,7 @@ let add_net_lib com file std =
 			failwith (".NET lib " ^ file ^ " not found")
 			failwith (".NET lib " ^ file ^ " not found")
 	in
 	in
 	let net_lib = new net_library com file real_file std in
 	let net_lib = new net_library com file real_file std in
+	if extern then net_lib#add_flag FlagIsExtern;
 	com.native_libs.net_libs <- (net_lib :> (net_lib_type,unit) native_library) :: com.native_libs.net_libs;
 	com.native_libs.net_libs <- (net_lib :> (net_lib_type,unit) native_library) :: com.native_libs.net_libs;
 	CompilationServer.handle_native_lib com net_lib
 	CompilationServer.handle_native_lib com net_lib
 
 
@@ -1293,7 +1294,7 @@ let before_generate com =
 				let f = Unix.readdir f in
 				let f = Unix.readdir f in
 				let finsens = String.lowercase f in
 				let finsens = String.lowercase f in
 				if String.ends_with finsens ".dll" then
 				if String.ends_with finsens ".dll" then
-					add_net_lib com (path ^ "/" ^ f) true;
+					add_net_lib com (path ^ "/" ^ f) true false ();
 				loop()
 				loop()
 			with | End_of_file ->
 			with | End_of_file ->
 				Unix.closedir f
 				Unix.closedir f

+ 2 - 2
src/codegen/gencommon/gencommon.ml

@@ -948,14 +948,14 @@ let dump_descriptor gen name path_s module_s =
 	in
 	in
 	if Common.platform gen.gcon Java then
 	if Common.platform gen.gcon Java then
 		List.iter (fun java_lib ->
 		List.iter (fun java_lib ->
-			if not (java_lib#has_flag NativeLibraries.FlagIsStd) then begin
+			if not (java_lib#has_flag NativeLibraries.FlagIsStd) && not (java_lib#has_flag NativeLibraries.FlagIsExtern) then begin
 				SourceWriter.write w (path java_lib#get_file_path ".jar");
 				SourceWriter.write w (path java_lib#get_file_path ".jar");
 				SourceWriter.newline w;
 				SourceWriter.newline w;
 			end
 			end
 		) gen.gcon.native_libs.java_libs
 		) gen.gcon.native_libs.java_libs
 	else if Common.platform gen.gcon Cs then
 	else if Common.platform gen.gcon Cs then
 		List.iter (fun net_lib ->
 		List.iter (fun net_lib ->
-			if not (net_lib#has_flag NativeLibraries.FlagIsStd) then begin
+			if not (net_lib#has_flag NativeLibraries.FlagIsStd) && not (net_lib#has_flag NativeLibraries.FlagIsExtern) then begin
 				SourceWriter.write w (path net_lib#get_name ".dll");
 				SourceWriter.write w (path net_lib#get_name ".dll");
 				SourceWriter.newline w;
 				SourceWriter.newline w;
 			end
 			end

+ 10 - 9
src/codegen/java.ml

@@ -606,7 +606,7 @@ let jclass_with_params com cls params = try
 			cinterfaces = List.map (japply_params jparams) cls.cinterfaces;
 			cinterfaces = List.map (japply_params jparams) cls.cinterfaces;
 		}
 		}
 	with Invalid_argument _ ->
 	with Invalid_argument _ ->
-		if com.verbose then prerr_endline ("Differing parameters for class: " ^ s_type_path cls.cpath);
+		if com.verbose then print_endline ("Differing parameters for class: " ^ s_type_path cls.cpath);
 		cls
 		cls
 
 
 let is_object = function | TObject( (["java";"lang"], "Object"), [] ) -> true | _ -> false
 let is_object = function | TObject( (["java";"lang"], "Object"), [] ) -> true | _ -> false
@@ -660,8 +660,8 @@ let compare_type com s1 s2 =
 				let implements = List.map (japply_params jparams) c.cinterfaces in
 				let implements = List.map (japply_params jparams) c.cinterfaces in
 				loop ~first_error:first_error super s2 || List.exists (fun super -> loop ~first_error:first_error super s2) implements
 				loop ~first_error:first_error super s2 || List.exists (fun super -> loop ~first_error:first_error super s2) implements
 			with | Not_found ->
 			with | Not_found ->
-				prerr_endline ("-java-lib: The type " ^ (s_sig s1) ^ " is referred but was not found. Compilation may not occur correctly.");
-				prerr_endline "Did you forget to include a needed lib?";
+				print_endline ("-java-lib: The type " ^ (s_sig s1) ^ " is referred but was not found. Compilation may not occur correctly.");
+				print_endline "Did you forget to include a needed lib?";
 				if first_error then
 				if first_error then
 					not (loop ~first_error:false s2 s1)
 					not (loop ~first_error:false s2 s1)
 				else
 				else
@@ -694,13 +694,13 @@ let select_best com flist =
 				| -1 ->
 				| -1 ->
 					loop cur_best flist
 					loop cur_best flist
 				| -2 -> (* error - no type is compatible *)
 				| -2 -> (* error - no type is compatible *)
-					if com.verbose then prerr_endline (f.jf_name ^ ": The types " ^ (s_sig r) ^ " and " ^ (s_sig r2) ^ " are incompatible");
+					if com.verbose then print_endline (f.jf_name ^ ": The types " ^ (s_sig r) ^ " and " ^ (s_sig r2) ^ " are incompatible");
 					(* bet that the current best has "beaten" other types *)
 					(* bet that the current best has "beaten" other types *)
 					loop cur_best flist
 					loop cur_best flist
 				| _ -> assert false
 				| _ -> assert false
 			with | Exit -> (* incompatible type parameters *)
 			with | Exit -> (* incompatible type parameters *)
 				(* error mode *)
 				(* error mode *)
-				if com.verbose then prerr_endline (f.jf_name ^ ": Incompatible argument return signatures: " ^ (s_sig r) ^ " and " ^ (s_sig r2));
+				if com.verbose then print_endline (f.jf_name ^ ": Incompatible argument return signatures: " ^ (s_sig r) ^ " and " ^ (s_sig r2));
 				None)
 				None)
 			| TMethod _, _ -> (* select the method *)
 			| TMethod _, _ -> (* select the method *)
 				loop f flist
 				loop f flist
@@ -1051,12 +1051,12 @@ class virtual java_library com name file_path = object(self)
 				end
 				end
 			with
 			with
 			| JReader.Error_message msg ->
 			| JReader.Error_message msg ->
-				prerr_endline ("Class reader failed: " ^ msg);
+				print_endline ("Class reader failed: " ^ msg);
 				None
 				None
 			| e ->
 			| e ->
 				if ctx.jcom.verbose then begin
 				if ctx.jcom.verbose then begin
-					(* prerr_endline (Printexc.get_backtrace ()); requires ocaml 3.11 *)
-					prerr_endline (Printexc.to_string e)
+					(* print_endline (Printexc.get_backtrace ()); requires ocaml 3.11 *)
+					print_endline (Printexc.to_string e)
 				end;
 				end;
 				None
 				None
 		in
 		in
@@ -1188,7 +1188,7 @@ class java_library_dir com name file_path = object(self)
 			| _ -> None
 			| _ -> None
 end
 end
 
 
-let add_java_lib com name std =
+let add_java_lib com name std extern =
 	let file = if Sys.file_exists name then
 	let file = if Sys.file_exists name then
 		name
 		name
 	else try Common.find_file com name with
 	else try Common.find_file com name with
@@ -1203,6 +1203,7 @@ let add_java_lib com name std =
 			(new java_library_jar com name file :> java_library)
 			(new java_library_jar com name file :> java_library)
 	in
 	in
 	if std then java_lib#add_flag FlagIsStd;
 	if std then java_lib#add_flag FlagIsStd;
+	if extern then java_lib#add_flag FlagIsExtern;
 	com.native_libs.java_libs <- (java_lib :> (java_lib_type,unit) native_library) :: com.native_libs.java_libs;
 	com.native_libs.java_libs <- (java_lib :> (java_lib_type,unit) native_library) :: com.native_libs.java_libs;
 	CompilationServer.handle_native_lib com java_lib
 	CompilationServer.handle_native_lib com java_lib
 
 

+ 1 - 1
src/codegen/swfLoader.ml

@@ -132,7 +132,7 @@ let is_valid_path com pack name =
 	let rec loop = function
 	let rec loop = function
 		| [] ->
 		| [] ->
 			false
 			false
-		| load :: l ->
+		| (_,load) :: l ->
 			match load (pack,name) null_pos with
 			match load (pack,name) null_pos with
 			| None -> loop l
 			| None -> loop l
 			| Some (file,(_,a)) -> true
 			| Some (file,(_,a)) -> true

+ 15 - 18
src/compiler/main.ml

@@ -482,6 +482,8 @@ try
 	let pre_compilation = ref [] in
 	let pre_compilation = ref [] in
 	let interp = ref false in
 	let interp = ref false in
 	let swf_version = ref false in
 	let swf_version = ref false in
+	let native_libs = ref [] in
+	let add_native_lib file extern = native_libs := (file,extern) :: !native_libs in
 	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 Globals.version /. 1000.));
 	Common.raw_define com "haxe3";
 	Common.raw_define com "haxe3";
 	Common.raw_define com "haxe4";
 	Common.raw_define com "haxe4";
@@ -643,29 +645,20 @@ try
 			with
 			with
 				_ -> raise (Arg.Bad "Invalid SWF header format, expected width:height:fps[:color]")
 				_ -> raise (Arg.Bad "Invalid SWF header format, expected width:height:fps[:color]")
 		),"<header>","define SWF header (width:height:fps:color)");
 		),"<header>","define SWF header (width:height:fps:color)");
-		(* FIXME: replace with -D define *)
-		("Target-specific",["--swf-lib"],["-swf-lib"],Arg.String (fun file ->
+		("Target-specific",["--flash-strict"],[], define Define.FlashStrict, "","more type strict flash API");
+		("Target-specific",[],["--swf-lib";"-swf-lib"],Arg.String (fun file ->
 			process_libs(); (* linked swf order matters, and lib might reference swf as well *)
 			process_libs(); (* linked swf order matters, and lib might reference swf as well *)
-			SwfLoader.add_swf_lib com file false
+			add_native_lib file false;
 		),"<file>","add the SWF library to the compiled SWF");
 		),"<file>","add the SWF library to the compiled SWF");
 		(* FIXME: replace with -D define *)
 		(* FIXME: replace with -D define *)
-		("Target-specific",["--swf-lib-extern"],["-swf-lib-extern"],Arg.String (fun file ->
-			SwfLoader.add_swf_lib com file true
+		("Target-specific",[],["--swf-lib-extern";"-swf-lib-extern"],Arg.String (fun file ->
+			add_native_lib file true;
 		),"<file>","use the SWF library for type checking");
 		),"<file>","use the SWF library for type checking");
-		("Target-specific",["--flash-strict"],[], define Define.FlashStrict, "","more type strict flash API");
-		("Target-specific",["--java-lib"],["-java-lib"],Arg.String (fun file ->
-			let std = file = "lib/hxjava-std.jar" in
-			com.callbacks#add_before_typer_create (fun () -> Java.add_java_lib com file std);
+		("Target-specific",[],["--java-lib";"-java-lib"],Arg.String (fun file ->
+			add_native_lib file false;
 		),"<file>","add an external JAR or class directory library");
 		),"<file>","add an external JAR or class directory library");
-		("Target-specific",["--net-lib"],["-net-lib"],Arg.String (fun file ->
-			let file, is_std = match ExtString.String.nsplit file "@" with
-				| [file] ->
-					file,false
-				| [file;"std"] ->
-					file,true
-				| _ -> raise Exit
-			in
-			com.callbacks#add_before_typer_create (fun () -> Dotnet.add_net_lib com file is_std);
+		("Target-specific",[],["--net-lib";"-net-lib"],Arg.String (fun file ->
+			add_native_lib file false;
 		),"<file>[@std]","add an external .NET DLL file");
 		),"<file>[@std]","add an external .NET DLL file");
 		("Target-specific",["--net-std"],["-net-std"],Arg.String (fun file ->
 		("Target-specific",["--net-std"],["-net-std"],Arg.String (fun file ->
 			Dotnet.add_net_std com file
 			Dotnet.add_net_std com file
@@ -879,6 +872,10 @@ try
 		let t = Timer.timer ["typing"] in
 		let t = Timer.timer ["typing"] in
 		Typecore.type_expr_ref := (fun ?(mode=MGet) ctx e with_type -> Typer.type_expr ~mode ctx e with_type);
 		Typecore.type_expr_ref := (fun ?(mode=MGet) ctx e with_type -> Typer.type_expr ~mode ctx e with_type);
 		List.iter (fun f -> f ()) (List.rev com.callbacks#get_before_typer_create);
 		List.iter (fun f -> f ()) (List.rev com.callbacks#get_before_typer_create);
+		(* Native lib pass 1: Register *)
+		let fl = List.map (fun (file,extern) -> NativeLibraryHandler.add_native_lib com file extern) !native_libs in
+		(* Native lib pass 2: Initialize *)
+		List.iter (fun f -> f()) fl;
 		let tctx = Typer.create com in
 		let tctx = Typer.create com in
 		let add_signature desc =
 		let add_signature desc =
 			Option.may (fun cs -> CompilationServer.maybe_add_context_sign cs com desc) (CompilationServer.get ());
 			Option.may (fun cs -> CompilationServer.maybe_add_context_sign cs com desc) (CompilationServer.get ());

+ 1 - 1
src/compiler/server.ml

@@ -294,7 +294,7 @@ let rec wait_loop process_params verbose accept =
 						| [] ->
 						| [] ->
 							if verbose then print_endline ("No library file was found for " ^ s_type_path m.m_path); (* TODO *)
 							if verbose then print_endline ("No library file was found for " ^ s_type_path m.m_path); (* TODO *)
 							raise Not_found (* no extern registration *)
 							raise Not_found (* no extern registration *)
-						| load :: l ->
+						| (_,load) :: l ->
 							match load m.m_path p with
 							match load m.m_path p with
 							| None -> loop l
 							| None -> loop l
 							| Some (file,_) ->
 							| Some (file,_) ->

+ 1 - 1
src/context/common.ml

@@ -188,7 +188,7 @@ type context = {
 	mutable warning : string -> pos -> unit;
 	mutable warning : string -> pos -> unit;
 	mutable get_messages : unit -> compiler_message list;
 	mutable get_messages : unit -> compiler_message list;
 	mutable filter_messages : (compiler_message -> bool) -> unit;
 	mutable filter_messages : (compiler_message -> bool) -> unit;
-	mutable load_extern_type : (path -> pos -> (string * Ast.package) option) list; (* allow finding types which are not in sources *)
+	mutable load_extern_type : (string * (path -> pos -> (string * Ast.package) option)) list; (* allow finding types which are not in sources *)
 	callbacks : compiler_callbacks;
 	callbacks : compiler_callbacks;
 	defines : Define.define;
 	defines : Define.define;
 	mutable print : string -> unit;
 	mutable print : string -> unit;

+ 13 - 19
src/context/compilationServer.ml

@@ -235,9 +235,9 @@ let get_native_lib cs key =
 	with Not_found -> None
 	with Not_found -> None
 
 
 let handle_native_lib com lib =
 let handle_native_lib com lib =
-	let build = lib#build in
 	com.native_libs.all_libs <- lib#get_file_path :: com.native_libs.all_libs;
 	com.native_libs.all_libs <- lib#get_file_path :: com.native_libs.all_libs;
-	begin match get() with
+	com.load_extern_type <- com.load_extern_type @ [lib#get_file_path,lib#build];
+	match get() with
 	| Some cs when Define.raw_defined com.defines "haxe.cacheNativeLibs" ->
 	| Some cs when Define.raw_defined com.defines "haxe.cacheNativeLibs" ->
 		let init () =
 		let init () =
 			let file = lib#get_file_path in
 			let file = lib#get_file_path in
@@ -267,25 +267,19 @@ let handle_native_lib com lib =
 				h;
 				h;
 			end;
 			end;
 		in
 		in
-		(* This is some dicey nonsense: Native library handlers might actually
-			lookup something during the conversion to Haxe AST. For instance, the
-			SWF loader has a `is_valid_path` check in some cases which relies on
-			`load_extern_type`. In order to deal with this, we temporarily register
-			the standard resolver and then remove it again after the handling.
-		*)
-		let old = com.load_extern_type in
-		com.load_extern_type <- com.load_extern_type @ [build];
-		let lut = init() in
-		let build path p =
-			try Some (Hashtbl.find lut path)
-			with Not_found -> None
-		in
-		com.load_extern_type <- old @ [build];
+		(fun () ->
+			let lut = init() in
+			let build path p =
+				try Some (Hashtbl.find lut path)
+				with Not_found -> None
+			in
+			com.load_extern_type <- List.map (fun (name,f) ->
+				name,if name = lib#get_file_path then build else f
+			) com.load_extern_type
+		)
 	| _ ->
 	| _ ->
 		(* Offline mode, just read library as usual. *)
 		(* Offline mode, just read library as usual. *)
-		lib#load;
-		com.load_extern_type <- com.load_extern_type @ [build];
-	end
+		(fun () -> lib#load)
 
 
 (* context *)
 (* context *)
 
 

+ 1 - 0
src/context/nativeLibraries.ml

@@ -22,6 +22,7 @@ open ExtString
 
 
 type native_lib_flags =
 type native_lib_flags =
 	| FlagIsStd
 	| FlagIsStd
+	| FlagIsExtern
 
 
 class virtual ['a,'data] native_library (name : string) (file_path : string) = object(self)
 class virtual ['a,'data] native_library (name : string) (file_path : string) = object(self)
 	val mutable flags : native_lib_flags list = []
 	val mutable flags : native_lib_flags list = []

+ 39 - 0
src/context/nativeLibraryHandler.ml

@@ -0,0 +1,39 @@
+(*
+	The Haxe Compiler
+	Copyright (C) 2005-2019  Haxe Foundation
+
+	This program is free software; you can redistribute it and/or
+	modify it under the terms of the GNU General Public License
+	as published by the Free Software Foundation; either version 2
+	of the License, or (at your option) any later version.
+
+	This program is distributed in the hope that it will be useful,
+	but WITHOUT ANY WARRANTY; without even the implied warranty of
+	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+	GNU General Public License for more details.
+
+	You should have received a copy of the GNU General Public License
+	along with this program; if not, write to the Free Software
+	Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+ *)
+
+open Globals
+open Common
+
+let add_native_lib com file is_extern = match com.platform with
+	| Globals.Flash ->
+		SwfLoader.add_swf_lib com file is_extern
+	| Globals.Java ->
+		let std = file = "lib/hxjava-std.jar" in
+		Java.add_java_lib com file std is_extern
+	| Globals.Cs ->
+		let file, is_std = match ExtString.String.nsplit file "@" with
+			| [file] ->
+				file,false
+			| [file;"std"] ->
+				file,true
+			| _ -> failwith ("unsupported file@`std` format: " ^ file)
+		in
+		Dotnet.add_net_lib com file is_std is_extern
+	| pf ->
+		failwith (Printf.sprintf "Target %s does not support native libraries (trying to load %s)" (platform_name pf) file);

+ 1 - 13
src/macro/macroApi.ml

@@ -1805,19 +1805,7 @@ let macro_api ccom get_api =
 		"add_native_lib", vfun1 (fun file ->
 		"add_native_lib", vfun1 (fun file ->
 			let file = decode_string file in
 			let file = decode_string file in
 			let com = ccom() in
 			let com = ccom() in
-			(match com.platform with
-			| Globals.Flash -> SwfLoader.add_swf_lib com file false
-			| Globals.Java -> Java.add_java_lib com file false
-			| Globals.Cs ->
-				let file, is_std = match ExtString.String.nsplit file "@" with
-					| [file] ->
-						file,false
-					| [file;"std"] ->
-						file,true
-					| _ -> failwith ("unsupported file@`std` format: " ^ file)
-				in
-				Dotnet.add_net_lib com file is_std
-			| _ -> failwith "Unsupported platform");
+			NativeLibraryHandler.add_native_lib com file false ();
 			vnull
 			vnull
 		);
 		);
 		"add_native_arg", vfun1 (fun arg ->
 		"add_native_arg", vfun1 (fun arg ->

+ 1 - 1
src/typing/macroContext.ml

@@ -197,7 +197,7 @@ let make_macro_api ctx p =
 			)
 			)
 		);
 		);
 		MacroApi.on_type_not_found = (fun f ->
 		MacroApi.on_type_not_found = (fun f ->
-			ctx.com.load_extern_type <- ctx.com.load_extern_type @ [fun path p ->
+			ctx.com.load_extern_type <- ctx.com.load_extern_type @ ["onTypeNotFound",fun path p ->
 				let td = f (s_type_path path) in
 				let td = f (s_type_path path) in
 				if td = Interp.vnull then
 				if td = Interp.vnull then
 					None
 					None

+ 1 - 1
src/typing/typeloadModule.ml

@@ -964,7 +964,7 @@ let load_module ctx m p =
 				let rec loop = function
 				let rec loop = function
 					| [] ->
 					| [] ->
 						raise (Error (Module_not_found m,p))
 						raise (Error (Module_not_found m,p))
-					| load :: l ->
+					| (_,load) :: l ->
 						match load m p with
 						match load m p with
 						| None -> loop l
 						| None -> loop l
 						| Some (file,(_,a)) -> file, a
 						| Some (file,(_,a)) -> file, a