support import.hx (closes #1138)

common.ml

@@ -131,6 +131,7 @@ type context = {
 	mutable get_macros : unit -> context option;
 	mutable run_command : string -> int;
 	file_lookup_cache : (string,string option) Hashtbl.t;
+	parser_cache : (string,string list * (type_def * pos) list) Hashtbl.t;
 	mutable stored_typed_exprs : (int, texpr) PMap.t;
 	(* output *)
 	mutable file : string;
@@ -762,6 +763,7 @@ let create v args =
 		file_lookup_cache = Hashtbl.create 0;
 		stored_typed_exprs = PMap.empty;
 		memory_marker = memory_marker;
+		parser_cache = Hashtbl.create 0;
 	}
 
 let log com str =
@@ -975,11 +977,19 @@ let find_file ctx f =
 		| None -> raise Not_found
 		| Some f -> f)
 
-
 let get_full_path f = try Extc.get_full_path f with _ -> f
 
 let unique_full_path = if Sys.os_type = "Win32" || Sys.os_type = "Cygwin" then (fun f -> String.lowercase (get_full_path f)) else get_full_path
 
+let get_path_parts f =
+	let f = String.concat "/" (ExtString.String.nsplit f "\\") in
+	let cl = ExtString.String.nsplit f "." in
+	let cl = (match List.rev cl with
+		| ["hx";path] -> ExtString.String.nsplit path "/"
+		| _ -> cl
+	) in
+	cl
+
 let normalize_path p =
 	let l = String.length p in
 	if l = 0 then

main.ml

@@ -201,12 +201,7 @@ let report_times print =
 	end
 
 let make_path f =
-	let f = String.concat "/" (ExtString.String.nsplit f "\\") in
-	let cl = ExtString.String.nsplit f "." in
-	let cl = (match List.rev cl with
-		| ["hx";path] -> ExtString.String.nsplit path "/"
-		| _ -> cl
-	) in
+	let cl = get_path_parts f in
 	let error msg =
 		let msg = "Could not process argument " ^ f ^ "\n" ^ msg in
 		failwith msg

tests/misc/projects/Issue1138/compile1.hxml

@@ -0,0 +1,4 @@
+-cp src1
+-cp src2
+-main C
+--interp

tests/misc/projects/Issue1138/compile1.hxml.stderr

@@ -0,0 +1 @@
+some1some2

tests/misc/projects/Issue1138/compile2.hxml

@@ -0,0 +1,4 @@
+-cp src1
+-cp src2
+-main p2.C2
+--interp

tests/misc/projects/Issue1138/compile2.hxml.stderr

@@ -0,0 +1 @@
+some1some23

tests/misc/projects/Issue1138/compile3-fail.hxml

@@ -0,0 +1,4 @@
+-cp src1
+-cp src2
+-main D
+--interp

tests/misc/projects/Issue1138/compile3-fail.hxml.stderr

@@ -0,0 +1 @@
+src1/D.hx:3: characters 8-16 : Int has no field triple

tests/misc/projects/Issue1138/compile4-fail.hxml

@@ -0,0 +1,3 @@
+-cp src3
+-main Main
+--interp

tests/misc/projects/Issue1138/compile4-fail.hxml.stderr

@@ -0,0 +1 @@
+$$normPath(::cwd::/src3/import.hx):1: characters 0-11 : Only import and using is allowed in import.hx files

tests/misc/projects/Issue1138/src1/C.hx

@@ -0,0 +1,7 @@
+class C {
+    static function main() {
+        var err = Sys.stderr();
+        err.writeString(A.some);
+        err.writeString(getSome());
+    }
+}

tests/misc/projects/Issue1138/src1/D.hx

@@ -0,0 +1,5 @@
+class D {
+    static function main() {
+        1.triple();
+    }
+}

tests/misc/projects/Issue1138/src1/import.hx

@@ -0,0 +1,2 @@
+import p2.A;
+import p2.A.getSome;

tests/misc/projects/Issue1138/src1/p2/C2.hx

@@ -0,0 +1,10 @@
+package p2;
+
+class C2 {
+    static function main() {
+        var err = Sys.stderr();
+        err.writeString(A.some);
+        err.writeString(getSome());
+        err.writeString(Std.string(1.triple()));
+    }
+}

tests/misc/projects/Issue1138/src1/p2/import.hx

@@ -0,0 +1 @@
+using B;

tests/misc/projects/Issue1138/src2/B.hx

@@ -0,0 +1,3 @@
+class B {
+    public static function triple(v:Int):Int return v * 3;
+}

tests/misc/projects/Issue1138/src2/import.hx

@@ -0,0 +1 @@
+using B;

tests/misc/projects/Issue1138/src2/p2/A.hx

@@ -0,0 +1,8 @@
+package p2;
+
+class A {
+    public static var some = "some1";
+    public static function getSome() {
+        return "some2";
+    }
+}

tests/misc/projects/Issue1138/src3/Main.hx

@@ -0,0 +1,3 @@
+class Main {
+    static function main() {}
+}

tests/misc/projects/Issue1138/src3/import.hx

@@ -0,0 +1 @@
+typedef A = {}

typeload.ml

@@ -154,7 +154,7 @@ let module_pass_1 com m tdecls loadp =
 			decls := (TTypeDecl t, decl) :: !decls;
 			acc
 		 | EAbstract d ->
-		 	if String.length d.d_name > 0 && d.d_name.[0] = '$' then error "Type names starting with a dollar are not allowed" p;
+			if String.length d.d_name > 0 && d.d_name.[0] = '$' then error "Type names starting with a dollar are not allowed" p;
 			let priv = List.mem APrivAbstract d.d_flags in
 			let path = make_path d.d_name priv in
 			let a = {
@@ -1987,7 +1987,7 @@ module ClassInitializer = struct
 			| Some { cf_public = p } -> p
 			| _ -> c.cl_extern || c.cl_interface || cctx.extends_public
 
- 	let rec get_parent c name =
+	let rec get_parent c name =
 		match c.cl_super with
 		| None -> None
 		| Some (csup,_) ->
@@ -2005,8 +2005,8 @@ module ClassInitializer = struct
 			c.cl_ordered_fields <- cf :: c.cl_ordered_fields;
 		end
 
- 	let type_opt (ctx,cctx) p t =
- 		let c = cctx.tclass in
+	let type_opt (ctx,cctx) p t =
+		let c = cctx.tclass in
 		match t with
 		| None when c.cl_extern || c.cl_interface ->
 			display_error ctx "Type required for extern classes and interfaces" p;
@@ -3259,12 +3259,43 @@ let type_types_into_module ctx m tdecls p =
 	end;
 	module_pass_2 ctx m decls tdecls p
 
+let handle_import_hx ctx m decls p =
+	let path_split = List.tl (List.rev (get_path_parts m.m_extra.m_file)) in
+	let join l = String.concat "/" (List.rev ("import.hx" :: l)) in
+	let rec loop path pack = match path,pack with
+		| _,[] -> [join path]
+		| (p :: path),(_ :: pack) -> (join (p :: path)) :: (loop path pack)
+		| _ -> []
+	in
+	let candidates = loop path_split (fst m.m_path) in
+	List.fold_left (fun acc path ->
+		let path = Common.unique_full_path path in
+		let _,decls = try
+			Hashtbl.find ctx.com.parser_cache path
+		with Not_found ->
+			if Sys.file_exists path then begin
+				let r = parse_file ctx.com path p in
+				List.iter (fun (d,p) -> match d with EImport _ | EUsing _ -> () | _ -> error "Only import and using is allowed in import.hx files" p) (snd r);
+				Hashtbl.replace ctx.com.parser_cache path r;
+				r
+			end else begin
+				let r = ([],[]) in
+				(* Add empty decls so we don't check the file system all the time. *)
+				Hashtbl.replace ctx.com.parser_cache path r;
+				r
+			end
+		in
+		decls @ acc
+	) decls candidates
+
 (*
 	Creates a new module and types [tdecls] into it.
 *)
 let type_module ctx mpath file ?(is_extern=false) tdecls p =
 	let m = make_module ctx mpath file p in
 	Hashtbl.add ctx.g.modules m.m_path m;
+	let tdecls = handle_import_hx ctx m tdecls p in
+	add_module ctx m p;
 	type_types_into_module ctx m tdecls p;
 	if is_extern then m.m_extra.m_kind <- MExtern;
 	m