X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=components%2Ftactics%2FfwdSimplTactic.ml;h=fa7d4aef1543997e69609071e89e7c379b199860;hb=a996266824ef41b59130440804ef1777137802e7;hp=0bae64f6c6fb7bb1e22a1ac84d4400cc4e0ae20a;hpb=7f2444c2670cadafddd8785b687ef312158376b0;p=helm.git

diff --git a/components/tactics/fwdSimplTactic.ml b/components/tactics/fwdSimplTactic.ml
index 0bae64f6c..fa7d4aef1 100644
--- a/components/tactics/fwdSimplTactic.ml
+++ b/components/tactics/fwdSimplTactic.ml
@@ -35,6 +35,7 @@ module T = Tacticals
 module FNG = FreshNamesGenerator
 module MI = CicMkImplicit
 module PESR = ProofEngineStructuralRules
+module HEL = HExtlib
 
 let fail_msg0 = "unexported clearbody: invalid argument"
 let fail_msg2 = "fwd: no applicable simplification"
@@ -95,8 +96,16 @@ let strip_prods metasenv context ?how_many to_what term =
       | _, t                                  -> metasenv, metas, conts 
    in
    aux metasenv [] [] to_what (how_many, term)
-   
-let lapply_tac ?(mk_fresh_name_callback = FreshNamesGenerator.mk_fresh_name ~subst:[]) 
+
+let get_clearables context terms =
+   let aux = function
+      | Cic.Rel i 
+      | Cic.Appl (Cic.Rel i :: _) -> PEH.get_name context i
+      | _                         -> None
+   in
+   HEL.list_rev_map_filter aux terms 
+
+let lapply_tac_aux ?(mk_fresh_name_callback = FreshNamesGenerator.mk_fresh_name ~subst:[]) 
                (* ?(substs = []) *) ?how_many ?(to_what = []) what =
    let letin_tac term = PT.letin_tac ~mk_fresh_name_callback term in   
    let lapply_tac (proof, goal) =
@@ -104,12 +113,13 @@ let lapply_tac ?(mk_fresh_name_callback = FreshNamesGenerator.mk_fresh_name ~sub
       let _, context, _ = CicUtil.lookup_meta goal metasenv in
       let lemma, _ = TC.type_of_aux' metasenv context what U.empty_ugraph in
       let lemma = FNG.clean_dummy_dependent_types lemma in
-      let metasenv, metas, conts = strip_prods metasenv context ?how_many to_what lemma in      
+      let metasenv, metas, conts = strip_prods metasenv context ?how_many to_what lemma in
       let conclusion =  
          match metas with [] -> what | _ -> Cic.Appl (what :: List.rev metas)
       in
-      let tac = T.then_ ~start:(letin_tac conclusion) 
-        ~continuation:(clearbody ~index:1)
+      let tac =
+	 T.then_ ~start:(letin_tac conclusion) 
+                 ~continuation:(clearbody ~index:1)	 
       in
       let proof = (xuri, metasenv, u, t) in
       let aux (proof, goals) (tac, goal) = 
@@ -119,7 +129,26 @@ let lapply_tac ?(mk_fresh_name_callback = FreshNamesGenerator.mk_fresh_name ~sub
       List.fold_left aux (proof, []) ((tac, goal) :: conts)
    in
    PET.mk_tactic lapply_tac
-	 
+
+let lapply_tac ?(mk_fresh_name_callback = FreshNamesGenerator.mk_fresh_name ~subst:[]) 
+               (* ?(substs = []) *) ?(linear = false) ?how_many ?(to_what = []) what =
+   let lapply_tac status =
+      let proof, goal = status in
+      let _, metasenv, _, _ = proof in
+      let _, context, _ = CicUtil.lookup_meta goal metasenv in
+      let lapply = lapply_tac_aux ~mk_fresh_name_callback ?how_many ~to_what what in
+      let tac =  
+         if linear then 
+            let hyps = get_clearables context (what :: to_what) in
+	    T.then_ ~start:lapply
+	            ~continuation:(PESR.clear ~hyps) (* T.try_tactic ~tactic: *)
+	 else 
+	    lapply    
+	 in
+	 PET.apply_tactic tac status
+   in
+   PET.mk_tactic lapply_tac
+
 (* fwd **********************************************************************)
 
 let fwd_simpl_tac
@@ -138,7 +167,7 @@ let fwd_simpl_tac
          | uri :: _ -> 
 	    Printf.eprintf "fwd: %s\n" (UriManager.string_of_uri uri); flush stderr;
 	    let start = lapply_tac (Cic.Rel index) (Cic.Const (uri, [])) in  
-            let tac = T.then_ ~start ~continuation:(PESR.clear hyp) in
+            let tac = T.then_ ~start ~continuation:(PESR.clear ~hyps:[hyp]) in
             PET.apply_tactic tac status
    in
    PET.mk_tactic fwd_simpl_tac