X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Ftactics%2FproofEngineStructuralRules.ml;h=47921953742be893160a5c5751570af6923b1d87;hb=da3031c3a830df0aaab4f57b63689a1b20d7ab89;hp=636ea07c0f3c67d36ba04ae3dc4057a6de4b14e5;hpb=50afaf262195266d156f594cff7e92a6e8898b3e;p=helm.git

diff --git a/helm/software/components/tactics/proofEngineStructuralRules.ml b/helm/software/components/tactics/proofEngineStructuralRules.ml
index 636ea07c0..479219537 100644
--- a/helm/software/components/tactics/proofEngineStructuralRules.ml
+++ b/helm/software/components/tactics/proofEngineStructuralRules.ml
@@ -30,7 +30,7 @@ module C = Cic
 
 let clearbody ~hyp = 
  let clearbody (proof, goal) =
-   let curi,metasenv,pbo,pty, attrs = proof in
+   let curi,metasenv,_subst,pbo,pty, attrs = proof in
     let metano,_,_ = CicUtil.lookup_meta goal metasenv in
      let string_of_name =
       function
@@ -46,25 +46,14 @@ let clearbody ~hyp =
                (fun entry context ->
                  match entry with
                     Some (C.Name hyp',C.Def (term,ty)) when hyp = hyp' ->
-                     let cleared_entry =
-                      let ty =
-                       match ty with
-                          Some ty -> ty
-                        | None ->
-                           fst
-                            (CicTypeChecker.type_of_aux' metasenv context term
-                              CicUniv.empty_ugraph) (* TASSI: FIXME *)
-                      in
-                       Some (C.Name hyp, Cic.Decl ty)
-                     in
+                     let cleared_entry = Some (C.Name hyp, Cic.Decl ty) in
                       cleared_entry::context
                   | None -> None::context
-                  | Some (n,C.Decl t)
-                  | Some (n,C.Def (t,None)) ->
+                  | Some (n,C.Decl t) ->
                      let _,_ =
                       try
                        CicTypeChecker.type_of_aux' metasenv context t
-                        CicUniv.empty_ugraph (* TASSI: FIXME *)
+                        CicUniv.oblivion_ugraph (* TASSI: FIXME *)
                       with
                        _ ->
                          raise
@@ -75,13 +64,29 @@ let clearbody ~hyp =
                           ))
                      in
                       entry::context
-                  | Some (_,Cic.Def (_,Some _)) -> assert false
+                  | Some (n,Cic.Def (te,ty)) ->
+                     (try
+                       ignore
+                        (CicTypeChecker.type_of_aux' metasenv context te
+                          CicUniv.oblivion_ugraph (* TASSI: FIXME *));
+                       ignore
+                        (CicTypeChecker.type_of_aux' metasenv context ty
+                          CicUniv.oblivion_ugraph (* TASSI: FIXME *));
+                      with
+                       _ ->
+                         raise
+                          (PET.Fail
+                            (lazy ("The correctness of hypothesis " ^
+                             string_of_name n ^
+                             " relies on the body of " ^ hyp)
+                          )));
+                     entry::context
                ) canonical_context []
              in
               let _,_ =
                try
                 CicTypeChecker.type_of_aux' metasenv canonical_context' ty
-                 CicUniv.empty_ugraph (* TASSI: FIXME *)
+                 CicUniv.oblivion_ugraph (* TASSI: FIXME *)
                with
                 _ ->
                  raise
@@ -93,13 +98,13 @@ let clearbody ~hyp =
          | t -> t
        ) metasenv
      in
-      (curi,metasenv',pbo,pty, attrs), [goal]
+      (curi,metasenv',_subst,pbo,pty, attrs), [goal]
  in
   PET.mk_tactic clearbody
 
 let clear_one ~hyp =
  let clear_one (proof, goal) =
-   let curi,metasenv,pbo,pty, attrs = proof in
+   let curi,metasenv,_subst,pbo,pty, attrs = proof in
     let metano,context,ty =
      CicUtil.lookup_meta goal metasenv
     in
@@ -120,13 +125,12 @@ let clear_one ~hyp =
                       (true, None::context)
                   | None -> (b, None::context)
                   | Some (n,C.Decl t)
-                  | Some (n,Cic.Def (t,Some _))
-                  | Some (n,C.Def (t,None)) ->
+                  | Some (n,Cic.Def (t,_)) ->
                       if b then
                          let _,_ =
                           try
                            CicTypeChecker.type_of_aux' metasenv context t
-                            CicUniv.empty_ugraph
+                            CicUniv.oblivion_ugraph
                           with _ ->
                            raise
                             (PET.Fail
@@ -143,7 +147,7 @@ let clear_one ~hyp =
              let _,_ =
                try
                 CicTypeChecker.type_of_aux' metasenv canonical_context' ty
-                 CicUniv.empty_ugraph 
+                 CicUniv.oblivion_ugraph 
                with _ ->
                 raise (PET.Fail (lazy ("Hypothesis " ^ hyp ^ " occurs in the goal")))
               in
@@ -151,7 +155,7 @@ let clear_one ~hyp =
          | t -> t
        ) metasenv
      in
-      (curi,metasenv',pbo,pty, attrs), [goal]
+      (curi,metasenv',_subst,pbo,pty, attrs), [goal]
  in
   PET.mk_tactic clear_one
 
@@ -176,7 +180,7 @@ let rename ~froms ~tos =
          try List.combine froms tos
 	 with Invalid_argument _ -> raise (PET.Fail (lazy error))
       in
-      let curi, metasenv, pbo, pty, attrs = proof in
+      let curi, metasenv, _subst, pbo, pty, attrs = proof in
       let metano, _, _ = CicUtil.lookup_meta goal metasenv in      
       let rename_map = function
          | Some (Cic.Name hyp, decl_or_def) as entry ->
@@ -191,6 +195,6 @@ let rename ~froms ~tos =
          | conjecture -> conjecture
       in
       let metasenv = List.map map metasenv in
-      (curi, metasenv, pbo, pty, attrs), [goal]
+      (curi, metasenv, _subst, pbo, pty, attrs), [goal]
    in
    PET.mk_tactic rename