Add generator-specific context

src/compiler/generate.ml

@@ -80,13 +80,17 @@ 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 ->
 			Genpy.generate,"python"
 		| Hl ->
-			Genhl.generate,"hl"
+			(fun com ->
+				Genhl.generate (Common.to_gctx com)
+			),"hl"
 		| Eval ->
 			(fun _ -> MacroContext.interpret tctx),"eval"
 		| Cross

src/context/common.ml

@@ -410,6 +410,29 @@ type context = {
 	memory_marker : float array;
 }
 
+let to_gctx com = {
+	Gctx.platform = com.platform;
+	defines = com.defines;
+	basic = com.basic;
+	class_paths = com.class_paths;
+	run_command = com.run_command;
+	run_command_args = com.run_command_args;
+	debug = com.debug;
+	file = com.file;
+	version = com.version;
+	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
@@ -1081,90 +1104,6 @@ let hash f =
 	done;
 	if Sys.word_size = 64 then Int32.to_int (Int32.shift_right (Int32.shift_left (Int32.of_int !h) 1) 1) else !h
 
-let url_encode s add_char =
-	let hex = "0123456789ABCDEF" in
-	for i = 0 to String.length s - 1 do
-		let c = String.unsafe_get s i in
-		match c with
-		| 'A'..'Z' | 'a'..'z' | '0'..'9' | '_' | '-' | '.' ->
-			add_char c
-		| _ ->
-			add_char '%';
-			add_char (String.unsafe_get hex (int_of_char c lsr 4));
-			add_char (String.unsafe_get hex (int_of_char c land 0xF));
-	done
-
-let url_encode_s s =
-	let b = Buffer.create 0 in
-	url_encode s (Buffer.add_char b);
-	Buffer.contents b
-
-(* UTF8 *)
-
-let to_utf8 str p =
-	let u8 = try
-		UTF8.validate str;
-		str;
-	with
-		UTF8.Malformed_code ->
-			(* ISO to utf8 *)
-			let b = UTF8.Buf.create 0 in
-			String.iter (fun c -> UTF8.Buf.add_char b (UCharExt.of_char c)) str;
-			UTF8.Buf.contents b
-	in
-	let ccount = ref 0 in
-	UTF8.iter (fun c ->
-		let c = UCharExt.code c in
-		if (c >= 0xD800 && c <= 0xDFFF) || c >= 0x110000 then Error.abort "Invalid unicode char" p;
-		incr ccount;
-		if c > 0x10000 then incr ccount;
-	) u8;
-	u8, !ccount
-
-let utf16_add buf c =
-	let add c =
-		Buffer.add_char buf (char_of_int (c land 0xFF));
-		Buffer.add_char buf (char_of_int (c lsr 8));
-	in
-	if c >= 0 && c < 0x10000 then begin
-		if c >= 0xD800 && c <= 0xDFFF then failwith ("Invalid unicode char " ^ string_of_int c);
-		add c;
-	end else if c < 0x110000 then begin
-		let c = c - 0x10000 in
-		add ((c asr 10) + 0xD800);
-		add ((c land 1023) + 0xDC00);
-	end else
-		failwith ("Invalid unicode char " ^ string_of_int c)
-
-let utf8_to_utf16 str zt =
-	let b = Buffer.create (String.length str * 2) in
-	(try UTF8.iter (fun c -> utf16_add b (UCharExt.code c)) str with Invalid_argument _ | UCharExt.Out_of_range -> ()); (* if malformed *)
-	if zt then utf16_add b 0;
-	Buffer.contents b
-
-let utf16_to_utf8 str =
-	let b = Buffer.create 0 in
-	let add c = Buffer.add_char b (char_of_int (c land 0xFF)) in
-	let get i = int_of_char (String.unsafe_get str i) in
-	let rec loop i =
-		if i >= String.length str then ()
-		else begin
-			let c = get i in
-			if c < 0x80 then begin
-				add c;
-				loop (i + 2);
-			end else if c < 0x800 then begin
-				let c = c lor ((get (i + 1)) lsl 8) in
-				add c;
-				add (c lsr 8);
-				loop (i + 2);
-			end else
-				die "" __LOC__;
-		end
-	in
-	loop 0;
-	Buffer.contents b
-
 let add_diagnostics_message ?(depth = 0) ?(code = None) com s p kind sev =
 	if sev = MessageSeverity.Error then com.has_error <- true;
 	let di = com.shared.shared_display_information in

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/core/stringHelper.ml

@@ -1,3 +1,6 @@
+open Globals
+open Extlib_leftovers
+
 let uppercase s =
 	let bytes = Bytes.of_string s in
 	Bytes.iteri
@@ -68,4 +71,88 @@ let extension file =
 		let dot_pos = String.rindex file '.' in
 		String.sub file dot_pos (String.length file - dot_pos)
 	with Not_found ->
-		file
+		file
+
+(* UTF8 *)
+
+let to_utf8 str p =
+	let u8 = try
+		UTF8.validate str;
+		str;
+	with
+		UTF8.Malformed_code ->
+			(* ISO to utf8 *)
+			let b = UTF8.Buf.create 0 in
+			String.iter (fun c -> UTF8.Buf.add_char b (UCharExt.of_char c)) str;
+			UTF8.Buf.contents b
+	in
+	let ccount = ref 0 in
+	UTF8.iter (fun c ->
+		let c = UCharExt.code c in
+		if (c >= 0xD800 && c <= 0xDFFF) || c >= 0x110000 then failwith "Invalid unicode char";
+		incr ccount;
+		if c > 0x10000 then incr ccount;
+	) u8;
+	u8, !ccount
+
+let utf16_add buf c =
+	let add c =
+		Buffer.add_char buf (char_of_int (c land 0xFF));
+		Buffer.add_char buf (char_of_int (c lsr 8));
+	in
+	if c >= 0 && c < 0x10000 then begin
+		if c >= 0xD800 && c <= 0xDFFF then failwith ("Invalid unicode char " ^ string_of_int c);
+		add c;
+	end else if c < 0x110000 then begin
+		let c = c - 0x10000 in
+		add ((c asr 10) + 0xD800);
+		add ((c land 1023) + 0xDC00);
+	end else
+		failwith ("Invalid unicode char " ^ string_of_int c)
+
+let utf8_to_utf16 str zt =
+	let b = Buffer.create (String.length str * 2) in
+	(try UTF8.iter (fun c -> utf16_add b (UCharExt.code c)) str with Invalid_argument _ | UCharExt.Out_of_range -> ()); (* if malformed *)
+	if zt then utf16_add b 0;
+	Buffer.contents b
+
+let utf16_to_utf8 str =
+	let b = Buffer.create 0 in
+	let add c = Buffer.add_char b (char_of_int (c land 0xFF)) in
+	let get i = int_of_char (String.unsafe_get str i) in
+	let rec loop i =
+		if i >= String.length str then ()
+		else begin
+			let c = get i in
+			if c < 0x80 then begin
+				add c;
+				loop (i + 2);
+			end else if c < 0x800 then begin
+				let c = c lor ((get (i + 1)) lsl 8) in
+				add c;
+				add (c lsr 8);
+				loop (i + 2);
+			end else
+				die "" __LOC__;
+		end
+	in
+	loop 0;
+	Buffer.contents b
+
+let url_encode s add_char =
+	let hex = "0123456789ABCDEF" in
+	for i = 0 to String.length s - 1 do
+		let c = String.unsafe_get s i in
+		match c with
+		| 'A'..'Z' | 'a'..'z' | '0'..'9' | '_' | '-' | '.' ->
+			add_char c
+		| _ ->
+			add_char '%';
+			add_char (String.unsafe_get hex (int_of_char c lsr 4));
+			add_char (String.unsafe_get hex (int_of_char c land 0xF));
+	done
+
+let url_encode_s s =
+	let b = Buffer.create 0 in
+	url_encode s (Buffer.add_char b);
+	Buffer.contents b

src/generators/gctx.ml

@@ -0,0 +1,88 @@
+open Globals
+open Type
+
+type t = {
+	platform : platform;
+	defines : Define.define;
+	class_paths : ClassPaths.class_paths;
+	run_command : string -> int;
+	run_command_args : string -> string list -> int;
+	basic : basic_types;
+	debug : bool;
+	file : string;
+	version : int;
+	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 defined com s =
+	Define.defined com.defines s
+
+let defined_value com v =
+	Define.defined_value com.defines v
+
+let define_value com k v =
+	Define.define_value com.defines k v
+
+let defined_value_safe ?default com v =
+	match default with
+		| Some s -> Define.defined_value_safe ~default:s com.defines v
+		| None -> Define.defined_value_safe com.defines v
+
+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
+
+let map_source_header com f =
+	match defined_value_safe com Define.SourceHeader with
+	| "" -> ()
+	| s -> f s