From: Enrico Tassi <enrico.tassi@inria.fr>
Date: Wed, 6 Jul 2005 13:09:16 +0000 (+0000)
Subject: clear now fails if the hypothesys doesnt exist, and doesn not typecheck
X-Git-Tag: V_0_7_1~61
X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=commitdiff_plain;h=c56a4b2bad2b1332bc2eda646c18ac547c4ce102;p=helm.git

clear now fails if the hypothesys doesnt exist, and doesn not typecheck
the whole context
---

diff --git a/helm/ocaml/tactics/proofEngineStructuralRules.ml b/helm/ocaml/tactics/proofEngineStructuralRules.ml
index 17378ffe7..99c37f801 100644
--- a/helm/ocaml/tactics/proofEngineStructuralRules.ml
+++ b/helm/ocaml/tactics/proofEngineStructuralRules.ml
@@ -111,32 +111,38 @@ let clear ~hyp =
       List.map
        (function
            (m,canonical_context,ty) when m = metano ->
-             let canonical_context' =
+             let context_changed, canonical_context' =
               List.fold_right
-               (fun entry context ->
+               (fun entry (b, context) ->
                  match entry with
-                    Some (Cic.Name hyp',_) when hyp' = hyp -> None::context
-                  | None -> None::context
+                    Some (Cic.Name hyp',_) when hyp' = hyp -> 
+                      (true, None::context)
+                  | None -> (b, None::context)
                   | Some (_,Cic.Def (_,Some _)) -> assert false
                   | Some (n,C.Decl t)
                   | Some (n,C.Def (t,None)) ->
-                     let _,_ =
-                      try
-                       CicTypeChecker.type_of_aux' metasenv context t
-                        CicUniv.empty_ugraph (* TASSI: FIXME *)
-                      with _ ->
-                       raise
-                        (Fail
-                          ("Hypothesis " ^ string_of_name n ^
-                           " uses hypothesis " ^ hyp))
-                     in
-                      entry::context
-               ) canonical_context []
+                      if b then
+                         let _,_ =
+                          try
+                           CicTypeChecker.type_of_aux' metasenv context t
+                            CicUniv.empty_ugraph
+                          with _ ->
+                           raise
+                            (Fail
+                              ("Hypothesis " ^ string_of_name n ^
+                               " uses hypothesis " ^ hyp))
+                         in
+                          (b, entry::context)
+                      else
+                        (b, entry::context)
+               ) canonical_context (false, [])
              in
-              let _,_ =
+             if not context_changed then
+               raise (Fail ("Hypothesis " ^ hyp ^ " does not exist"));
+             let _,_ =
                try
                 CicTypeChecker.type_of_aux' metasenv canonical_context' ty
-                 CicUniv.empty_ugraph (* TASSI: FIXME *)
+                 CicUniv.empty_ugraph 
                with _ ->
                 raise (Fail ("Hypothesis " ^ hyp ^ " occurs in the goal"))
               in