also port genhl to gctx

src/compiler/generate.ml

@@ -88,7 +88,9 @@ let generate ctx tctx ext actx =
 		| 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

@@ -416,8 +416,12 @@ let to_gctx com = {
 	Gctx.platform = com.platform;
 	defines = com.defines;
 	basic = com.basic;
+	class_path = com.class_path;
+	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;
@@ -1191,90 +1195,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/core/stringHelper.ml

@@ -1,3 +1,6 @@
+open Globals
+open Extlib_leftovers
+
 let uppercase s =
 	let bytes = Bytes.of_string s in
 	Bytes.iteri
@@ -57,4 +60,89 @@ let escape_res_name name allowed =
 		else if List.mem chr allowed then
 			Char.escaped chr
 		else
-			"-x" ^ (string_of_int (Char.code chr))) name
+			"-x" ^ (string_of_int (Char.code chr))) name
+
+
+(* 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

@@ -4,9 +4,13 @@ open Type
 type t = {
 	platform : platform;
 	defines : Define.define;
+	class_path : string list;
+	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;
@@ -16,6 +20,20 @@ type t = {
 	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
 
@@ -62,4 +80,9 @@ let get_entry_point gctx =
 		in
 		let e = Option.get gctx.main in (* must be present at this point *)
 		(snd path, c, e)
-	) gctx.main_class
+	) gctx.main_class
+
+let map_source_header com f =
+	match defined_value_safe com Define.SourceHeader with
+	| "" -> ()
+	| s -> f s

src/generators/genhl.ml

@@ -24,7 +24,7 @@ open Globals
 open Ast
 open Type
 open Error
-open Common
+open Gctx
 open Hlcode
 
 (* compiler *)
@@ -84,7 +84,7 @@ type constval =
 	| CString of string
 
 type context = {
-	com : Common.context;
+	com : Gctx.t;
 	cglobals : (string, ttype) lookup;
 	cstrings : (string, string) lookup;
 	cbytes : (bytes, bytes) lookup;
@@ -322,7 +322,7 @@ let set_curpos ctx p =
 
 let make_debug ctx arr =
 	let get_relative_path p =
-		match Common.defined ctx.com Common.Define.AbsolutePath with
+		match Gctx.defined ctx.com Define.AbsolutePath with
 		| true -> if (Filename.is_relative p.pfile)
 			then Filename.concat (Sys.getcwd()) p.pfile
 			else p.pfile
@@ -332,7 +332,7 @@ let make_debug ctx arr =
 			let base = List.find (fun path ->
 				let l = String.length path in
 				len > l && String.sub p.pfile 0 l = path
-			) ctx.com.Common.class_path in
+			) ctx.com.Gctx.class_path in
 			let l = String.length base in
 			String.sub p.pfile l (len - l)
 		with Not_found ->
@@ -3389,7 +3389,7 @@ let generate_static ctx c f =
 			| (Meta.HlNative,[(EConst(String(lib,_)),_)] ,_ ) :: _ ->
 				add_native lib f.cf_name
 			| (Meta.HlNative,[(EConst(Float(ver,_)),_)] ,_ ) :: _ ->
-				let cur_ver = (try Common.defined_value ctx.com Define.HlVer with Not_found -> "") in
+				let cur_ver = (try Gctx.defined_value ctx.com Define.HlVer with Not_found -> "") in
 				if cur_ver < ver then
 					let gen_content() =
 						op ctx (OThrow (make_string ctx ("Requires compiling with -D hl-ver=" ^ ver ^ ".0 or higher") null_pos));
@@ -4054,7 +4054,7 @@ let create_context com is_macro dump =
 	let ctx = {
 		com = com;
 		is_macro = is_macro;
-		optimize = not (Common.raw_defined com "hl_no_opt");
+		optimize = not (Gctx.raw_defined com "hl_no_opt");
 		dump_out = if dump then Some (IO.output_channel (open_out_bin "dump/hlopt.txt")) else None;
 		m = method_context 0 HVoid null_capture false;
 		cints = new_lookup();
@@ -4173,8 +4173,8 @@ let make_context_sign com =
 let prev_sign = ref "" and prev_data = ref ""
 
 let generate com =
-	let dump = Common.defined com Define.Dump in
-	let hl_check = Common.raw_defined com "hl_check" in
+	let dump = Gctx.defined com Define.Dump in
+	let hl_check = Gctx.raw_defined com "hl_check" in
 
 	let sign = make_context_sign com in
 	if sign = !prev_sign && not dump && not hl_check then begin
@@ -4194,7 +4194,7 @@ let generate com =
 		Hlcode.dump (fun s -> output_string ch (s ^ "\n")) code;
 		close_out ch;
 	end;
-	(*if Common.raw_defined com "hl_dump_spec" then begin
+	(*if Gctx.raw_defined com "hl_dump_spec" then begin
 		let ch = open_out_bin "dump/hlspec.txt" in
 		let write s = output_string ch (s ^ "\n") in
 		Array.iter (fun f ->
@@ -4220,19 +4220,19 @@ let generate com =
 	if Path.file_extension com.file = "c" then begin
 		let gnames = Array.make (Array.length code.globals) "" in
 		PMap.iter (fun n i -> gnames.(i) <- n) ctx.cglobals.map;
-		if not (Common.defined com Define.SourceHeader) then begin
+		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
-			Common.define_value com Define.SourceHeader (Printf.sprintf "Generated by HLC %d.%d.%d (HL v%d)" version_major version_minor version_revision code.version);
+			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;
 		let t = Timer.timer ["nativecompile";"hl"] in
-		if not (Common.defined com Define.NoCompilation) && com.run_command_args "haxelib" ["run";"hashlink";"build";escape_command com.file] <> 0 then failwith "Build failed";
+		if not (Gctx.defined com Define.NoCompilation) && com.run_command_args "haxelib" ["run";"hashlink";"build";escape_command com.file] <> 0 then failwith "Build failed";
 		t();
 	end else begin
 		let ch = IO.output_string() in
-		write_code ch code (not (Common.raw_defined com "hl_no_debug"));
+		write_code ch code (not (Gctx.raw_defined com "hl_no_debug"));
 		let str = IO.close_out ch in
 		let ch = open_out_bin com.file in
 		output_string ch str;
@@ -4242,10 +4242,10 @@ let generate com =
 	end;
 	Hlopt.clean_cache();
 	t();
-	if Common.raw_defined com "run" then begin
+	if Gctx.raw_defined com "run" then begin
 		if com.run_command_args "haxelib" ["run";"hashlink";"run";escape_command com.file] <> 0 then failwith "Failed to run HL";
 	end;
-	if Common.defined com Define.Interp then
+	if Gctx.defined com Define.Interp then
 		try
 			let t = Timer.timer ["generate";"hl";"interp"] in
 			let ctx = Hlinterp.create true in

src/generators/genjs.ml

@@ -2006,7 +2006,7 @@ let generate com =
 	| Some smap ->
 		write_mappings ctx.com smap "file:///";
 		let basefile = Filename.basename com.file in
-		print ctx "\n//# sourceMappingURL=%s.map" (url_encode_s basefile);
+		print ctx "\n//# sourceMappingURL=%s.map" (StringHelper.url_encode_s basefile);
 	| None -> try Sys.remove (com.file ^ ".map") with _ -> ());
 	flush ctx;
 	Option.may (fun chan -> close_out chan) ctx.chan