[generators] add gctx.ml to lose dependency on common.ml

src/compiler/generate.ml

@@ -80,7 +80,9 @@ let generate ctx tctx ext actx =
 			Gencs.generate,"cs"
 		| Java ->
 			if Common.defined com Jvm then
-				Genjvm.generate actx.jvm_flag,"java"
+				(fun com ->
+					Genjvm.generate actx.jvm_flag (Common.to_gctx com)
+				),"java"
 			else
 				Genjava.generate,"java"
 		| Python ->

src/context/common.ml

@@ -412,6 +412,25 @@ type context = {
 	memory_marker : float array;
 }
 
+let to_gctx com = {
+	Gctx.platform = com.platform;
+	defines = com.defines;
+	basic = com.basic;
+	debug = com.debug;
+	file = com.file;
+	features = com.features;
+	modules = com.modules;
+	main = com.main;
+	types = com.types;
+	resources = com.resources;
+	main_class = com.main_class;
+	native_libs = match com.platform with
+		| Java -> (com.native_libs.java_libs :> NativeLibraries.native_library_base list)
+		| Cs -> (com.native_libs.net_libs  :> NativeLibraries.native_library_base list)
+		| Flash -> (com.native_libs.swf_libs  :> NativeLibraries.native_library_base list)
+		| _ -> [];
+}
+
 let enter_stage com stage =
 	(* print_endline (Printf.sprintf "Entering stage %s" (s_compiler_stage stage)); *)
 	com.stage <- stage

src/context/nativeLibraries.ml

@@ -23,14 +23,18 @@ type native_lib_flags =
 	| FlagIsStd
 	| FlagIsExtern
 
-class virtual ['a,'data] native_library (name : string) (file_path : string) = object(self)
+class virtual native_library_base (name : string) (file_path : string) = object(self)
 	val mutable flags : native_lib_flags list = []
 
 	method add_flag flag = flags <- flag :: flags
 	method has_flag flag = List.mem flag flags
 
 	method get_name = name
 	method get_file_path = file_path
+end
+
+class virtual ['a,'data] native_library (name : string) (file_path : string) = object(self)
+	inherit native_library_base name file_path
 
 	method virtual build : path -> pos -> Ast.package option
 	method virtual close : unit

src/generators/gctx.ml

@@ -0,0 +1,65 @@
+open Globals
+open Type
+
+type t = {
+	platform : platform;
+	defines : Define.define;
+	basic : basic_types;
+	debug : bool;
+	file : string;
+	features : (string,bool) Hashtbl.t;
+	modules : Type.module_def list;
+	main : Type.texpr option;
+	types : Type.module_type list;
+	resources : (string,string) Hashtbl.t;
+	main_class : path option;
+	native_libs : NativeLibraries.native_library_base list;
+}
+
+let raw_defined gctx v =
+	Define.raw_defined gctx.defines v
+
+let has_dce gctx =
+	try
+		Define.defined_value gctx.defines Define.Dce <> "no"
+with Not_found ->
+	false
+
+let rec has_feature gctx f =
+	try
+		Hashtbl.find gctx.features f
+	with Not_found ->
+		if gctx.types = [] then not (has_dce gctx) else
+		match List.rev (ExtString.String.nsplit f ".") with
+		| [] -> die "" __LOC__
+		| [cl] -> has_feature gctx (cl ^ ".*")
+		| field :: cl :: pack ->
+			let r = (try
+				let path = List.rev pack, cl in
+				(match List.find (fun t -> t_path t = path && not (Meta.has Meta.RealPath (t_infos t).mt_meta)) gctx.types with
+				| t when field = "*" ->
+					not (has_dce gctx) ||
+					(match t with TAbstractDecl a -> Meta.has Meta.ValueUsed a.a_meta | _ -> Meta.has Meta.Used (t_infos t).mt_meta)
+				| TClassDecl c when (has_class_flag c CExtern) && (gctx.platform <> Js || cl <> "Array" && cl <> "Math") ->
+					not (has_dce gctx) || Meta.has Meta.Used (try PMap.find field c.cl_statics with Not_found -> PMap.find field c.cl_fields).cf_meta
+				| TClassDecl c ->
+					PMap.exists field c.cl_statics || PMap.exists field c.cl_fields
+				| _ ->
+					false)
+			with Not_found ->
+				false
+			) in
+			Hashtbl.add gctx.features f r;
+			r
+
+let get_entry_point gctx =
+	Option.map (fun path ->
+		let m = List.find (fun m -> m.m_path = path) gctx.modules in
+		let c =
+			match m.m_statics with
+			| Some c when (PMap.mem "main" c.cl_statics) -> c
+			| _ -> Option.get (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 gctx.main in (* must be present at this point *)
+		(snd path, c, e)
+	) gctx.main_class

src/generators/genjvm.ml

@@ -19,7 +19,7 @@
 
 open Globals
 open Ast
-open Common
+open Gctx
 open Type
 open Path
 open JvmGlobals
@@ -58,7 +58,7 @@ end
 (* Haxe *)
 
 type generation_context = {
-	com : Common.context;
+	gctx : Gctx.t;
 	out : jvm_output;
 	t_runtime_exception : Type.t;
 	entry_point : (tclass * texpr) option;
@@ -505,7 +505,6 @@ class texpr_to_jvm
 	(jm : JvmMethod.builder)
 	(return_type : jsignature option)
 = object(self)
-	val com = gctx.com
 	val code = jm#get_code
 	val pool : JvmConstantPool.constant_pool = jc#get_pool
 
@@ -521,7 +520,7 @@ class texpr_to_jvm
 	method vtype t =
 		jsignature_of_type gctx t
 
-	method mknull t = com.basic.tnull (follow t)
+	method mknull t = gctx.gctx.basic.tnull (follow t)
 
 	(* locals *)
 
@@ -988,13 +987,13 @@ class texpr_to_jvm
 			store();
 			let ev = mk (TLocal v) v.v_type null_pos in
 			let el = List.rev_map (fun case ->
-				let f e' = mk (TBinop(OpEq,ev,e')) com.basic.tbool e'.epos in
+				let f e' = mk (TBinop(OpEq,ev,e')) gctx.gctx.basic.tbool e'.epos in
 				let e_cond = match case.case_patterns with
 					| [] -> die "" __LOC__
 					| [e] -> f e
 					| e :: el ->
 						List.fold_left (fun eacc e ->
-							mk (TBinop(OpBoolOr,eacc,f e)) com.basic.tbool e.epos
+							mk (TBinop(OpBoolOr,eacc,f e)) gctx.gctx.basic.tbool e.epos
 						) (f e) el
 				in
 				(e_cond,case.case_expr)
@@ -2109,7 +2108,7 @@ class texpr_to_jvm
 		| TParenthesis e1 | TMeta(_,e1) ->
 			self#texpr ret e1
 		| TFor(v,e1,e2) ->
-			self#texpr ret (Texpr.for_remap com.basic v e1 e2 e.epos)
+			self#texpr ret (Texpr.for_remap gctx.gctx.basic v e1 e2 e.epos)
 		| TEnumIndex e1 ->
 			self#texpr rvalue_any e1;
 			jm#invokevirtual java_enum_path "ordinal" (method_sig [] (Some TInt))
@@ -2560,9 +2559,9 @@ class tclass_to_jvm gctx c = object(self)
 			| None ->
 				if c.cl_path = (["haxe"],"Resource") && cf.cf_name = "content" then begin
 					let el = Hashtbl.fold (fun name _ acc ->
-						Texpr.Builder.make_string gctx.com.basic name null_pos :: acc
-					) gctx.com.resources [] in
-					let e = mk (TArrayDecl el) (gctx.com.basic.tarray gctx.com.basic.tstring) null_pos in
+						Texpr.Builder.make_string gctx.gctx.basic name null_pos :: acc
+					) gctx.gctx.resources [] in
+					let e = mk (TArrayDecl el) (gctx.gctx.basic.tarray gctx.gctx.basic.tstring) null_pos in
 					default e;
 				end;
 			| Some e when mtype <> MStatic ->
@@ -2603,7 +2602,7 @@ class tclass_to_jvm gctx c = object(self)
 		let jsig = method_sig [array_sig string_sig] None in
 		let jm = jc#spawn_method "main" jsig [MPublic;MStatic] in
 		let _,load,_ = jm#add_local "args" (TArray(string_sig,None)) VarArgument in
-		if has_feature gctx.com "haxe.root.Sys.args" then begin
+		if has_feature gctx.gctx "haxe.root.Sys.args" then begin
 			load();
 			jm#putstatic (["haxe";"root"],"Sys") "_args" (TArray(string_sig,None))
 		end;
@@ -2838,7 +2837,7 @@ let generate_enum gctx en =
 		jm_values#new_native_array (object_path_sig jc_enum#get_this_path) fl;
 		jm_values#return;
 		(* Add __meta__ TODO: do this via annotations instead? *)
-		begin match Texpr.build_metadata gctx.com.basic (TEnumDecl en) with
+		begin match Texpr.build_metadata gctx.gctx.basic (TEnumDecl en) with
 		| None ->
 			()
 		| Some e ->
@@ -3000,32 +2999,32 @@ module Preprocessor = struct
 				| _ ->
 					()
 			) m.m_types
-		) gctx.com.modules;
+		) gctx.gctx.modules;
 		(* preprocess classes *)
 		List.iter (fun mt ->
 			match mt with
 			| TClassDecl c ->
 				if not (has_class_flag c CInterface) then gctx.preprocessor#preprocess_class c
 				else check_single_method_interface gctx c;
 			| _ -> ()
-		) gctx.com.types;
+		) gctx.gctx.types;
 		(* find typedef-interface implementations *)
 		List.iter (fun mt -> match mt with
 			| TClassDecl c when not (has_class_flag c CInterface) && not (has_class_flag c CExtern) ->
 				gctx.typedef_interfaces#process_class c;
 			| _ ->
 				()
-		) gctx.com.types
+		) gctx.gctx.types
 end
 
-let generate jvm_flag com =
-	let path = FilePath.parse com.file in
-	let jar_name,entry_point = match get_entry_point com with
+let generate jvm_flag gctx =
+	let path = FilePath.parse gctx.file in
+	let jar_name,entry_point = match get_entry_point gctx with
 		| Some (jarname,cl,expr) -> jarname, Some (cl,expr)
 		| None -> "jar",None
 	in
 	let compression_level = try
-		int_of_string (Define.defined_value com.defines Define.JvmCompressionLevel)
+		int_of_string (Define.defined_value gctx.defines Define.JvmCompressionLevel)
 	with _ ->
 		6
 	in
@@ -3038,10 +3037,10 @@ let generate jvm_flag com =
 		| Some _ ->
 			begin match path.directory with
 				| None ->
-					"./",create_jar ("./" ^ com.file)
+					"./",create_jar ("./" ^ gctx.file)
 				| Some dir ->
 					mkdir_from_path dir;
-					add_trailing_slash dir,create_jar com.file
+					add_trailing_slash dir,create_jar gctx.file
 			end
 		| None -> match path.directory with
 			| Some dir ->
@@ -3050,25 +3049,25 @@ let generate jvm_flag com =
 			| None ->
 				failwith "Please specify an output file name"
 	end else begin
-		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_name = if gctx.debug then jar_name ^ "-Debug" else jar_name in
+		let jar_dir = add_trailing_slash gctx.file in
 		let jar_path = Printf.sprintf "%s%s.jar" jar_dir jar_name in
 		jar_dir,create_jar jar_path
 	end in
 	let anon_identification = new tanon_identification haxe_dynamic_object_path in
 	let dynamic_level = try
-		int_of_string (Define.defined_value com.defines Define.JvmDynamicLevel)
+		int_of_string (Define.defined_value gctx.defines Define.JvmDynamicLevel)
 	with _ ->
 		1
 	in
 	if dynamic_level < 0 || dynamic_level > 2 then failwith "Invalid value for -D jvm.dynamic-level: Must be >=0 and <= 2";
 	let gctx = {
-		com = com;
+		gctx = gctx;
 		out = out;
-		t_runtime_exception = TInst(resolve_class com (["java";"lang"],"RuntimeException"),[]);
+		t_runtime_exception = TInst(resolve_class gctx (["java";"lang"],"RuntimeException"),[]);
 		entry_point = entry_point;
-		t_exception = TInst(resolve_class com (["java";"lang"],"Exception"),[]);
-		t_throwable = TInst(resolve_class com (["java";"lang"],"Throwable"),[]);
+		t_exception = TInst(resolve_class gctx (["java";"lang"],"Exception"),[]);
+		t_throwable = TInst(resolve_class gctx (["java";"lang"],"Throwable"),[]);
 		anon_identification = anon_identification;
 		preprocessor = Obj.magic ();
 		typedef_interfaces = Obj.magic ();
@@ -3078,12 +3077,12 @@ let generate jvm_flag com =
 		default_export_config = {
 			export_debug = true;
 		};
-		detail_times = Common.raw_defined com "jvm_times";
+		detail_times = Gctx.raw_defined gctx "jvm_times";
 		timer = new Timer.timer ["generate";"java"];
 		jar_compression_level = compression_level;
 		dynamic_level = dynamic_level;
 	} in
-	gctx.preprocessor <- new preprocessor com.basic (jsignature_of_type gctx);
+	gctx.preprocessor <- new preprocessor gctx.gctx.basic (jsignature_of_type gctx);
 	gctx.typedef_interfaces <- new typedef_interfaces gctx.preprocessor#get_infos anon_identification;
 	gctx.typedef_interfaces#add_interface_rewrite (["haxe";"root"],"Iterator") (["java";"util"],"Iterator") true;
 	let class_paths = ExtList.List.filter_map (fun java_lib ->
@@ -3100,13 +3099,13 @@ let generate jvm_flag com =
 			close_out ch_out;
 			Some (Printf.sprintf "lib/%s \n" name)
 		end
-	) com.native_libs.java_libs in
+	) gctx.gctx.native_libs in
 	Hashtbl.iter (fun name v ->
 		let filename = StringHelper.escape_res_name name ['/';'-'] in
 		gctx.out#add_entry v filename;
-	) com.resources;
+	) gctx.gctx.resources;
 	let generate_real_types () =
-		List.iter (generate_module_type gctx) com.types;
+		List.iter (generate_module_type gctx) gctx.gctx.types;
 	in
 	let generate_typed_interfaces () =
 		Hashtbl.iter (fun _ c -> generate_module_type gctx (TClassDecl c)) gctx.typedef_interfaces#get_interfaces;