Add class_path as a record type (#11477)

* add class_path as a record type

* one thing led to another...

* add secret -libcp CLI argument to distinguish library class paths

We don't know the name of the lib though because haxelib doesn't tell us in an obvious way, and I can't be parsed to arse it out of the preceeding -D or something...

* embrace plural

* don't debug

* make find_file control flow a bit less silly

* check current file while caching so we don't have to find it afterwards

* do we actually need this special case?

Since we always have the empty class path anyway, this should just work via normal recursion. Maybe.

* store class path alongside file

* so that's what that does

src/compiler/args.ml

@@ -126,7 +126,10 @@ 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 ->
-			com.class_path <- Path.add_trailing_slash path :: com.class_path
+			com.class_paths#add (new ClassPath.directory_class_path (Path.add_trailing_slash path) User);
+		),"<path>","add a directory to find source files");
+		("Compilation",[],["-libcp"],Arg.String (fun path ->
+			com.class_paths#add (new ClassPath.directory_class_path (Path.add_trailing_slash path) Lib);
 		),"<path>","add a directory to find source files");
 		("Compilation",["-m";"--main"],["-main"],Arg.String (fun cl ->
 			if com.main_class <> None then raise (Arg.Bad "Multiple --main classes specified");

src/compiler/compilationCache.ml

@@ -1,11 +1,12 @@
 open Globals
 open Ast
+open Path
 open Json
 open Type
 open Define
 
 type cached_file = {
-	c_file_path : string;
+	c_file_path : ClassPaths.resolved_file;
 	c_time : float;
 	c_package : string list;
 	c_decls : type_decl list;
@@ -120,13 +121,13 @@ class cache = object(self)
 			Hashtbl.add contexts sign cache;
 			cache
 
-	method add_info sign desc platform class_path defines =
+	method add_info sign desc platform (class_paths : ClassPaths.class_paths) defines =
 		let cc = self#get_context sign in
 		let jo = JObject [
 			"index",JInt cc#get_index;
 			"desc",JString desc;
 			"platform",JString (platform_name platform);
-			"classPaths",JArray (List.map (fun s -> JString s) class_path);
+			"classPaths",JArray (List.map (fun s -> JString s) class_paths#as_string_list);
 			"signature",JString (Digest.to_hex sign);
 			"defines",JArray (PMap.foldi (fun k v acc -> JObject [
 				"key",JString k;

src/compiler/compiler.ml

@@ -78,8 +78,15 @@ let run_command ctx cmd =
 module Setup = struct
 	let initialize_target ctx com actx =
 		init_platform com;
+		com.class_paths#lock_context (platform_name com.platform) false;
 		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
+			com.class_paths#modify_inplace (fun cp -> match cp#scope with
+				| Std ->
+					let cp' = new ClassPath.directory_class_path (cp#path ^ dir ^ "/_std/") StdTarget in
+					cp :: [cp']
+				| _ ->
+					[cp]
+			);
 		in
 		match com.platform with
 			| Cross ->
@@ -170,7 +177,6 @@ module Setup = struct
 
 	let create_typer_context ctx macros =
 		let com = ctx.com in
-		Common.log com ("Classpath: " ^ (String.concat ";" com.class_path));
 		let buffer = Buffer.create 64 in
 		Buffer.add_string buffer "Defines: ";
 		PMap.iter (fun k v -> match v with
@@ -185,6 +191,8 @@ module Setup = struct
 	let executable_path() =
 		Extc.executable_path()
 
+	open ClassPath
+
 	let get_std_class_paths () =
 		try
 			let p = Sys.getenv "HAXE_STD_PATH" in
@@ -198,25 +206,30 @@ module Setup = struct
 					l
 			in
 			let parts = Str.split_delim (Str.regexp "[;:]") p in
-			"" :: List.map Path.add_trailing_slash (loop parts)
+			List.map (fun s -> Path.add_trailing_slash s,Std) (loop parts)
 		with Not_found ->
 			let base_path = Path.get_real_path (try executable_path() with _ -> "./") in
 			if Sys.os_type = "Unix" then
 				let prefix_path = Filename.dirname base_path in
 				let lib_path = Filename.concat prefix_path "lib" in
 				let share_path = Filename.concat prefix_path "share" in
 				[
-					"";
-					Path.add_trailing_slash (Filename.concat share_path "haxe/std");
-					Path.add_trailing_slash (Filename.concat lib_path "haxe/std");
-					Path.add_trailing_slash (Filename.concat base_path "std");
+					(Path.add_trailing_slash (Filename.concat share_path "haxe/std"),Std);
+					(Path.add_trailing_slash (Filename.concat lib_path "haxe/std"),Std);
+					(Path.add_trailing_slash (Filename.concat base_path "std"),Std);
 				]
 			else
 				[
-					"";
-					Path.add_trailing_slash (Filename.concat base_path "std");
+					(Path.add_trailing_slash (Filename.concat base_path "std"),Std);
 				]
 
+	let init_std_class_paths com =
+		com.class_paths#add com.empty_class_path;
+		List.iter (fun (s,scope) ->
+			let cp = new ClassPath.directory_class_path s scope in
+			com.class_paths#add cp
+		) (List.rev (get_std_class_paths ()))
+
 	let setup_common_context ctx =
 		let com = ctx.com in
 		ctx.com.print <- ctx.comm.write_out;
@@ -256,8 +269,7 @@ module Setup = struct
 		) (filter_messages false (fun _ -> true))));
 		com.filter_messages <- (fun predicate -> (ctx.messages <- (List.rev (filter_messages true predicate))));
 		com.run_command <- run_command ctx;
-		com.class_path <- get_std_class_paths ();
-		com.std_path <- List.filter (fun p -> ExtString.String.ends_with p "std/" || ExtString.String.ends_with p "std\\") com.class_path
+		init_std_class_paths com
 
 end
 
@@ -530,7 +542,7 @@ module HighLevel = struct
 				if l = "" then
 					acc
 				else if l.[0] <> '-' then
-					"-cp" :: l :: acc
+					"-libcp" :: l :: acc
 				else match (try ExtString.String.split l " " with _ -> l, "") with
 				| ("-L",dir) ->
 					"--neko-lib-path" :: (String.sub l 3 (String.length l - 3)) :: acc

src/compiler/displayProcessing.ml

@@ -121,6 +121,7 @@ let process_display_file com actx =
 		let rec loop = function
 			| [] -> None
 			| cp :: l ->
+				let cp = cp#path in
 				let cp = (if cp = "" then "./" else cp) in
 				let c = Path.add_trailing_slash (Path.get_real_path cp) in
 				let clen = String.length c in
@@ -135,7 +136,7 @@ let process_display_file com actx =
 				end else
 					loop l
 		in
-		loop com.class_path
+		loop com.class_paths#as_list
 	in
 	match com.display.dms_display_file_policy with
 		| DFPNo ->
@@ -223,7 +224,7 @@ let load_display_module_in_macro tctx display_file_dot_path clear = match displa
 
 let load_display_file_standalone (ctx : Typecore.typer) file =
 	let com = ctx.com in
-	let pack,decls = TypeloadParse.parse_module_file com file null_pos in
+	let pack,decls = TypeloadParse.parse_module_file com (ClassPaths.create_resolved_file file ctx.com.empty_class_path) null_pos in
 	let path = Path.FilePath.parse file in
 	let name = match path.file_name with
 		| None -> "?DISPLAY"
@@ -236,7 +237,7 @@ let load_display_file_standalone (ctx : Typecore.typer) file =
 			let parts = ExtString.String.nsplit dir (if path.backslash then "\\" else "/") in
 			let parts = List.rev (ExtList.List.drop (List.length pack) (List.rev parts)) in
 			let dir = ExtString.String.join (if path.backslash then "\\" else "/") parts in
-			com.class_path <- dir :: com.class_path
+			com.class_paths#add (new ClassPath.directory_class_path dir User)
 	end;
 	ignore(TypeloadModule.type_module ctx (pack,name) file ~dont_check_path:true decls null_pos)
 
@@ -318,7 +319,7 @@ let process_global_display_mode com tctx =
 		let symbols =
 			let l = cs#get_context_files ((Define.get_signature com.defines) :: (match com.get_macros() with None -> [] | Some com -> [Define.get_signature com.defines])) in
 			List.fold_left (fun acc (file_key,cfile) ->
-				let file = cfile.c_file_path in
+				let file = cfile.c_file_path.file in
 				if (filter <> None || DisplayPosition.display_position#is_in_file (com.file_keys#get file)) then
 					(file,DocumentSymbols.collect_module_symbols (Some (file,get_module_name_of_cfile file cfile)) (filter = None) (cfile.c_package,cfile.c_decls)) :: acc
 				else

src/compiler/messageReporting.ml

@@ -54,13 +54,13 @@ let resolve_source file l1 p1 l2 p2 =
 	List.rev !lines
 
 let resolve_file ctx f =
-		let ext = Common.extension f in
-		let second_ext = Common.extension (Common.remove_extension f) in
-		let platform_ext = "." ^ (platform_name_macro ctx) in
-		if platform_ext = second_ext then
-			(Common.remove_extension (Common.remove_extension f)) ^ ext
-		else
-			f
+	let ext = StringHelper.extension f in
+	let second_ext = StringHelper.extension (StringHelper.remove_extension f) in
+	let platform_ext = "." ^ (platform_name_macro ctx) in
+	if platform_ext = second_ext then
+		(StringHelper.remove_extension (StringHelper.remove_extension f)) ^ ext
+	else
+		f
 
 let error_printer file line = Printf.sprintf "%s:%d:" file line
 

src/compiler/server.ml

@@ -41,9 +41,10 @@ let check_display_flush ctx f_otherwise = match ctx.com.json_out with
 
 let current_stdin = ref None
 
-let parse_file cs com file p =
+let parse_file cs com (rfile : ClassPaths.resolved_file) p =
 	let cc = CommonCache.get_cache com in
-	let ffile = Path.get_full_path file
+	let file = rfile.file in
+	let ffile = Path.get_full_path rfile.file
 	and fkey = com.file_keys#get file in
 	let is_display_file = DisplayPosition.display_position#is_in_file (com.file_keys#get ffile) in
 	match is_display_file, !current_stdin with
@@ -57,15 +58,15 @@ let parse_file cs com file p =
 				if cfile.c_time <> ftime then raise Not_found;
 				Parser.ParseSuccess((cfile.c_package,cfile.c_decls),false,cfile.c_pdi)
 			with Not_found ->
-				let parse_result = TypeloadParse.parse_file com file p in
+				let parse_result = TypeloadParse.parse_file com rfile p in
 				let info,is_unusual = match parse_result with
 					| ParseError(_,_,_) -> "not cached, has parse error",true
 					| ParseSuccess(data,is_display_file,pdi) ->
 						if is_display_file then begin
 							if pdi.pd_errors <> [] then
 								"not cached, is display file with parse errors",true
 							else if com.display.dms_per_file then begin
-								cc#cache_file fkey ffile ftime data pdi;
+								cc#cache_file fkey rfile ftime data pdi;
 								"cached, is intact display file",true
 							end else
 								"not cached, is display file",true
@@ -76,7 +77,7 @@ let parse_file cs com file p =
 							let ident = Hashtbl.find Parser.special_identifier_files fkey in
 							Printf.sprintf "not cached, using \"%s\" define" ident,true
 						with Not_found ->
-							cc#cache_file fkey ffile ftime data pdi;
+							cc#cache_file fkey rfile ftime data pdi;
 							"cached",false
 						end
 				in
@@ -208,8 +209,9 @@ let get_changed_directories sctx (ctx : Typecore.typer) =
 					with Unix.Unix_error _ ->
 						()
 				in
-				List.iter add_dir com.class_path;
-				List.iter add_dir (Path.find_directories (platform_name com.platform) true com.class_path);
+				let class_path_strings = com.class_paths#as_string_list in
+				List.iter add_dir class_path_strings;
+				List.iter add_dir (Path.find_directories (platform_name com.platform) true class_path_strings);
 				ServerMessage.found_directories com "" !dirs;
 				cs#add_directories sign !dirs
 			) :: sctx.delays;
@@ -461,15 +463,16 @@ let after_target_init sctx ctx =
 	ServerMessage.defines com "";
 	ServerMessage.signature com "" sign;
 	ServerMessage.display_position com "" (DisplayPosition.display_position#get);
+	let class_path_strings = com.class_paths#as_string_list in
 	try
-		if (Hashtbl.find sctx.class_paths sign) <> com.class_path then begin
+		if (Hashtbl.find sctx.class_paths sign) <> class_path_strings then begin
 			ServerMessage.class_paths_changed com "";
-			Hashtbl.replace sctx.class_paths sign com.class_path;
+			Hashtbl.replace sctx.class_paths sign class_path_strings;
 			cs#clear_directories sign;
 			(cs#get_context sign)#set_initialized false;
 		end;
 	with Not_found ->
-		Hashtbl.add sctx.class_paths sign com.class_path;
+		Hashtbl.add sctx.class_paths sign class_path_strings;
 		()
 
 let after_compilation sctx ctx =