Browse Source

[compiler] juggle some more

Simon Krajewski 3 years ago
parent
commit
2631a2ce9e

+ 1 - 1
src/codegen/swfLoader.ml

@@ -545,7 +545,7 @@ let remove_debug_infos as3 =
 
 let parse_swf com file =
 	let t = Timer.timer ["read";"swf"] in
-	let is_swc = file_extension file = "swc" || file_extension file = "ane" in
+	let is_swc = Path.file_extension file = "swc" || Path.file_extension file = "ane" in
 	let ch = if is_swc then begin
 		let zip = Zip.open_in file in
 		try

+ 8 - 1
src/compiler/compilationContext.ml

@@ -57,4 +57,11 @@ type server_api = {
 	init_wait_stdio : unit -> server_accept;
 	wait_loop : bool -> server_accept -> int;
 	do_connect : string -> int -> string list -> unit;
-}
+}
+
+let message ctx msg =
+	ctx.messages <- msg :: ctx.messages
+
+let error ctx msg p =
+	message ctx (CMError(msg,p));
+	ctx.has_error <- true

+ 3 - 110
src/compiler/compiler.ml

@@ -2,21 +2,11 @@ open Extlib_leftovers
 open Globals
 open Common
 open CompilationContext
-open Type
 open DisplayException
 open DisplayTypes.CompletionResultKind
 
 exception Abort
 
-let message ctx msg =
-	ctx.messages <- msg :: ctx.messages
-
-let error ctx msg p =
-	message ctx (CMError(msg,p));
-	ctx.has_error <- true
-
-let delete_file f = try Sys.remove f with _ -> ()
-
 let initialize_target ctx com actx =
 	let add_std dir =
 		com.class_path <- List.filter (fun s -> not (List.mem s com.std_path)) com.class_path @ List.map (fun p -> p ^ dir ^ "/_std/") com.std_path @ com.std_path
@@ -162,7 +152,7 @@ let load_display_module_in_macro tctx display_file_dot_path clear = match displa
 					Hashtbl.remove mctx.com.module_lut cpath;
 					Hashtbl.remove mctx.com.type_to_module cpath;
 					List.iter (fun mt ->
-						let ti = t_infos mt in
+						let ti = Type.t_infos mt in
 						Hashtbl.remove mctx.com.module_lut ti.mt_path;
 						Hashtbl.remove mctx.com.type_to_module ti.mt_path;
 					) m.m_types
@@ -294,103 +284,6 @@ let filter ctx tctx display_file_dot_path =
 	Filters.run com tctx main;
 	t()
 
-let check_auxiliary_output com actx =
-	begin match actx.xml_out with
-		| None -> ()
-		| Some "hx" ->
-			Genhxold.generate com
-		| Some file ->
-			Common.log com ("Generating xml: " ^ file);
-			Path.mkdir_from_path file;
-			Genxml.generate com file
-	end;
-	begin match actx.json_out with
-		| None -> ()
-		| Some file ->
-			Common.log com ("Generating json : " ^ file);
-			Path.mkdir_from_path file;
-			Genjson.generate com.types file
-	end
-
-
-let parse_swf_header ctx h = match ExtString.String.nsplit h ":" with
-		| [width; height; fps] ->
-			Some (int_of_string width,int_of_string height,float_of_string fps,0xFFFFFF)
-		| [width; height; fps; color] ->
-			let color = if ExtString.String.starts_with color "0x" then color else "0x" ^ color in
-			Some (int_of_string width, int_of_string height, float_of_string fps, int_of_string color)
-		| _ ->
-			error ctx "Invalid SWF header format, expected width:height:fps[:color]" null_pos;
-			None
-
-let generate ctx tctx ext actx =
-	let com = tctx.Typecore.com in
-	(* check file extension. In case of wrong commandline, we don't want
-		to accidentaly delete a source file. *)
-	if file_extension com.file = ext then delete_file com.file;
-	if com.platform = Flash || com.platform = Cpp || com.platform = Hl then List.iter (Codegen.fix_overrides com) com.types;
-	if Common.defined com Define.Dump then begin
-		Codegen.Dump.dump_types com;
-		Option.may Codegen.Dump.dump_types (com.get_macros())
-	end;
-	if Common.defined com Define.DumpDependencies then begin
-		Codegen.Dump.dump_dependencies com;
-		if not com.is_macro_context then match tctx.Typecore.g.Typecore.macros with
-			| None -> ()
-			| Some(_,ctx) -> Codegen.Dump.dump_dependencies ~target_override:(Some "macro") ctx.Typecore.com
-	end;
-	begin match com.platform with
-		| Neko | Hl | Eval when actx.interp -> ()
-		| Cpp when Common.defined com Define.Cppia -> ()
-		| Cpp | Cs | Php -> Path.mkdir_from_path (com.file ^ "/.")
-		| Java when not actx.jvm_flag -> Path.mkdir_from_path (com.file ^ "/.")
-		| _ -> Path.mkdir_from_path com.file
-	end;
-	if actx.interp then
-		Std.finally (Timer.timer ["interp"]) MacroContext.interpret tctx
-	else if com.platform = Cross then
-		()
-	else begin
-		let generate,name = match com.platform with
-		| Flash ->
-			let header = try
-				parse_swf_header ctx (defined_value com Define.SwfHeader)
-			with Not_found ->
-				None
-			in
-			Genswf.generate header,"swf"
-		| Neko ->
-			Genneko.generate,"neko"
-		| Js ->
-			Genjs.generate,"js"
-		| Lua ->
-			Genlua.generate,"lua"
-		| Php ->
-			Genphp7.generate,"php"
-		| Cpp ->
-			Gencpp.generate,"cpp"
-		| Cs ->
-			Gencs.generate,"cs"
-		| Java ->
-			if Common.defined com Jvm then
-				Genjvm.generate actx.jvm_flag,"java"
-			else
-				Genjava.generate,"java"
-		| Python ->
-			Genpy.generate,"python"
-		| Hl ->
-			Genhl.generate,"hl"
-		| Eval ->
-			(fun _ -> MacroContext.interpret tctx),"eval"
-		| Cross ->
-			die "" __LOC__
-		in
-		Common.log com ("Generating " ^ name ^ ": " ^ com.file);
-		let t = Timer.timer ["generate";name] in
-		generate com;
-		t()
-	end
-
 let run_command ctx cmd =
 	let t = Timer.timer ["command"] in
 	(* TODO: this is a hack *)
@@ -547,9 +440,9 @@ let compile ctx actx =
 		handle_display ctx tctx display_file_dot_path;
 		filter ctx tctx display_file_dot_path;
 		if ctx.has_error then raise Abort;
-		check_auxiliary_output com actx;
+		Generate.check_auxiliary_output com actx;
 		com.stage <- CGenerationStart;
-		if not actx.no_output then generate ctx tctx ext actx;
+		if not actx.no_output then Generate.generate ctx tctx ext actx;
 		com.stage <- CGenerationDone;
 	end;
 	Sys.catch_break false;

+ 101 - 0
src/compiler/generate.ml

@@ -0,0 +1,101 @@
+open Globals
+open CompilationContext
+
+let check_auxiliary_output com actx =
+	begin match actx.xml_out with
+		| None -> ()
+		| Some "hx" ->
+			Genhxold.generate com
+		| Some file ->
+			Common.log com ("Generating xml: " ^ file);
+			Path.mkdir_from_path file;
+			Genxml.generate com file
+	end;
+	begin match actx.json_out with
+		| None -> ()
+		| Some file ->
+			Common.log com ("Generating json : " ^ file);
+			Path.mkdir_from_path file;
+			Genjson.generate com.types file
+	end
+
+
+let parse_swf_header ctx h = match ExtString.String.nsplit h ":" with
+		| [width; height; fps] ->
+			Some (int_of_string width,int_of_string height,float_of_string fps,0xFFFFFF)
+		| [width; height; fps; color] ->
+			let color = if ExtString.String.starts_with color "0x" then color else "0x" ^ color in
+			Some (int_of_string width, int_of_string height, float_of_string fps, int_of_string color)
+		| _ ->
+			error ctx "Invalid SWF header format, expected width:height:fps[:color]" null_pos;
+			None
+
+let delete_file f = try Sys.remove f with _ -> ()
+
+let generate ctx tctx ext actx =
+	let com = tctx.Typecore.com in
+	(* check file extension. In case of wrong commandline, we don't want
+		to accidentaly delete a source file. *)
+	if Path.file_extension com.file = ext then delete_file com.file;
+	if com.platform = Flash || com.platform = Cpp || com.platform = Hl then List.iter (Codegen.fix_overrides com) com.types;
+	if Common.defined com Define.Dump then begin
+		Codegen.Dump.dump_types com;
+		Option.may Codegen.Dump.dump_types (com.get_macros())
+	end;
+	if Common.defined com Define.DumpDependencies then begin
+		Codegen.Dump.dump_dependencies com;
+		if not com.is_macro_context then match tctx.Typecore.g.Typecore.macros with
+			| None -> ()
+			| Some(_,ctx) -> Codegen.Dump.dump_dependencies ~target_override:(Some "macro") ctx.Typecore.com
+	end;
+	begin match com.platform with
+		| Neko | Hl | Eval when actx.interp -> ()
+		| Cpp when Common.defined com Define.Cppia -> ()
+		| Cpp | Cs | Php -> Path.mkdir_from_path (com.file ^ "/.")
+		| Java when not actx.jvm_flag -> Path.mkdir_from_path (com.file ^ "/.")
+		| _ -> Path.mkdir_from_path com.file
+	end;
+	if actx.interp then
+		Std.finally (Timer.timer ["interp"]) MacroContext.interpret tctx
+	else if com.platform = Cross then
+		()
+	else begin
+		let generate,name = match com.platform with
+		| Flash ->
+			let header = try
+				parse_swf_header ctx (Common.defined_value com Define.SwfHeader)
+			with Not_found ->
+				None
+			in
+			Genswf.generate header,"swf"
+		| Neko ->
+			Genneko.generate,"neko"
+		| Js ->
+			Genjs.generate,"js"
+		| Lua ->
+			Genlua.generate,"lua"
+		| Php ->
+			Genphp7.generate,"php"
+		| Cpp ->
+			Gencpp.generate,"cpp"
+		| Cs ->
+			Gencs.generate,"cs"
+		| Java ->
+			if Common.defined com Jvm then
+				Genjvm.generate actx.jvm_flag,"java"
+			else
+				Genjava.generate,"java"
+		| Python ->
+			Genpy.generate,"python"
+		| Hl ->
+			Genhl.generate,"hl"
+		| Eval ->
+			(fun _ -> MacroContext.interpret tctx),"eval"
+		| Cross ->
+			die "" __LOC__
+		in
+		Common.log com ("Generating " ^ name ^ ": " ^ com.file);
+		let t = Timer.timer ["generate";name] in
+		generate com;
+		t()
+	end

+ 1 - 1
src/compiler/server.ml

@@ -384,7 +384,7 @@ let check_module sctx ctx m p =
 		let check () =
 			try
 				if not (has_policy NoCheckShadowing) then check_module_path();
-				if not (has_policy NoCheckFileTimeModification) || file_extension (Path.UniqueKey.lazy_path m.m_extra.m_file) <> "hx" then check_file();
+				if not (has_policy NoCheckFileTimeModification) || Path.file_extension (Path.UniqueKey.lazy_path m.m_extra.m_file) <> "hx" then check_file();
 				if not (has_policy NoCheckDependencies) then check_dependencies();
 				None
 			with

+ 1 - 6
src/context/common.ml

@@ -845,11 +845,6 @@ let clone com is_macro_context =
 
 let file_time file = Extc.filetime file
 
-let file_extension file =
-	match List.rev (ExtString.String.nsplit file ".") with
-	| e :: _ -> String.lowercase e
-	| [] -> ""
-
 let flash_versions = List.map (fun v ->
 	let maj = int_of_float v in
 	let min = int_of_float (mod_float (v *. 10.) 10.) in
@@ -909,7 +904,7 @@ let set_platform com pf file =
 	if com.platform <> Cross then failwith "Multiple targets";
 	init_platform com pf;
 	com.file <- file;
-	if (pf = Flash) && file_extension file = "swc" then define com Define.Swc;
+	if (pf = Flash) && Path.file_extension file = "swc" then define com Define.Swc;
 	(* Set the source header, unless the user has set one already or the platform sets a custom one *)
 	if not (defined com Define.SourceHeader) && (pf <> Hl) then
 		define_value com Define.SourceHeader ("Generated by Haxe " ^ s_version_full)

+ 1 - 1
src/context/display/displayPath.ml

@@ -53,7 +53,7 @@ module TypePathHandler = struct
 						else
 							packages := f :: !packages
 					end;
-				end else if file_extension f = "hx" && f <> "import.hx" then begin
+				end else if Path.file_extension f = "hx" && f <> "import.hx" then begin
 					let c = Filename.chop_extension f in
 					try
 						ignore(String.index c '.')

+ 5 - 0
src/core/path.ml

@@ -376,6 +376,11 @@ let mkdir_from_path path =
 let full_dot_path pack mname tname =
 	if tname = mname then (pack,mname) else (pack @ [mname],tname)
 
+let file_extension file =
+	match List.rev (ExtString.String.nsplit file ".") with
+	| e :: _ -> String.lowercase e
+	| [] -> ""
+
 module FilePath = struct
 	type t = {
 		directory : string option;

+ 1 - 1
src/generators/genhl.ml

@@ -4132,7 +4132,7 @@ let generate com =
 		"\"" ^ Buffer.contents b ^ "\""
 	in
 
-	if file_extension com.file = "c" then begin
+	if Path.file_extension com.file = "c" then begin
 		let gnames = Array.create (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