Pārlūkot izejas kodu

allow compiler caching of extern types (close #1946)

Nicolas Cannasse 10 gadi atpakaļ
vecāks
revīzija
f27a3c1e12
3 mainītis faili ar 19 papildinājumiem un 2 dzēšanām
  1. 12 0
      main.ml
  2. 1 0
      type.ml
  3. 6 2
      typeload.ml

+ 12 - 0
main.ml

@@ -741,6 +741,18 @@ and wait_loop boot_com host port =
 				if m.m_extra.m_mark <= start_mark then begin
 					(match m.m_extra.m_kind with
 					| MFake | MSub -> () (* don't get classpath *)
+					| MExtern ->
+						(* if we have a file then this will override our extern type *)
+						let has_file = (try ignore(Typeload.resolve_module_file com2 m.m_path (ref[]) p); true with Not_found -> false) in
+						if has_file then raise Not_found;
+						let rec loop = function
+							| [] -> raise Not_found (* no extern registration *)
+							| load :: l ->
+								match load m.m_path p with
+								| None -> loop l
+								| Some (file,_) -> if Common.unique_full_path file <> m.m_extra.m_file then raise Not_found
+						in
+						loop com2.load_extern_type
 					| MCode -> if not (check_module_path com2 m p) then raise Not_found;
 					| MMacro when ctx.Typecore.in_macro -> if not (check_module_path com2 m p) then raise Not_found;
 					| MMacro ->

+ 1 - 0
type.ml

@@ -298,6 +298,7 @@ and module_kind =
 	| MMacro
 	| MFake
 	| MSub
+	| MExtern
 
 and dt =
 	| DTSwitch of texpr * (texpr * dt) list * dt option

+ 6 - 2
typeload.ml

@@ -2742,8 +2742,9 @@ let rec init_module_type ctx context_init do_init (decl,p) =
 				error "Abstract is missing underlying type declaration" a.a_pos
 		end
 
-let type_module ctx m file tdecls p =
+let type_module ctx m file ?(is_extern=false) tdecls p =
 	let m, decls, tdecls = make_module ctx m file tdecls p in
+	if is_extern then m.m_extra.m_kind <- MExtern;
 	add_module ctx m p;
 	(* define the per-module context for the next pass *)
 	let ctx = {
@@ -2906,6 +2907,7 @@ let load_module ctx m p =
 			match !type_module_hook ctx m p with
 			| Some m -> m
 			| None ->
+			let is_extern = ref false in
 			let file, decls = (try
 				parse_module ctx m p
 			with Not_found ->
@@ -2917,10 +2919,12 @@ let load_module ctx m p =
 						| None -> loop l
 						| Some (file,(_,a)) -> file, a
 				in
+				is_extern := true;
 				loop ctx.com.load_extern_type
 			) in
+			let is_extern = !is_extern in
 			try
-				type_module ctx m file decls p
+				type_module ctx m file ~is_extern decls p
 			with Forbid_package (inf,pl,pf) when p <> Ast.null_pos ->
 				raise (Forbid_package (inf,p::pl,pf))
 	) in