let cache = ref NUri.UriMap.empty;;
let includes = ref [];;
-let load_db,set_global_aliases,get_global_aliases,add_deps,get_deps =
+let load_db,set_global_aliases,get_global_aliases,add_deps,get_deps,remove_deps=
let global_aliases = ref [] in
- let includes_map = ref NUri.UriMap.empty in
+ let rev_includes_map = ref NUri.UriMap.empty in
let store_db () =
let ch = open_out (db_path ()) in
- Marshal.to_channel ch (magic,(!global_aliases,!includes_map)) [];
+ Marshal.to_channel ch (magic,(!global_aliases,!rev_includes_map)) [];
close_out ch in
let load_db () =
try
) im NUri.UriMap.empty
in
global_aliases := ga;
- includes_map := im
+ rev_includes_map := im
with
Sys_error _ -> () in
let get_deps u =
let get_deps_one_step u =
- try NUri.UriMap.find u !includes_map with Not_found -> [] in
+ try NUri.UriMap.find u !rev_includes_map with Not_found -> [] in
let rec aux res =
function
[] -> res
else
aux (he::res) (get_deps_one_step he @ tl)
in
- aux [] [u]
+ aux [] [u] in
+ let remove_deps u =
+ rev_includes_map := NUri.UriMap.remove u !rev_includes_map;
+ rev_includes_map :=
+ NUri.UriMap.map
+ (fun l -> List.filter (fun uri -> not (NUri.eq u uri)) l) !rev_includes_map;
+ store_db ()
in
load_db,
(fun ga -> global_aliases := ga; store_db ()),
(fun () -> !global_aliases),
(fun u l ->
- includes_map := NUri.UriMap.add u (l @ get_deps u) !includes_map;
+ rev_includes_map := NUri.UriMap.add u (l @ get_deps u) !rev_includes_map;
store_db ()),
- get_deps
+ get_deps,
+ remove_deps
;;
let init = load_db;;
let decompile ~baseuri =
let baseuris = get_deps baseuri in
List.iter (fun baseuri ->
+ remove_deps baseuri;
HExtlib.safe_remove (path_of_baseuri baseuri);
let basepath = path_of_baseuri ~no_suffix:true baseuri in
try
Filename.dirname (NUri.string_of_uri nuri) <> NUri.string_of_uri baseuri
) (get_global_aliases ()))
with
- Unix.Unix_error (_,m1,m2) -> (* raised by Unix.opendir, we hope :-) *)
- if List.length baseuris <> 1 then
- prerr_endline ("CRITICAL ERROR: " ^ m1 ^ ": " ^ m2);
- assert (List.length baseuris = 1)
+ Unix.Unix_error _ -> () (* raised by Unix.opendir, we hope :-) *)
) baseuris
;;