X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fng_refiner%2Fcheck.ml;h=4adff1569d3051721352c6de92ee3e7be387d370;hb=b0b6b600e029435bfce53f41cd267c669a1f8dc2;hp=c1ce4260794ce9bb4388dc6a3f756f34eaa2ab5b;hpb=622b14b04e2076d75c283363969dab7d28380bfb;p=helm.git diff --git a/helm/software/components/ng_refiner/check.ml b/helm/software/components/ng_refiner/check.ml index c1ce42607..4adff1569 100644 --- a/helm/software/components/ng_refiner/check.ml +++ b/helm/software/components/ng_refiner/check.ml @@ -193,23 +193,47 @@ let _ = NCicTypeChecker.set_logger (fun _ -> ()); do_old_logging := false; prerr_endline "typechecking, first with the new and then with the old kernel"; - 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)) + match NCicLibrary.get_obj u with + | _,_,_,_,NCic.Constant (_,_,Some bo, ty, _) -> + let rec intros = function + | NCic.Prod (name, s, t) -> + let ctx, t = intros t in + ctx @ [(name, (NCic.Decl s))] , t + | t -> [], t + in + let ctx, ity = intros ty in + let sty, menv, _ = + NCicMetaSubst.saturate ~delta:max_int [] ctx ty 0 + in + let ctx, ty = intros ty in + let metasenv, subst = + try + NCicUnification.unify menv [] ctx ity sty + with + | NCicUnification.Uncertain msg + | NCicUnification.UnificationFailure msg + | NCicMetaSubst.MetaSubstFailure msg -> + prerr_endline (Lazy.force msg); + prerr_endline + (Printf.sprintf "RESULT OF UNIF\n%s\n%s == %s\n" + (NCicPp.ppcontext ~metasenv:menv ~subst:[] ctx) + (NCicPp.ppterm ~metasenv:menv ~subst:[] ~context:ctx ity) + (NCicPp.ppterm ~metasenv:menv ~subst:[] ~context:ctx sty)); + [], [] + in + if (NCicReduction.are_convertible + ~subst (fun ~subst:_ _ _ _ ->[]) ctx ity sty) + then + prerr_endline ("OK: " ^ NUri.string_of_uri u) + else + prerr_endline ("FAIL: " ^ NUri.string_of_uri u); + (*let inferred_ty = + NCicTypeChecker.typeof ~subst:[] ~metasenv:[] [] bo + in*) + | _ -> ()) alluris; - let dopo = Unix.gettimeofday () in - Gc.compact (); - let dopo2 = Unix.gettimeofday () in - Printf.eprintf "NEW typing: %3.2f, gc: %3.2f\n%!" (dopo -. prima) (dopo2 -. dopo); - CicEnvironment.invalidate (); - Gc.compact (); - let prima = Unix.gettimeofday () in - List.iter (fun u -> ignore (CicTypeChecker.typecheck u)) alluris; - let dopo = Unix.gettimeofday () in - Gc.compact (); - let dopo2 = Unix.gettimeofday () in - Printf.eprintf "OLD typing: %3.2f, gc: %3.2f\n%!" (dopo -. prima) (dopo2 -. dopo) ;;