X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fng_kernel%2Fcheck.ml;h=f5fb6841c39a47efdc878408a1eb5a20f7f9deea;hb=bd1e80fb01cfb419e256d5899ac5bf8818f11e64;hp=fb9d553b8e40b7bc3f38f0f9c914b3b5eef98bfb;hpb=57e708bca8555d6146c4e3d07c0a9b6a546373ce;p=helm.git diff --git a/helm/software/components/ng_kernel/check.ml b/helm/software/components/ng_kernel/check.ml index fb9d553b8..f5fb6841c 100644 --- a/helm/software/components/ng_kernel/check.ml +++ b/helm/software/components/ng_kernel/check.ml @@ -12,9 +12,10 @@ (* $Id$ *) let debug = true -let ignore_exc = true +let ignore_exc = false let rank_all_dependencies = false let trust_environment = false +let print_object = true let indent = ref 0;; @@ -49,12 +50,20 @@ 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")] 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 @@ -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,57 @@ 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_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= 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 +204,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 ();