let _ = let indent = ref 0 in (* let do_indent () = String.make !indent ' ' in *) NCicTypeChecker.set_logger (function | `Start_type_checking s -> (); (* prerr_endline (do_indent () ^ "Start: " ^ NUri.string_of_uri s); *) incr indent | `Type_checking_completed s -> (); decr indent; (* prerr_endline (do_indent () ^ "End: " ^ NUri.string_of_uri s) *) ); NCicPp.set_ppterm NCicPp.trivial_pp_term; Helm_registry.load_from "conf.xml"; let alluris = try let s = Sys.argv.(1) in if s = "-alluris" then begin let uri_re = Str.regexp ".*\\(ind\\|con\\)$" in let uris = Http_getter.getalluris () in let alluris = List.filter (fun u -> Str.string_match uri_re u 0) uris in let oc = open_out "alluris.txt" in List.iter (fun s -> output_string oc (s^"\n")) alluris; close_out oc; [] end else [s] with Invalid_argument _ -> let r = ref [] in let ic = open_in "alluris.txt" in try while true do r := input_line ic :: !r; done; [] with _ -> List.rev !r in let alluris = HExtlib.filter_map (fun u -> try Some (UriManager.uri_of_string u) with _ -> None) alluris in (* brutal *) prerr_endline "computing graphs to load..."; let dbd = HSql.quick_connect (LibraryDb.parse_dbd_conf ()) in MetadataTypes.ownerize_tables (Helm_registry.get "matita.owner"); let uniq l = HExtlib.list_uniq (List.sort UriManager.compare l) in let who_uses u = uniq (List.map (fun (uri,_) -> UriManager.strip_xpointer uri) (MetadataDeps.inverse_deps ~dbd u)) in let roots_alluris = let rec fix acc l = let acc, todo = List.fold_left (fun (acc,todo) x -> let w = who_uses x in if w = [] then (x::acc,todo) else (acc,uniq (todo@w))) (acc,[]) l in if todo = [] then uniq acc else fix acc todo in (fix [] alluris) in prerr_endline "generating Coq graphs..."; CicEnvironment.set_trust (fun _ -> false); List.iter (fun u -> prerr_endline (" - " ^ UriManager.string_of_uri u); try ignore(CicTypeChecker.typecheck u); with | CicTypeChecker.AssertFailure s | CicTypeChecker.TypeCheckerFailure s -> prerr_endline (Lazy.force s) ) roots_alluris; prerr_endline "loading..."; List.iter (fun u -> prerr_endline (" - "^UriManager.string_of_uri u); try NCicEnvironment.load_graph u with exn -> ()) roots_alluris; prerr_endline "finished...."; CicUniv.do_rank (NCicEnvironment.get_graph ()); prerr_endline "ranked...."; prerr_endline "caching objects"; HExtlib.profiling_enabled := false; List.iter (fun uu -> let uu= NUri.nuri_of_ouri uu in indent := 0; (* prerr_endline ("************* INIZIO **************** " ^ NUri.string_of_uri uu); *) let _,o = NCicEnvironment.get_obj uu in (* prerr_endline (NCicPp.ppobj o); *) try NCicTypeChecker.typecheck_obj o; (* prerr_endline ("************* FINE ****************" ^ NUri.string_of_uri uu); *) with | NCicTypeChecker.AssertFailure s | NCicTypeChecker.TypeCheckerFailure s as e -> (* prerr_endline ("Obj: " ^ NCicPp.ppobj o); *) prerr_endline ("######### " ^ Lazy.force s); raise e | CicEnvironment.Object_not_found s -> prerr_endline ("Obj not found: " ^ UriManager.string_of_uri s); ) alluris; NCicEnvironment.invalidate (); Gc.compact (); HExtlib.profiling_enabled := true; prerr_endline "typechecking, first with the new and then with the old kernel"; let prima = Unix.gettimeofday () in List.iter (fun u -> let u= NUri.nuri_of_ouri u in indent := 0; NCicTypeChecker.typecheck_obj (snd (NCicEnvironment.get_obj u))) alluris; let dopo = Unix.gettimeofday () in Gc.compact (); let dopo2 = Unix.gettimeofday () in Printf.eprintf "NEW typing: %3.2f, gc: %3.2f\n%!" (dopo -. prima) (dopo2 -. dopo); CicEnvironment.invalidate (); Gc.compact (); let prima = Unix.gettimeofday () in List.iter (fun u -> ignore (CicTypeChecker.typecheck u)) alluris; let dopo = Unix.gettimeofday () in Gc.compact (); let dopo2 = Unix.gettimeofday () in Printf.eprintf "OLD typing: %3.2f, gc: %3.2f\n%!" (dopo -. prima) (dopo2 -. dopo) ;;