]> matita.cs.unibo.it Git - helm.git/commitdiff
Bugfix: NCicUnification.could_reduce now performs whd in the applied fixpoint
authorWilmer Ricciotti <ricciott@cs.unibo.it>
Tue, 10 Jan 2012 14:28:55 +0000 (14:28 +0000)
committerWilmer Ricciotti <ricciott@cs.unibo.it>
Tue, 10 Jan 2012 14:28:55 +0000 (14:28 +0000)
case, to prevent the recursive call from raising assert failure.

matita/components/ng_refiner/nCicUnification.ml
matita/components/ng_refiner/nCicUnification.mli

index bf5c009f4c018b71cf6f4fb9d00cbbced147f038..b4bc32fe6035dc7bded70504a0826222ca2d63dc 100644 (file)
@@ -134,13 +134,15 @@ let rec mk_irl stop base =
 ;;
 
 (* the argument must be a term in whd *)
-let rec could_reduce =
+let rec could_reduce status ~subst context =
  function
   | C.Meta _ -> true
   | C.Appl (C.Const (Ref.Ref (_,Ref.Fix (_,recno,_)))::args)
-     when List.length args > recno -> could_reduce (List.nth args recno)
-  | C.Match (_,_,arg,_) -> could_reduce arg
-  | C.Appl (he::_) -> could_reduce he
+     when List.length args > recno ->
+      let t = NCicReduction.whd status ~subst context (List.nth args recno) in
+        could_reduce status subst context t
+  | C.Match (_,_,arg,_) -> could_reduce status ~subst context arg
+  | C.Appl (he::_) -> could_reduce status ~subst context he
   | C.Sort _ | C.Rel _ | C.Prod _ | C.Lambda _ | C.Const _ -> false
   | C.Appl [] | C.LetIn _ | C.Implicit _ -> assert false
 ;;
@@ -722,7 +724,7 @@ and fo_unif0 during_delift status swap test_eq_only metasenv subst context (norm
          with Invalid_argument _ -> assert false)
    | (C.Implicit _, _) | (_, C.Implicit _) -> assert false
    | _ when norm1 && norm2 ->
-       if (could_reduce t1 || could_reduce t2) then
+       if (could_reduce status ~subst context t1 || could_reduce status ~subst context t2) then
         raise (Uncertain (mk_msg status metasenv subst context t1 t2))
        else
         raise (UnificationFailure (mk_msg status metasenv subst context t1 t2))
@@ -886,8 +888,8 @@ and unify status test_eq_only metasenv subst context t1 t2 swap =
          | UnificationFailure _ | Uncertain _ when (not (norm1 && norm2))
            -> unif_machines metasenv subst (small_delta_step ~subst m1 m2)
          | UnificationFailure msg
-           when could_reduce (NCicReduction.unwind status (fst m1))
-             || could_reduce (NCicReduction.unwind status (fst m2))
+           when could_reduce status ~subst context (NCicReduction.unwind status (fst m1))
+             || could_reduce status ~subst context (NCicReduction.unwind status (fst m2))
            -> raise (Uncertain msg)
       (*D*)  in outside None; rc with exn -> outside (Some exn); raise exn 
      in
index 510a31136a983e3eb9d9c9b6f8e9d028569d499e..c7d44e8ab555d1cd7246e7809eb449b702ac6148 100644 (file)
@@ -30,7 +30,7 @@ val fix_sorts:
 
 (* this should be moved elsewhere *)
 (* The term must be in whd *)
-val could_reduce: NCic.term -> bool
+val could_reduce: #NCicCoercion.status -> subst:NCic.substitution -> NCic.context -> NCic.term -> bool
 
 (* delift_type_wrt_terms st m s c t args
  *   lift t (length args)