X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fng_kernel%2Fcheck.ml;h=8f014d4d20ab733e30f3e368cab072da7c9a6c4c;hb=7b112b0cd39c5ab0db5c28636c0a7f7e36b4d6e2;hp=ab012367ace8d4159b77175d7f92eb5feda5ac70;hpb=283c65c5e52db9bc3ee712358faa6cd6b48d38d0;p=helm.git diff --git a/helm/software/components/ng_kernel/check.ml b/helm/software/components/ng_kernel/check.ml index ab012367a..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;; @@ -49,13 +50,21 @@ let logger = if debug then 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")] + [`Type, NUri.uri_of_string ("cic:/matita/pts/Type.univ")] + else + [`Type, NUri.uri_of_string ("cic:/matita/pts/Type"^string_of_int n^".univ")] +;; +let mk_cprop n = + if n = 0 then + [`CProp, NUri.uri_of_string ("cic:/matita/pts/Type.univ")] else - [false, NUri.uri_of_string ("cic:/matita/pts/Type"^string_of_int n^".univ")] + [`CProp, NUri.uri_of_string ("cic:/matita/pts/Type"^string_of_int n^".univ")] ;; + let _ = let do_old_logging = ref true in HelmLogger.register_log_callback @@ -64,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 @@ -134,32 +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_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 (); @@ -171,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 ();