X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fng_kernel%2Fcheck.ml;h=d10b771aad2b249618ba4178db18ceba1cd955a6;hb=62a12215bbf8686fab44e8db25babd3095983c8f;hp=d0c18e6a7642afbb787862002c0e575118e4ed9a;hpb=e48acbc0d00717ce8f12412673ece4e4ee0e9642;p=helm.git diff --git a/helm/software/components/ng_kernel/check.ml b/helm/software/components/ng_kernel/check.ml index d0c18e6a7..d10b771aa 100644 --- a/helm/software/components/ng_kernel/check.ml +++ b/helm/software/components/ng_kernel/check.ml @@ -13,8 +13,9 @@ let debug = true let ignore_exc = false -let rank_all_dependencies = true +let rank_all_dependencies = false let trust_environment = false +let print_object = true let indent = ref 0;; @@ -50,6 +51,20 @@ let logger = prerr_endline (do_indent () ^ "Trust: " ^ NUri.string_of_uri s)) ;; +let mk_type n = + if n = 0 then + [false, NUri.uri_of_string ("cic:/matita/pts/Type.univ")] + else + [false, NUri.uri_of_string ("cic:/matita/pts/Type"^string_of_int n^".univ")] +;; +let mk_cprop n = + if n = 0 then + [false, NUri.uri_of_string ("cic:/matita/pts/CProp.univ")] + else + [false, NUri.uri_of_string ("cic:/matita/pts/CProp"^string_of_int n^".univ")] +;; + + let _ = let do_old_logging = ref true in HelmLogger.register_log_callback @@ -58,7 +73,6 @@ let _ = prerr_endline (HelmLogger.string_of_html_msg html_msg)); CicParser.impredicative_set := false; NCicTypeChecker.set_logger logger; - NCicPp.set_ppterm NCicPp.trivial_pp_term; Helm_registry.load_from "conf.xml"; let alluris = try @@ -128,23 +142,57 @@ let _ = try load_graph u with exn -> ()) roots_alluris; prerr_endline "finished...."; - CicUniv.do_rank (get_graph ()); - prerr_endline "caching objects"; + let lll, uuu =(CicUniv.do_rank (get_graph ())) in + CicUniv.print_ugraph (get_graph ()); + let lll = List.sort compare lll in + List.iter (fun k -> + prerr_endline (CicUniv.string_of_universe k ^ " = " ^ string_of_int (CicUniv.get_rank k))) uuu; + let _ = + try + let rec aux = function + | a::(b::_ as tl) -> + NCicEnvironment.add_constraint true (mk_type a) (mk_type b); + NCicEnvironment.add_constraint true (mk_cprop a) (mk_cprop b); + NCicEnvironment.add_constraint true (mk_cprop a) (mk_type b); + NCicEnvironment.add_constraint true (mk_type a) (mk_cprop b); + NCicEnvironment.add_constraint false (mk_cprop a) (mk_type a); + NCicEnvironment.add_constraint false (mk_type a) (mk_cprop a); + aux tl + | [a] -> + NCicEnvironment.add_constraint false (mk_type a) (mk_cprop a); + NCicEnvironment.add_constraint false (mk_cprop a) (mk_type a); + | _ -> () + in + aux lll + with NCicEnvironment.BadConstraint s as e -> + prerr_endline (Lazy.force s); raise e + in prerr_endline "ranked...."; + prerr_endline (NCicEnvironment.pp_constraints ()); HExtlib.profiling_enabled := false; List.iter (fun uu -> - let uu= NUri.nuri_of_ouri uu in + let uu= OCic2NCic.nuri_of_ouri uu in indent := 0; let o = NCicLibrary.get_obj uu in + if print_object then prerr_endline (NCicPp.ppobj o); try NCicTypeChecker.typecheck_obj o with - | NCicTypeChecker.AssertFailure s - | NCicTypeChecker.TypeCheckerFailure s - | NCicEnvironment.ObjectNotFound s - | NCicEnvironment.BadDependency s as e -> - prerr_endline ("######### " ^ Lazy.force s); - if not ignore_exc then raise e + exn -> + let rec aux = function + | NCicTypeChecker.AssertFailure s + | NCicTypeChecker.TypeCheckerFailure s + | NCicEnvironment.ObjectNotFound s + | NCicEnvironment.BadConstraint s as e-> + prerr_endline ("######### " ^ Lazy.force s); + if not ignore_exc then raise e + | NCicEnvironment.BadDependency (s,x) as e -> + prerr_endline ("######### " ^ Lazy.force s); + aux x; + if not ignore_exc then raise e + | e -> raise e + in + aux exn ) alluris; NCicEnvironment.invalidate (); @@ -156,7 +204,7 @@ let _ = let prima = Unix.gettimeofday () in List.iter (fun u -> - let u= NUri.nuri_of_ouri u in + let u= OCic2NCic.nuri_of_ouri u in indent := 0; NCicTypeChecker.typecheck_obj (NCicLibrary.get_obj u)) alluris;