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=467d611474a0fe185e68786747ec78c59321233c;hpb=25bc159057b95f144495872b55115a1762561d69;p=helm.git diff --git a/helm/software/components/ng_kernel/check.ml b/helm/software/components/ng_kernel/check.ml index 467d61147..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,24 +142,18 @@ let _ = try load_graph u with exn -> ()) roots_alluris; prerr_endline "finished...."; - let lll,uuu = List.sort compare (CicUniv.do_rank (get_graph ())) in + 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 (string_of_universe k ^ " = " ^ string_of_int (Cicuniv.get_rank k))) uuu - in + 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); + NCicEnvironment.add_lt_constraint (mk_type a) (mk_type b); + NCicEnvironment.add_lt_constraint (mk_type a) (mk_cprop b); 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 @@ -173,17 +167,25 @@ let _ = let uu= OCic2NCic.nuri_of_ouri uu in indent := 0; let o = NCicLibrary.get_obj uu in - prerr_endline (NCicPp.ppobj o); + 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.BadConstraint 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 (); @@ -195,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 ();