Cooking implemented (not tested yet).

[helm.git] / helm / software / components / tactics / proofEngineStructuralRules.ml

diff --git a/helm/software/components/tactics/proofEngineStructuralRules.ml b/helm/software/components/tactics/proofEngineStructuralRules.ml
index ea7586e164f77c3a03079bdc9142481eb396ac70..3f96677b8b01d8bd0e7c5bc07d419b26ccfccd3a 100644 (file)
--- a/helm/software/components/tactics/proofEngineStructuralRules.ml
+++ b/helm/software/components/tactics/proofEngineStructuralRules.ml
@@ -46,21 +46,10 @@ 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
@@ -75,7 +64,23 @@ 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.empty_ugraph (* TASSI: FIXME *));
+                       ignore
+                        (CicTypeChecker.type_of_aux' metasenv context ty
+                          CicUniv.empty_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 _,_ =
@@ -120,8 +125,7 @@ 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