X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fng_kernel%2Fcheck.ml;h=28aeb16c8da1b338fd93bcd3e5b66dc80c227eff;hb=c622da7bd4b14f5953424e09f32c14f74d681a3f;hp=132ce5b7f350ea0ef660f9b8448ca7bdcfdda5e4;hpb=a090beb987748d1a8d24e93c7e7c9662a3abe06d;p=helm.git diff --git a/helm/software/components/ng_kernel/check.ml b/helm/software/components/ng_kernel/check.ml index 132ce5b7f..28aeb16c8 100644 --- a/helm/software/components/ng_kernel/check.ml +++ b/helm/software/components/ng_kernel/check.ml @@ -5,24 +5,41 @@ let trust_environment = false let indent = ref 0;; +let load_graph, get_graph = + let oldg = ref CicUniv.empty_ugraph in + (function uri -> + let _,g = CicEnvironment.get_obj !oldg uri in + oldg := g), + (function _ -> !oldg) +;; + let logger = let do_indent () = String.make !indent ' ' in (function - | `Start_type_checking s -> (); - if debug then - prerr_endline (do_indent () ^ "Start: " ^ NUri.string_of_uri s); - incr indent - - | `Type_checking_completed s -> (); - decr indent; - if debug then - prerr_endline (do_indent () ^ "End: " ^ NUri.string_of_uri s)) + | `Start_type_checking s -> + if debug then + prerr_endline (do_indent () ^ "Start: " ^ NUri.string_of_uri s); + incr indent + | `Type_checking_completed s -> + decr indent; + if debug then + prerr_endline (do_indent () ^ "End: " ^ NUri.string_of_uri s) + | `Type_checking_interrupted s -> + decr indent; + if debug then + prerr_endline (do_indent () ^ "Break: " ^ NUri.string_of_uri s) + | `Type_checking_failed s -> + decr indent; + if debug then + prerr_endline (do_indent () ^ "Fail: " ^ NUri.string_of_uri s)) ;; let _ = + let do_old_logging = ref true in HelmLogger.register_log_callback (fun ?append_NL html_msg -> - prerr_endline (HelmLogger.string_of_html_msg html_msg)); + if !do_old_logging then + prerr_endline (HelmLogger.string_of_html_msg html_msg)); CicParser.impredicative_set := false; NCicTypeChecker.set_logger logger; NCicPp.set_ppterm NCicPp.trivial_pp_term; @@ -92,21 +109,19 @@ let _ = List.iter (fun u -> prerr_endline (" - "^UriManager.string_of_uri u); - try NCicEnvironment.load_graph u with exn -> ()) + try load_graph u with exn -> ()) roots_alluris; prerr_endline "finished...."; - CicUniv.do_rank (NCicEnvironment.get_graph ()); + CicUniv.do_rank (get_graph ()); prerr_endline "caching objects"; prerr_endline "ranked...."; HExtlib.profiling_enabled := false; List.iter (fun uu -> - let uu= NUri.nuri_of_ouri uu in - indent := 0; - logger (`Start_type_checking uu); - let _,o = NCicEnvironment.get_obj uu in + let uu= NUri.nuri_of_ouri uu in + indent := 0; + let o = NCicLibrary.get_obj uu in try - NCicTypeChecker.typecheck_obj o; - logger (`Type_checking_completed uu); + NCicTypeChecker.typecheck_obj o with | NCicTypeChecker.AssertFailure s | NCicTypeChecker.TypeCheckerFailure s as e -> @@ -120,13 +135,14 @@ let _ = Gc.compact (); HExtlib.profiling_enabled := true; NCicTypeChecker.set_logger (fun _ -> ()); + do_old_logging := false; 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))) + NCicTypeChecker.typecheck_obj (NCicLibrary.get_obj u)) alluris; let dopo = Unix.gettimeofday () in Gc.compact ();