Răsfoiți Sursa

[cs][java][jvm] clean up -main handling a little (module-statics preparation) (#9230)

* [cs][java][jvm] clean up -main handling a little (module-statics preparation)

these are the only targets that actually rely on the com.main_class and treat it as an actual class path. to support module-level -main i need to treat that as module path, this change will make it easy to change the real main class because i will only need to change the get_entry_point implementation.

also this fixes genjvm generating entry-point main methods for any "main" method :-)

* [jvm] fix entry-point logic a bit

only matters when main class will be something different (e.g. module-statics), but still
Dan Korostelev 5 ani în urmă
părinte
comite
ff610ac384

+ 16 - 13
src/codegen/gencommon/gencommon.ml

@@ -378,6 +378,8 @@ type generator_ctx =
 	(* this is all you need to care about *)
 	(* this is all you need to care about *)
 	gcon : Common.context;
 	gcon : Common.context;
 
 
+	gentry_point : (string * tclass * texpr) option;
+
 	gclasses : gen_classes;
 	gclasses : gen_classes;
 
 
 	gtools : gen_tools;
 	gtools : gen_tools;
@@ -571,6 +573,7 @@ let new_ctx con =
 
 
 	let rec gen = {
 	let rec gen = {
 		gcon = con;
 		gcon = con;
+		gentry_point = get_entry_point con;
 		gclasses = {
 		gclasses = {
 			cl_reflect = get_cl (get_type ([], "Reflect"));
 			cl_reflect = get_cl (get_type ([], "Reflect"));
 			cl_type = get_cl (get_type ([], "Type"));
 			cl_type = get_cl (get_type ([], "Type"));
@@ -915,19 +918,19 @@ let dump_descriptor gen name path_s module_s =
 	SourceWriter.write w "end modules";
 	SourceWriter.write w "end modules";
 	SourceWriter.newline w;
 	SourceWriter.newline w;
 	(* dump all resources *)
 	(* dump all resources *)
-	(match gen.gcon.main_class with
-		| Some path ->
-			SourceWriter.write w "begin main";
-			SourceWriter.newline w;
-			(try
-				SourceWriter.write w (Hashtbl.find main_paths path)
-			with
-				| Not_found -> SourceWriter.write w (path_s path));
-			SourceWriter.newline w;
-			SourceWriter.write w "end main";
-			SourceWriter.newline w
-	| _ -> ()
-	);
+	(match gen.gentry_point with
+	| Some (_,cl,_) ->
+		SourceWriter.write w "begin main";
+		SourceWriter.newline w;
+		let path = cl.cl_path in
+		(try
+			SourceWriter.write w (Hashtbl.find main_paths path)
+		with Not_found ->
+			SourceWriter.write w (path_s path));
+		SourceWriter.newline w;
+		SourceWriter.write w "end main";
+		SourceWriter.newline w
+	| _ -> ());
 	SourceWriter.write w "begin resources";
 	SourceWriter.write w "begin resources";
 	SourceWriter.newline w;
 	SourceWriter.newline w;
 	Hashtbl.iter (fun name _ ->
 	Hashtbl.iter (fun name _ ->

+ 9 - 1
src/context/common.ml

@@ -849,4 +849,12 @@ let adapt_defines_to_macro_context defines =
 
 
 let is_legacy_completion com = match com.json_out with
 let is_legacy_completion com = match com.json_out with
 	| None -> true
 	| None -> true
-	| Some api -> !ServerConfig.legacy_completion
+	| Some api -> !ServerConfig.legacy_completion
+
+let get_entry_point com =
+	Option.map (fun path ->
+		let m = List.find (fun m -> m.m_path = path) com.modules in
+		let c = ExtList.List.find_map (fun t -> match t with TClassDecl c when c.cl_path = path -> Some c | _ -> None) m.m_types in
+		let e = Option.get com.main in (* must be present at this point *)
+		(snd path, c, e)
+	) com.main_class

+ 24 - 31
src/generators/gencs.ml

@@ -2582,30 +2582,26 @@ let generate con =
 
 
 			gen_attributes w cl.cl_meta;
 			gen_attributes w cl.cl_meta;
 
 
-			let is_main =
-				match gen.gcon.main_class with
-					| Some ( (_,"Main") as path) when path = cl.cl_path && not cl.cl_interface ->
-						(*
-							for cases where the main class is called Main, there will be a problem with creating the entry point there.
-							In this special case, a special entry point class will be created
-						*)
-						write w "public class EntryPoint__Main ";
-						begin_block w;
-						write w "public static void Main() ";
-						begin_block w;
-						(if Hashtbl.mem gen.gtypes (["cs"], "Boot") then write w "global::cs.Boot.init();"; newline w);
-						(match gen.gcon.main with
-							| None ->
-								expr_s true w { eexpr = TTypeExpr(TClassDecl cl); etype = t_dynamic; epos = null_pos };
-								write w ".main();"
-							| Some expr ->
-								expr_s false w (mk_block expr));
-						end_block w;
-						end_block w;
-						newline w;
-						false
-					| Some path when path = cl.cl_path && not cl.cl_interface -> true
-					| _ -> false
+			let main_expr =
+				match gen.gentry_point with
+				| Some (_,({ cl_path = (_,"Main") } as cl_main),expr) when cl == cl_main && not cl.cl_interface ->
+					(*
+						for cases where the main class is called Main, there will be a problem with creating the entry point there.
+						In this special case, a special entry point class will be created
+					*)
+					write w "public class EntryPoint__Main ";
+					begin_block w;
+					write w "public static void Main() ";
+					begin_block w;
+					(if Hashtbl.mem gen.gtypes (["cs"], "Boot") then write w "global::cs.Boot.init();"; newline w);
+					expr_s false w expr;
+					write w ";";
+					end_block w;
+					end_block w;
+					newline w;
+					None
+				| Some (_, cl_main,expr) when cl == cl_main && not cl.cl_interface -> Some expr
+				| _ -> None
 			in
 			in
 
 
 			let clt, access, modifiers = get_class_modifiers cl.cl_meta (if cl.cl_interface then "interface" else "class") "public" [] in
 			let clt, access, modifiers = get_class_modifiers cl.cl_meta (if cl.cl_interface then "interface" else "class") "public" [] in
@@ -2636,17 +2632,14 @@ let generate con =
 			in
 			in
 			loop cl.cl_meta;
 			loop cl.cl_meta;
 
 
-			if is_main then begin
+			Option.may (fun expr ->
 				write w "public static void Main()";
 				write w "public static void Main()";
 				begin_block w;
 				begin_block w;
 				(if Hashtbl.mem gen.gtypes (["cs"], "Boot") then write w "global::cs.Boot.init();"; newline w);
 				(if Hashtbl.mem gen.gtypes (["cs"], "Boot") then write w "global::cs.Boot.init();"; newline w);
-				(match gen.gcon.main with
-					| None ->
-						write w "main();";
-					| Some expr ->
-							expr_s false w (mk_block expr));
+				expr_s false w expr;
+				write w ";";
 				end_block w
 				end_block w
-			end;
+			) main_expr;
 
 
 			(match cl.cl_init with
 			(match cl.cl_init with
 				| None -> ()
 				| None -> ()

+ 19 - 23
src/generators/genjava.ml

@@ -2151,29 +2151,25 @@ let generate con =
 		in
 		in
 		loop cl.cl_meta;
 		loop cl.cl_meta;
 
 
-		(match gen.gcon.main_class with
-			| Some path when path = cl.cl_path ->
-				write w "public static void main(String[] args)";
-				begin_block w;
-				(try
-					let t = Hashtbl.find gen.gtypes ([], "Sys") in
-							match t with
-								| TClassDecl(cl) when PMap.mem "_args" cl.cl_statics ->
-									write w "Sys._args = args;"; newline w
-								| _ -> ()
-				with | Not_found -> ()
-				);
-				write w "haxe.java.Init.init();";
-				newline w;
-				(match gen.gcon.main with
-					| Some(expr) ->
-						expr_s w (mk_block expr)
-					| None ->
-						write w "main();");
-				end_block w;
-				newline w
-			| _ -> ()
-		);
+		(match gen.gentry_point with
+		| Some (_,cl_main,expr) when cl == cl_main ->
+			write w "public static void main(String[] args)";
+			begin_block w;
+			(try
+				let t = Hashtbl.find gen.gtypes ([], "Sys") in
+				match t with
+				| TClassDecl(cl) when PMap.mem "_args" cl.cl_statics ->
+					write w "Sys._args = args;"; newline w
+				| _ -> ()
+			with Not_found ->
+				());
+			write w "haxe.java.Init.init();";
+			newline w;
+			expr_s w expr;
+			write w ";";
+			end_block w;
+			newline w
+		| _ -> ());
 
 
 		(match cl.cl_init with
 		(match cl.cl_init with
 			| None -> ()
 			| None -> ()

+ 10 - 14
src/generators/genjvm.ml

@@ -51,6 +51,7 @@ exception HarderFailure of string
 type generation_context = {
 type generation_context = {
 	com : Common.context;
 	com : Common.context;
 	jar : Zip.out_file;
 	jar : Zip.out_file;
+	entry_point : (tclass * texpr) option;
 	t_exception : Type.t;
 	t_exception : Type.t;
 	t_throwable : Type.t;
 	t_throwable : Type.t;
 	mutable anon_identification : jsignature tanon_identification;
 	mutable anon_identification : jsignature tanon_identification;
@@ -2527,7 +2528,7 @@ class tclass_to_jvm gctx c = object(self)
 		let offset = jc#get_pool#add_string ssig in
 		let offset = jc#get_pool#add_string ssig in
 		jm#add_attribute (AttributeSignature offset)
 		jm#add_attribute (AttributeSignature offset)
 
 
-	method generate_main =
+	method generate_main e =
 		let jsig = method_sig [array_sig string_sig] None in
 		let jsig = method_sig [array_sig string_sig] None in
 		let jm = jc#spawn_method "main" jsig [MPublic;MStatic] in
 		let jm = jc#spawn_method "main" jsig [MPublic;MStatic] in
 		let _,load,_ = jm#add_local "args" (TArray(string_sig,None)) VarArgument in
 		let _,load,_ = jm#add_local "args" (TArray(string_sig,None)) VarArgument in
@@ -2536,12 +2537,7 @@ class tclass_to_jvm gctx c = object(self)
 			jm#putstatic (["haxe";"root"],"Sys") "_args" (TArray(string_sig,None))
 			jm#putstatic (["haxe";"root"],"Sys") "_args" (TArray(string_sig,None))
 		end;
 		end;
 		jm#invokestatic (["haxe"; "java"], "Init") "init" (method_sig [] None);
 		jm#invokestatic (["haxe"; "java"], "Init") "init" (method_sig [] None);
-		begin match gctx.com.main with
-		| Some e ->
-			self#generate_expr gctx jc jm e true SCNone MStatic
-		| None ->
-			()
-		end;
+		self#generate_expr gctx jc jm e true SCNone MStatic;
 		if not jm#is_terminated then jm#return
 		if not jm#is_terminated then jm#return
 
 
 	method private generate_fields =
 	method private generate_fields =
@@ -2549,11 +2545,11 @@ class tclass_to_jvm gctx c = object(self)
 			| Method (MethNormal | MethInline) ->
 			| Method (MethNormal | MethInline) ->
 				List.iter (fun cf ->
 				List.iter (fun cf ->
 					failsafe cf.cf_pos (fun () -> self#generate_method gctx jc c mtype cf);
 					failsafe cf.cf_pos (fun () -> self#generate_method gctx jc c mtype cf);
-					if cf.cf_name = "main" then self#generate_main;
 				) (cf :: List.filter (fun cf -> Meta.has Meta.Overload cf.cf_meta) cf.cf_overloads)
 				) (cf :: List.filter (fun cf -> Meta.has Meta.Overload cf.cf_meta) cf.cf_overloads)
 			| _ ->
 			| _ ->
 				if not c.cl_interface && is_physical_field cf then failsafe cf.cf_pos (fun () -> self#generate_field gctx jc c mtype cf)
 				if not c.cl_interface && is_physical_field cf then failsafe cf.cf_pos (fun () -> self#generate_field gctx jc c mtype cf)
 		in
 		in
+		Option.may (fun (c2,e) -> if c2 == c then self#generate_main e) gctx.entry_point;
 		List.iter (field MStatic) c.cl_ordered_statics;
 		List.iter (field MStatic) c.cl_ordered_statics;
 		List.iter (field MInstance) c.cl_ordered_fields;
 		List.iter (field MInstance) c.cl_ordered_fields;
 		begin match c.cl_constructor,c.cl_super with
 		begin match c.cl_constructor,c.cl_super with
@@ -2919,15 +2915,14 @@ let file_name_and_extension file =
 
 
 let generate com =
 let generate com =
 	mkdir_from_path com.file;
 	mkdir_from_path com.file;
-	let jar_name,manifest_suffix = match com.main_class with
-		| Some path ->
-			let pack = match fst path with
+	let jar_name,manifest_suffix,entry_point = match get_entry_point com with
+		| Some (jarname,cl,expr) ->
+			let pack = match fst cl.cl_path with
 				| [] -> ["haxe";"root"]
 				| [] -> ["haxe";"root"]
 				| pack -> pack
 				| pack -> pack
 			in
 			in
-			let name = snd path in
-			name,"\nMain-Class: " ^ (s_type_path (pack,name))
-		| None -> "jar",""
+			jarname,"\nMain-Class: " ^ (s_type_path (pack,snd cl.cl_path)), Some (cl,expr)
+		| None -> "jar","",None
 	in
 	in
 	let jar_name = if com.debug then jar_name ^ "-Debug" else jar_name in
 	let jar_name = if com.debug then jar_name ^ "-Debug" else jar_name in
 	let jar_dir = add_trailing_slash com.file in
 	let jar_dir = add_trailing_slash com.file in
@@ -2936,6 +2931,7 @@ let generate com =
 	let gctx = {
 	let gctx = {
 		com = com;
 		com = com;
 		jar = Zip.open_out jar_path;
 		jar = Zip.open_out jar_path;
+		entry_point = entry_point;
 		t_exception = TInst(resolve_class com (["java";"lang"],"Exception"),[]);
 		t_exception = TInst(resolve_class com (["java";"lang"],"Exception"),[]);
 		t_throwable = TInst(resolve_class com (["java";"lang"],"Throwable"),[]);
 		t_throwable = TInst(resolve_class com (["java";"lang"],"Throwable"),[]);
 		anon_identification = anon_identification;
 		anon_identification = anon_identification;