- The assert failure has been removed since in some situations (????) an
empty dir (no new objects) was not created and thus it was normal that it
was not removed. TO BE BETTER UNDERSTOOD
let cache = ref NUri.UriMap.empty;;
let includes = ref [];;
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 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
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
close_out ch in
let load_db () =
try
) im NUri.UriMap.empty
in
global_aliases := ga;
) im NUri.UriMap.empty
in
global_aliases := ga;
with
Sys_error _ -> () in
let get_deps u =
let get_deps_one_step u =
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
let rec aux res =
function
[] -> res
else
aux (he::res) (get_deps_one_step he @ tl)
in
else
aux (he::res) (get_deps_one_step he @ tl)
in
+ 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 ->
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;
+ get_deps,
+ remove_deps
let decompile ~baseuri =
let baseuris = get_deps baseuri in
List.iter (fun baseuri ->
let decompile ~baseuri =
let baseuris = get_deps baseuri in
List.iter (fun baseuri ->
HExtlib.safe_remove (path_of_baseuri baseuri);
let basepath = path_of_baseuri ~no_suffix:true baseuri in
try
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
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 :-) *)