X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fng_kernel%2FnCicReduction.ml;h=6105dd3a08c68739c3a0e208c19923c38bd86a09;hb=912780aaffd1e3a107a837dac1443ad2476e94b7;hp=d37fdd441d3c689772e28fd9dd7e20712b6ac2d1;hpb=0c2737f166a10e0799c9f3d3c260c26c29c403de;p=helm.git diff --git a/helm/software/components/ng_kernel/nCicReduction.ml b/helm/software/components/ng_kernel/nCicReduction.ml index d37fdd441..6105dd3a0 100644 --- a/helm/software/components/ng_kernel/nCicReduction.ml +++ b/helm/software/components/ng_kernel/nCicReduction.ml @@ -114,7 +114,9 @@ module Reduction(RS : Strategy) = struct aux (k, e, he, tl' @ s) | (_, _, C.Const (Ref.Ref (_,Ref.Def height) as refer), s) as config -> - if delta >= height then config, false else + if delta >= height then + config, false + else let _,_,body,_,_,_ = NCicEnvironment.get_checked_def refer in aux (0, [], body, s) | (_, _, C.Const (Ref.Ref (_, @@ -154,18 +156,20 @@ module Reduction(RS : Strategy) = struct c | config -> config in - (match decofix (fst (reduce ~delta:0 ~subst context (k,e,term,[]))) with + let match_head = k,e,term,[] in + let reduced,_ = reduce ~delta:0 ~subst context match_head in + (match decofix reduced with | (_, _, C.Const (Ref.Ref (_,Ref.Con (_,j,_))),[]) -> aux (k, e, List.nth pl (j-1), s) | (_, _, C.Const (Ref.Ref (_,Ref.Con (_,j,lno))), s')-> let _,params = HExtlib.split_nth lno s' in aux (k, e, List.nth pl (j-1), params@s) - | _ -> config,true) + | _ -> config, true) in aux ;; - let whd ?(delta=0) ?(subst=[]) context t = + let whd ?(delta=0) ~subst context t = unwind (fst (reduce ~delta ~subst context (0, [], t, []))) ;; @@ -180,12 +184,12 @@ let whd = R.whd let (===) x y = Pervasives.compare x y = 0 ;; -let get_relevance = ref (fun ~subst:_ _ _ -> assert false);; +let get_relevance = ref (fun ~metasenv:_ ~subst:_ _ _ -> assert false);; let set_get_relevance f = get_relevance := f;; (* t1, t2 must be well-typed *) -let are_convertible ?(subst=[]) = +let are_convertible ~metasenv ~subst = let rec aux test_eq_only context t1 t2 = let alpha_eq test_eq_only t1 t2 = if t1 === t2 then @@ -224,8 +228,8 @@ let are_convertible ?(subst=[]) = with Invalid_argument "List.for_all2" -> prerr_endline ("Meta " ^ string_of_int n1 ^ " occurrs with local contexts of different lenght\n"^ - NCicPp.ppterm ~metasenv:[] ~subst ~context t1 ^ " === " ^ - NCicPp.ppterm ~metasenv:[] ~subst ~context t2); + NCicPp.ppterm ~metasenv ~subst ~context t1 ^ " === " ^ + NCicPp.ppterm ~metasenv ~subst ~context t2); assert false) -> true | C.Meta (n1,l1), _ -> @@ -257,7 +261,8 @@ let are_convertible ?(subst=[]) = tl1 tl2 true relevance with Invalid_argument _ -> false | HExtlib.FailureAt fail -> - let relevance = !get_relevance ~subst context hd1 tl1 in + let relevance = + !get_relevance ~metasenv ~subst context hd1 tl1 in let _,relevance = HExtlib.split_nth fail relevance in let b,relevance = (match relevance with | [] -> assert false @@ -274,7 +279,7 @@ let are_convertible ?(subst=[]) = | (C.Appl (hd1::tl1), C.Appl (hd2::tl2)) -> aux test_eq_only context hd1 hd2 && - let relevance = !get_relevance ~subst context hd1 tl1 in + let relevance = !get_relevance ~metasenv ~subst context hd1 tl1 in (try HExtlib.list_forall_default3 (fun t1 t2 b -> not b || aux test_eq_only context t1 t2)