track modules files and dependencies

codegen.ml

@@ -119,7 +119,7 @@ let extend_remoting ctx c t p async prot =
 		Error (Module_not_found _,p2) when p == p2 ->
 	(* build it *)
 	if ctx.com.verbose then print_endline ("Building proxy for " ^ s_type_path path);
-	let decls = (try
+	let file, decls = (try
 		Typeload.parse_module ctx path p
 	with
 		| Not_found -> ctx.com.package_rules <- rules; error ("Could not load proxy module " ^ s_type_path path ^ (if fst path = [] then " (try using absolute path)" else "")) p
@@ -170,7 +170,7 @@ let extend_remoting ctx c t p async prot =
 			(EClass { c with d_flags = []; d_name = new_name; d_data = fields },p)
 		| _ -> d
 	) decls in
-	let m = Typeload.type_module ctx (t.tpackage,new_name) decls p in
+	let m = Typeload.type_module ctx (t.tpackage,new_name) file decls p in
 	try
 		List.find (fun tdecl -> snd (t_path tdecl) = new_name) m.mtypes
 	with Not_found ->
@@ -216,6 +216,8 @@ let rec build_generic ctx c p tl =
 		let cg = mk_class (pack,name) c.cl_pos in
 		let mg = {
 			mpath = cg.cl_path;
+			mfile = m.mfile;
+			mdeps = m.mdeps; (* share *)
 			mtypes = [TClassDecl cg];
 		} in
 		Hashtbl.add ctx.g.modules mg.mpath mg;
@@ -454,6 +456,18 @@ let rec has_rtti c =
 		| _ -> false
 	) c.cl_implements || (match c.cl_super with None -> false | Some (c,_) -> has_rtti c)
 
+let restore c =
+	let meta = c.cl_meta and path = c.cl_path in
+	let fl = c.cl_fields and ofl = c.cl_ordered_fields and st = c.cl_statics and ost = c.cl_ordered_statics in
+	(fun() -> 
+		c.cl_meta <- meta;
+		c.cl_path <- path;
+		c.cl_fields <- fl;
+		c.cl_ordered_fields <- ofl;
+		c.cl_statics <- st;
+		c.cl_ordered_statics <- ost;
+	)
+
 let on_generate ctx t =
 	match t with
 	| TClassDecl c ->
@@ -461,6 +475,7 @@ let on_generate ctx t =
 			let rpath = (fst c.cl_module,"_" ^ snd c.cl_module) in
 			if Hashtbl.mem ctx.g.types_module rpath then error ("This private class name will clash with " ^ s_type_path rpath) c.cl_pos;
 		end;
+		c.cl_restore <- restore c;
 		List.iter (fun m ->
 			match m with
 			| ":native",[Ast.EConst (Ast.String name),p],mp ->

common.ml

@@ -60,7 +60,7 @@ type context = {
 	mutable package_rules : (string,package_rule) PMap.t;
 	mutable error : string -> pos -> unit;
 	mutable warning : string -> pos -> unit;
-	mutable load_extern_type : (path -> pos -> Ast.package option) list; (* allow finding types which are not in sources *)
+	mutable load_extern_type : (path -> pos -> (string * Ast.package) option) list; (* allow finding types which are not in sources *)
 	mutable filters : (unit -> unit) list;
 	mutable defines_signature : string option;
 	(* output *)

main.ml

@@ -249,7 +249,7 @@ let add_swf_lib com file =
 	let build cl p =
 		match (try Some (Hashtbl.find (extract()) cl) with Not_found -> None) with
 		| None -> None
-		| Some c -> Some (Genswf.build_class com c file)
+		| Some c -> Some (file, Genswf.build_class com c file)
 	in
 	com.load_extern_type <- com.load_extern_type @ [build];
 	com.swf_libs <- (file,getSWF,extract) :: com.swf_libs

type.ml

@@ -181,6 +181,8 @@ and tclass = {
 	mutable cl_constructor : tclass_field option;
 	mutable cl_init : texpr option;
 	mutable cl_overrides : string list;
+
+	mutable cl_restore : unit -> unit;
 }
 
 and tenum_field = {
@@ -225,6 +227,8 @@ and module_type =
 type module_def = {
 	mpath : path;
 	mtypes : module_type list;
+	mfile : string;
+	mdeps : (module_def,unit) PMap.t ref;
 }
 
 let alloc_var =
@@ -271,6 +275,7 @@ let mk_class path pos =
 		cl_constructor = None;
 		cl_init = None;
 		cl_overrides = [];
+		cl_restore = (fun() -> ());
 	}
 
 let null_class =

typeload.ml

@@ -1246,7 +1246,7 @@ let add_module ctx m p =
 	List.iter decl_type m.mtypes;
 	Hashtbl.add ctx.g.modules m.mpath m
 
-let type_module ctx m tdecls loadp =
+let type_module ctx m file tdecls loadp =
 	(* PASS 1 : build module structure - does not load any module or type - should be atomic ! *)
 	let decls = ref [] in
 	let make_path name priv =
@@ -1299,6 +1299,8 @@ let type_module ctx m tdecls loadp =
 	let m = {
 		mpath = m;
 		mtypes = List.rev !decls;
+		mfile = Common.get_full_path file;
+		mdeps = ref PMap.empty;
 	} in
 	add_module ctx m loadp;
 	(* PASS 2 : build types structure - does not type any expression ! *)
@@ -1479,7 +1481,7 @@ let parse_module ctx m p =
 		else
 			display_error ctx ("Invalid package : " ^ spack (fst m) ^ " should be " ^ spack pack) p
 	end;
-	if !remap <> fst m then
+	file, if !remap <> fst m then
 		(* build typedefs to redirect to real package *)
 		List.rev (List.fold_left (fun acc (t,p) ->
 			let build f d =
@@ -1511,11 +1513,11 @@ let parse_module ctx m p =
 		decls
 
 let load_module ctx m p =
-	try
+	let m2 = (try
 		Hashtbl.find ctx.g.modules m
 	with
 		Not_found ->
-			let decls = (try
+			let file, decls = (try
 				parse_module ctx m p
 			with Not_found ->
 				let rec loop = function
@@ -1524,8 +1526,11 @@ let load_module ctx m p =
 					| load :: l ->
 						match load m p with
 						| None -> loop l
-						| Some (_,a) -> a
+						| Some (file,(_,a)) -> file, a
 				in
 				loop ctx.com.load_extern_type
 			) in
-			type_module ctx m decls p
+			type_module ctx m file decls p
+	) in
+	ctx.current.mdeps := PMap.add m2 () !(ctx.current.mdeps);
+	m2

typer.ml

@@ -2276,7 +2276,7 @@ let make_macro_api ctx p =
 		);
 		Interp.define_type = (fun v ->
 			let m, tdef, pos = (try Interp.decode_type_def v with Interp.Invalid_expr -> Interp.exc (Interp.VString "Invalid type definition")) in
-			ignore(Typeload.type_module ctx m [tdef,pos] pos);
+			ignore(Typeload.type_module ctx m "" [tdef,pos] pos);
 		);
 	}
 
@@ -2495,6 +2495,8 @@ let rec create com =
 	let empty =	{
 		mpath = [] , "";
 		mtypes = [];
+		mfile = "";
+		mdeps = ref PMap.empty;
 	} in
 	let ctx = {
 		com = com;