瀏覽代碼

[display] support display in random files outside the class path

Simon Krajewski 6 年之前
父節點
當前提交
f9607f7fff
共有 3 個文件被更改,包括 26 次插入3 次删除
  1. 21 1
      src/compiler/displayOutput.ml
  2. 3 0
      src/compiler/main.ml
  3. 2 2
      src/core/path.ml

+ 21 - 1
src/compiler/displayOutput.ml

@@ -291,6 +291,7 @@ let handle_display_argument com file_pos pre_compilation did_something =
 type display_path_kind =
 	| DPKNormal of path
 	| DPKMacro of path
+	| DPKDirect of string
 	| DPKNone
 
 let process_display_file com classes =
@@ -343,12 +344,31 @@ let process_display_file com classes =
 				(match List.rev (ExtString.String.nsplit real Path.path_sep) with
 				| file :: _ when file.[0] >= 'a' && file.[0] <= 'z' -> failwith ("Display file '" ^ file ^ "' should not start with a lowercase letter")
 				| _ -> ());
-				failwith "Display file was not found in class path"
+				DPKDirect real
 			in
 			Common.log com ("Display file : " ^ real);
 			Common.log com ("Classes found : ["  ^ (String.concat "," (List.map s_type_path !classes)) ^ "]");
 			path
 
+let load_display_file_standalone ctx file =
+	let com = ctx.com in
+	let pack,decls = TypeloadParse.parse_module_file com file null_pos in
+	let path = Path.FilePath.parse file in
+	let name = match path.file_name with
+		| None -> "?DISPLAY"
+		| Some name -> name
+	in
+	begin match path.directory with
+		| None -> ()
+		| Some dir ->
+			(* Chop off number of package parts from the dir and use that as class path. *)
+			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
+	end;
+	ignore(TypeloadModule.type_module ctx (pack,name) file ~dont_check_path:true decls null_pos)
+
 let promote_type_hints tctx =
 	let rec explore_type_hint (md,p,t) =
 		match t with

+ 3 - 0
src/compiler/main.ml

@@ -1045,6 +1045,9 @@ try
 				Some path
 			| DPKNone ->
 				None
+			| DPKDirect file ->
+				DisplayOutput.load_display_file_standalone tctx file;
+				None
 		in
 		begin try
 			do_type tctx !config_macros !classes;

+ 2 - 2
src/core/path.ml

@@ -234,8 +234,8 @@ module FilePath = struct
 		| "." | ".." ->
 			create (Some path) None None false
 		| _ ->
-			let c1 = String.rindex path '/' in
-			let c2 = String.rindex path '\\' in
+			let c1 = try String.rindex path '/' with Not_found -> -1 in
+			let c2 = try String.rindex path '\\' with Not_found -> -1 in
 			let split s at = String.sub s 0 at,String.sub s (at + 1) (String.length s - at - 1) in
 			let dir,path,backslash = if c1 < c2 then begin
 				let dir,path = split path c2 in