X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fng_kernel%2Fcheck.ml;h=8f014d4d20ab733e30f3e368cab072da7c9a6c4c;hb=1fbc5fd1d3e29b6b95e2613d10760e3bfd3e213f;hp=71ba8ddc284720f3ec8bed7fa0ed08c34b41d6d6;hpb=28f01bb2d0e5f1b3f180b0b478267d2beb06a5fe;p=helm.git diff --git a/helm/software/components/ng_kernel/check.ml b/helm/software/components/ng_kernel/check.ml index 71ba8ddc2..8f014d4d2 100644 --- a/helm/software/components/ng_kernel/check.ml +++ b/helm/software/components/ng_kernel/check.ml @@ -15,6 +15,7 @@ let debug = true let ignore_exc = false let rank_all_dependencies = false let trust_environment = false +let print_object = true let indent = ref 0;; @@ -52,15 +53,15 @@ let logger = let mk_type n = if n = 0 then - [false, NUri.uri_of_string ("cic:/matita/pts/Type.univ")] + [`Type, NUri.uri_of_string ("cic:/matita/pts/Type.univ")] else - [false, NUri.uri_of_string ("cic:/matita/pts/Type"^string_of_int n^".univ")] + [`Type, 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")] + [`CProp, NUri.uri_of_string ("cic:/matita/pts/Type.univ")] else - [false, NUri.uri_of_string ("cic:/matita/pts/CProp"^string_of_int n^".univ")] + [`CProp, NUri.uri_of_string ("cic:/matita/pts/Type"^string_of_int n^".univ")] ;; @@ -72,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 @@ -142,36 +142,50 @@ let _ = try load_graph u with exn -> ()) roots_alluris; prerr_endline "finished...."; - let lll = List.sort compare (CicUniv.do_rank (get_graph ())) in - 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_type a) (mk_cprop a); - NCicEnvironment.add_constraint true (mk_cprop a) (mk_type b); - NCicEnvironment.add_constraint true (mk_type b) (mk_cprop b); + NCicEnvironment.add_lt_constraint (mk_type a) (mk_type b); + NCicEnvironment.add_lt_constraint (mk_type a) (mk_cprop b); aux tl | _ -> () 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= 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 + NCicEnvironment.check_and_add_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 (); @@ -183,9 +197,9 @@ let _ = let prima = Unix.gettimeofday () in List.iter (fun u -> - let u= OCic2NCic.nuri_of_ouri u in + let u= OCic2NCic.nuri_of_ouri u in indent := 0; - NCicTypeChecker.typecheck_obj (NCicLibrary.get_obj u)) + ignore (NCicEnvironment.get_checked_obj u)) alluris; let dopo = Unix.gettimeofday () in Gc.compact ();