X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=matita%2Fcomponents%2Fng_refiner%2FnCicUnification.ml;h=6f1d8718ae02d8c1b0998c1664c498b4959735f4;hb=HEAD;hp=bf5c009f4c018b71cf6f4fb9d00cbbced147f038;hpb=473819a43c9f376324865ecb3b4534f4e6cc6248;p=helm.git

diff --git a/matita/components/ng_refiner/nCicUnification.ml b/matita/components/ng_refiner/nCicUnification.ml
index bf5c009f4..6f1d8718a 100644
--- a/matita/components/ng_refiner/nCicUnification.ml
+++ b/matita/components/ng_refiner/nCicUnification.ml
@@ -19,7 +19,7 @@ exception KeepReducingThis of
   string Lazy.t * (NCicReduction.machine * bool) * 
                   (NCicReduction.machine * bool) ;;
 
-let (===) x y = Pervasives.compare x y = 0 ;;
+let (===) x y = Stdlib.compare x y = 0 ;;
 
 let mk_msg (status:#NCic.status) metasenv subst context t1 t2 =
  (lazy (
@@ -134,13 +134,17 @@ 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 (_,_,he,_) ->
+     let he = NCicReduction.whd status ~subst context he in
+      could_reduce status ~subst context he
+  | 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
 ;;
@@ -229,6 +233,31 @@ let rec sortfy status exc metasenv subst context t =
  in
   metasenv,subst,t
 
+let indfy status exc metasenv subst context t =
+ let t = NCicReduction.whd status ~subst context t in
+ let metasenv,subst =
+  match t with
+   | NCic.Const (Ref.Ref (_, Ref.Ind _))
+   | NCic.Appl (NCic.Const (Ref.Ref (_, Ref.Ind _))::_) -> metasenv, subst
+(*
+   | NCic.Meta (n,_) -> 
+      let attrs, context, ty = NCicUtils.lookup_meta n metasenv in
+      let kind = NCicUntrusted.kind_of_meta attrs in
+       if kind = `IsSort then
+        metasenv,subst
+       else
+        (match ty with
+          | NCic.Implicit (`Typeof _) ->
+              metasenv_to_subst n (`IsSort,[],ty) metasenv subst
+          | ty ->
+             let metasenv,subst,ty = sortfy status exc metasenv subst context ty in
+              metasenv_to_subst n (`IsSort,[],ty) metasenv subst)
+*)
+   | NCic.Implicit _ -> assert false
+   | _ -> raise exc
+ in
+  metasenv,subst,t
+
 let tipify status exc metasenv subst context t ty =
  let is_type attrs =
   match NCicUntrusted.kind_of_meta attrs with
@@ -247,7 +276,7 @@ let tipify status exc metasenv subst context t ty =
          let metasenv,subst,ty = sortfy status exc metasenv subst cc ty in
          let metasenv = 
            NCicUntrusted.replace_in_metasenv n
-            (fun attrs,cc,_ -> NCicUntrusted.set_kind `IsType attrs, cc, ty)
+            (fun (attrs,cc,_) -> NCicUntrusted.set_kind `IsType attrs, cc, ty)
             metasenv 
          in
           metasenv,subst,false
@@ -261,7 +290,7 @@ let tipify status exc metasenv subst context t ty =
           let metasenv,subst,ty = sortfy status exc metasenv subst cc ty in
           let subst = 
             NCicUntrusted.replace_in_subst n
-              (fun attrs,cc,bo,_->NCicUntrusted.set_kind `IsType attrs,cc,bo,ty)
+              (fun (attrs,cc,bo,_)->NCicUntrusted.set_kind `IsType attrs,cc,bo,ty)
              subst 
           in
            optimize_meta metasenv subst (NCicSubstitution.subst_meta status lc bo))
@@ -410,6 +439,8 @@ and unify_for_delift status metasenv subst context t1 t2 =
    try Some
     (fo_unif_w_hints true status false true(*test_eq_only*) metasenv subst
       context (false,t1) (false,t2))
+    (*(unify status true(*test_eq_only*) metasenv subst
+      context t1 t2 false)*)
    with UnificationFailure _ | Uncertain _ | KeepReducingThis _ -> None
  in
  indent := ind; res
@@ -526,8 +557,7 @@ and fo_unif0 during_delift status swap test_eq_only metasenv subst context (norm
                i
           | NCic.Meta (i,_) -> (metasenv, subst), i
           | _ ->
-             raise (UnificationFailure (lazy "Locked term vs non
-              flexible term; probably not saturated enough yet!"))
+             raise (UnificationFailure (lazy "Locked term vs non flexible term; probably not saturated enough yet!"))
          in
           let t1 = NCicReduction.whd status ~subst context t1 in
           let j, lj = 
@@ -722,7 +752,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 +916,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