X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;ds=sidebyside;f=helm%2Fmatita%2FmatitacleanLib.ml;h=06c6835ca5797b32b09a38e68c06cc55d88bb526;hb=0a23b2111c404a0a7141a0d5729cf3aa0bdf7798;hp=4218492f4ebea739c6ec4a906696fe06a2bbf70a;hpb=646ade789430669f4a6be3ecbf47d89fe865f132;p=helm.git diff --git a/helm/matita/matitacleanLib.ml b/helm/matita/matitacleanLib.ml index 4218492f4..06c6835ca 100644 --- a/helm/matita/matitacleanLib.ml +++ b/helm/matita/matitacleanLib.ml @@ -98,21 +98,25 @@ let close_uri_list uri_to_remove = in (* now calculate the list of objects that belong to these baseuris *) let uri_to_remove = - List.fold_left - (fun acc buri -> - let inhabitants = HG.ls (buri ^ "/") in - let inhabitants = List.filter - (function HGT.Ls_object _ -> true | _ -> false) - inhabitants - in - let inhabitants = List.map - (function - | HGT.Ls_object e -> buri ^ "/" ^ e.HGT.uri - | _ -> assert false) - inhabitants - in - inhabitants @ acc) - [] buri_to_remove + try + List.fold_left + (fun acc buri -> + let inhabitants = HG.ls (buri ^ "/") in + let inhabitants = List.filter + (function HGT.Ls_object _ -> true | _ -> false) + inhabitants + in + let inhabitants = List.map + (function + | HGT.Ls_object e -> buri ^ "/" ^ e.HGT.uri + | _ -> assert false) + inhabitants + in + inhabitants @ acc) + [] buri_to_remove + with HGT.Invalid_URI u -> + MatitaLog.error ("We were listing an invalid buri: " ^ u); + exit 1 in (* now we want the list of all uri that depend on them *) let depend = @@ -133,7 +137,17 @@ let baseuri_of_file file = List.iter (fun stm -> match baseuri_of_baseuri_decl stm with - | Some buri -> uri := MatitaMisc.strip_trailing_slash buri + | Some buri -> + let u = MatitaMisc.strip_trailing_slash buri in + if String.length u < 5 || String.sub u 0 5 <> "cic:/" then + MatitaLog.error (file ^ " sets an incorrect baseuri: " ^ buri); + (try + ignore(HG.resolve u) + with + | HGT.Unresolvable_URI _ -> + MatitaLog.error (file ^ " sets an unresolvable baseuri: "^buri) + | HGT.Key_not_found _ -> ()); + uri := u | None -> ()) stms; !uri