X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Ftactics%2FproofEngineStructuralRules.ml;h=47921953742be893160a5c5751570af6923b1d87;hb=b637879a2b3f2ceda65afb3c950061189c4730b7;hp=ea7586e164f77c3a03079bdc9142481eb396ac70;hpb=c6cc2a7227d6750076f591a62d7b1896ebf1ebfa;p=helm.git diff --git a/helm/software/components/tactics/proofEngineStructuralRules.ml b/helm/software/components/tactics/proofEngineStructuralRules.ml index ea7586e16..479219537 100644 --- a/helm/software/components/tactics/proofEngineStructuralRules.ml +++ b/helm/software/components/tactics/proofEngineStructuralRules.ml @@ -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 @@ -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