X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Ftactics%2Ftacticals.ml;h=34ecb2d99d1c68f6f18a58cca383cb396358f663;hb=4693f3b9de6d867921b51f61e9a7dc36c3da1b77;hp=d5ec8acfb8be6c9edee7f353ba9f5368f8314511;hpb=1212c08483bf6b652d2d013f4ce3bdb60a8388b8;p=helm.git diff --git a/helm/software/components/tactics/tacticals.ml b/helm/software/components/tactics/tacticals.ml index d5ec8acfb..34ecb2d99 100644 --- a/helm/software/components/tactics/tacticals.ml +++ b/helm/software/components/tactics/tacticals.ml @@ -42,7 +42,7 @@ module PET = ProofEngineTypes let id_tac = let id_tac (proof,goal) = - let _, metasenv, _subst, _, _, _ = proof in + let _, metasenv, _, _, _, _ = proof in let _, _, _ = CicUtil.lookup_meta goal metasenv in (proof,[goal]) in @@ -50,7 +50,7 @@ let id_tac = let fail_tac = let fail_tac (proof,goal) = - let _, metasenv, _subst, _ , _, _ = proof in + let _, metasenv, _, _ , _, _ = proof in let _, _, _ = CicUtil.lookup_meta goal metasenv in raise (PET.Fail (lazy "fail tactical")) in @@ -201,6 +201,23 @@ let if_ ~start ~continuation ~fail = in PET.mk_tactic if_ +let ifs ~start ~continuations ~fail = + let ifs status = + let xoutput = + try + let result = PET.apply_tactic start status in + info (lazy ("Tacticals.ifs: succedeed!!!")); + Some result + with PET.Fail _ -> None + in + let tactic = match xoutput with + | Some res -> thens ~start:(const_tac res) ~continuations + | None -> fail + in + PET.apply_tactic tactic status + in + PET.mk_tactic ifs + let first ~tactics = let rec first ~(tactics: tactic list) status = info (lazy "in Tacticals.first"); @@ -273,16 +290,18 @@ let solve_tactics ~tactics = let progress_tactic ~tactic = let msg = lazy "Failed to progress" in - let progress_tactic (((_,metasenv,_subst,_,_,_),_) as istatus) = - let ((_,metasenv',_subst,_,_,_),_) as ostatus = + let progress_tactic (((_,metasenv,_,_,_,_),g) as istatus) = + let ((_,metasenv',_,_,_,_),opened) as ostatus = PET.apply_tactic tactic istatus in - (*CSC: Warning - If just the index of some metas changes the tactic is recognized - as a progressing one. This is wrong. *) - if metasenv' = metasenv then - raise (PET.Fail msg) - else - ostatus + match opened with + | [g1] -> + let _,oc,oldty = CicUtil.lookup_meta g metasenv in + let _,nc,newty = CicUtil.lookup_meta g1 metasenv' in + if oldty = newty && oc = nc then + raise (PET.Fail msg) + else + ostatus + | _ -> ostatus in PET.mk_tactic progress_tactic