[compiler] move haxelib handling to HighLevel

src/compiler/args.ml

@@ -25,52 +25,6 @@ let usage_string ?(print_cat=true) arg_spec usage =
 		Printf.sprintf "  %s%s  %s" label (String.make (max_length - (String.length label)) ' ') doc
 	) (List.filter (fun (cat', _, _, _, _, _) -> (if List.mem cat' cat_order then cat' else "Miscellaneous") = cat) args))) cats)))
 
-let add_libs com libs =
-	let global_repo = List.exists (fun a -> a = "--haxelib-global") com.args in
-	let call_haxelib() =
-		let t = Timer.timer ["haxelib"] in
-		let cmd = "haxelib" ^ (if global_repo then " --global" else "") ^ " path " ^ String.concat " " libs in
-		let pin, pout, perr = Unix.open_process_full cmd (Unix.environment()) in
-		let lines = Std.input_list pin in
-		let err = Std.input_list perr in
-		let ret = Unix.close_process_full (pin,pout,perr) in
-		if ret <> Unix.WEXITED 0 then failwith (match lines, err with
-			| [], [] -> "Failed to call haxelib (command not found ?)"
-			| [], [s] when ExtString.String.ends_with (ExtString.String.strip s) "Module not found: path" -> "The haxelib command has been strip'ed, please install it again"
-			| _ -> String.concat "\n" (lines@err));
-		t();
-		lines
-	in
-	match libs with
-	| [] -> []
-	| _ ->
-		let lines =
-			try
-				(* if we are compiling, really call haxelib since library path might have changed *)
-				if com.display.dms_full_typing then raise Not_found;
-				com.cs#find_haxelib libs
-			with Not_found ->
-				let lines = call_haxelib() in
-				com.cs#cache_haxelib libs lines;
-				lines
-		in
-		let extra_args = ref [] in
-		let lines = List.fold_left (fun acc l ->
-			let l = ExtString.String.strip l in
-			if l = "" then acc else
-			if l.[0] <> '-' then l :: acc else
-			match (try ExtString.String.split l " " with _ -> l, "") with
-			| ("-L",dir) ->
-				com.neko_libs <- String.sub l 3 (String.length l - 3) :: com.neko_libs;
-				acc
-			| param, value ->
-				extra_args := param :: !extra_args;
-				if value <> "" then extra_args := value :: !extra_args;
-				acc
-		) [] lines in
-		com.class_path <- lines @ com.class_path;
-		List.rev !extra_args
-
 let process_args arg_spec =
 	(* Takes a list of arg specs including some custom info, and generates a
 	list in the format Arg.parse_argv wants. Handles multiple official or
@@ -105,8 +59,6 @@ let parse_args com =
 		swf_header = None;
 		cmds = [];
 		config_macros = [];
-		cp_libs = [];
-		added_libs = Hashtbl.create 0;
 		no_output = false;
 		did_something = false;
 		force_typing = false;
@@ -120,16 +72,6 @@ let parse_args com =
 	} in
 	let add_native_lib file extern = actx.native_libs <- (file,extern) :: actx.native_libs in
 	let define f = Arg.Unit (fun () -> Common.define com f) in
-	let process_ref = ref (fun args -> ()) in
-	let process_libs() =
-		let libs = List.filter (fun l -> not (Hashtbl.mem actx.added_libs l)) (List.rev actx.cp_libs) in
-		actx.cp_libs <- [];
-		List.iter (fun l -> Hashtbl.add actx.added_libs l ()) libs;
-		(* immediately process the arguments to insert them at the place -lib was defined *)
-		match add_libs com libs with
-		| [] -> ()
-		| args -> (!process_ref) args
-	in
 	(* category, official names, deprecated names, arg spec, usage hint, doc *)
 	let basic_args_spec = [
 		("Target",["--js"],["-js"],Arg.String (set_platform com Js),"<file>","generate JavaScript code into target file");
@@ -148,15 +90,12 @@ let parse_args com =
 			set_platform com Cpp file;
 		),"<file>","generate Cppia bytecode into target file");
 		("Target",["--cs"],["-cs"],Arg.String (fun dir ->
-			actx.cp_libs <- "hxcs" :: actx.cp_libs;
 			set_platform com Cs dir;
 		),"<directory>","generate C# code into target directory");
 		("Target",["--java"],["-java"],Arg.String (fun dir ->
-			actx.cp_libs <- "hxjava" :: actx.cp_libs;
 			set_platform com Java dir;
 		),"<directory>","generate Java code into target directory");
 		("Target",["--jvm"],[],Arg.String (fun dir ->
-			actx.cp_libs <- "hxjava" :: actx.cp_libs;
 			Common.define com Define.Jvm;
 			actx.jvm_flag <- true;
 			set_platform com Java dir;
@@ -186,7 +125,6 @@ let parse_args com =
 			raise (Arg.Bad "--run requires an argument: a Haxe module name")
 		), "<module> [args...]","interpret a Haxe module with command line arguments");
 		("Compilation",["-p";"--class-path"],["-cp"],Arg.String (fun path ->
-			process_libs();
 			com.class_path <- Path.add_trailing_slash path :: com.class_path
 		),"<path>","add a directory to find source files");
 		("Compilation",["-m";"--main"],["-main"],Arg.String (fun cl ->
@@ -195,10 +133,6 @@ let parse_args com =
 			com.main_class <- Some cpath;
 			actx.classes <- cpath :: actx.classes
 		),"<class>","select startup class");
-		("Compilation",["-L";"--library"],["-lib"],Arg.String (fun l ->
-			actx.cp_libs <- l :: actx.cp_libs;
-			Common.external_define com l;
-		),"<name[:ver]>","use a haxelib library");
 		("Compilation",["-D";"--define"],[],Arg.String (fun var ->
 			let flag, value = try let split = ExtString.String.split var "=" in (fst split, Some (snd split)) with _ -> var, None in
 			match value with
@@ -258,9 +192,11 @@ let parse_args com =
 		),"<header>","define SWF header (width:height:fps:color)");
 		("Target-specific",["--flash-strict"],[], define Define.FlashStrict, "","more type strict flash API");
 		("Target-specific",["--swf-lib"],["-swf-lib"],Arg.String (fun file ->
-			process_libs(); (* linked swf order matters, and lib might reference swf as well *)
 			add_native_lib file false;
 		),"<file>","add the SWF library to the compiled SWF");
+		("Target-specific",["--neko-lib"],[],Arg.String (fun file ->
+			com.neko_libs <- file :: com.neko_libs
+		),"<file>","add the neko library");
 		(* FIXME: replace with -D define *)
 		("Target-specific",["--swf-lib-extern"],["-swf-lib-extern"],Arg.String (fun file ->
 			add_native_lib file true;
@@ -427,9 +363,6 @@ let parse_args com =
 		end;
 	in
 	actx.raise_usage <- (fun () -> raise (Helper.HelpMessage (usage_string basic_args_spec usage)));
-	process_ref := process;
 	(* Handle CLI arguments *)
 	process com.args;
-	(* Process haxelibs *)
-	process_libs();
 	actx

src/compiler/compilationContext.ml

@@ -12,8 +12,6 @@ type arg_context = {
 	mutable swf_header : (int * int * float * int) option;
 	mutable cmds : string list;
 	mutable config_macros : string list;
-	mutable cp_libs : string list;
-	added_libs : (string,unit) Hashtbl.t;
 	mutable no_output : bool;
 	mutable did_something : bool;
 	mutable force_typing : bool;

src/compiler/compiler.ml

@@ -760,18 +760,78 @@ let create_context comm cs compilation_step params = {
 }
 
 module HighLevel = struct
+	let add_libs libs args cs has_display =
+		let global_repo = List.exists (fun a -> a = "--haxelib-global") args in
+		let fail msg =
+			raise (Arg.Bad msg)
+		in
+		let call_haxelib() =
+			let t = Timer.timer ["haxelib"] in
+			let cmd = "haxelib" ^ (if global_repo then " --global" else "") ^ " path " ^ String.concat " " libs in
+			let pin, pout, perr = Unix.open_process_full cmd (Unix.environment()) in
+			let lines = Std.input_list pin in
+			let err = Std.input_list perr in
+			let ret = Unix.close_process_full (pin,pout,perr) in
+			if ret <> Unix.WEXITED 0 then fail (match lines, err with
+				| [], [] -> "Failed to call haxelib (command not found ?)"
+				| [], [s] when ExtString.String.ends_with (ExtString.String.strip s) "Module not found: path" -> "The haxelib command has been strip'ed, please install it again"
+				| _ -> String.concat "\n" (lines@err));
+			t();
+			lines
+		in
+		match libs with
+		| [] ->
+			[]
+		| _ ->
+			let lines =
+				try
+					(* if we are compiling, really call haxelib since library path might have changed *)
+					if not has_display then raise Not_found;
+					cs#find_haxelib libs
+				with Not_found -> try
+					let lines = call_haxelib() in
+					cs#cache_haxelib libs lines;
+					lines
+				with Unix.Unix_error(code,msg,arg) ->
+					fail ((Printf.sprintf "%s (%s)" (Unix.error_message code) arg))
+			in
+			let lines = List.fold_left (fun acc l ->
+				let l = ExtString.String.strip l in
+				if l = "" then
+					acc
+				else if l.[0] <> '-' then
+					"-cp" :: l :: acc
+				else match (try ExtString.String.split l " " with _ -> l, "") with
+				| ("-L",dir) ->
+					"--neko-lib" :: (String.sub l 3 (String.length l - 3)) :: acc
+				| param, value ->
+					let acc = if value <> "" then value :: acc else acc in
+					let acc = param :: acc in
+					acc
+			) [] lines in
+			lines
+
 	(* Returns a list of contexts, but doesn't do anything yet *)
 	let process_params server_api create pl =
 		let each_params = ref [] in
 		let compilations = DynArray.create () in
 		let curdir = Unix.getcwd () in
+		let has_display = ref false in
+		let added_libs = Hashtbl.create 0 in
 		let add_context args =
 			let ctx = create (server_api.on_context_create()) args in
 			(* --cwd triggers immediately, so let's reset *)
 			Unix.chdir curdir;
 			DynArray.add compilations ctx;
+			Hashtbl.clear added_libs;
 			ctx;
 		in
+		let rec find_subsequent_libs acc args = match args with
+		| ("-L" | "--library" | "-lib") :: name :: args ->
+			find_subsequent_libs (name :: acc) args
+		| _ ->
+			List.rev acc,args
+		in
 		let rec loop acc = function
 			| [] ->
 				ignore(add_context (!each_params @ (List.rev acc)));
@@ -796,16 +856,31 @@ module HighLevel = struct
 				let acc = cl :: "-x" :: acc in
 				let ctx = add_context (!each_params @ (List.rev acc)) in
 				ctx.com.sys_args <- args;
+			| ("-L" | "--library" | "-lib") :: name :: args ->
+				let libs,args = find_subsequent_libs [name] args in
+				let libs = List.filter (fun l -> not (Hashtbl.mem added_libs l)) libs in
+				List.iter (fun l -> Hashtbl.add added_libs l ()) libs;
+				let lines = add_libs libs pl server_api.cache !has_display in
+				loop acc (lines @ args)
+			| ("--jvm" | "--java" | "-java" as arg) :: dir :: args ->
+				loop_lib arg dir "hxjava" acc args
+			| ("--cs" | "-cs" as arg) :: dir :: args ->
+				loop_lib arg dir "hxcs" acc args
 			| arg :: l ->
 				match List.rev (ExtString.String.nsplit arg ".") with
 				| "hxml" :: _ when (match acc with "-cmd" :: _ | "--cmd" :: _ -> false | _ -> true) ->
 					let acc, l = (try acc, Helper.parse_hxml arg @ l with Not_found -> (arg ^ " (file not found)") :: acc, l) in
 					loop acc l
-				| _ -> loop (arg :: acc) l
+				| _ ->
+					loop (arg :: acc) l
+		and loop_lib arg dir lib acc args =
+			loop (dir :: arg :: acc) ("-lib" :: lib :: args)
 		in
 		(* put --display in front if it was last parameter *)
 		let pl = (match List.rev pl with
-			| file :: "--display" :: pl when file <> "memory" -> "--display" :: file :: List.rev pl
+			| file :: "--display" :: pl when file <> "memory" ->
+				has_display := true;
+				"--display" :: file :: List.rev pl
 			| _ -> pl
 		) in
 		loop [] pl;