X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2FgTopLevel%2FproofEngine.ml;h=55531c2aadd5b2c8c3d6446a536deb0804252683;hb=7d47820d03f154a86c966fb72c52f42b6c52176a;hp=972ae962afa3805ea0de092df33f0733809dd3b0;hpb=3066e4dcb7270a5eb20020a91d45da9eb87e2f2e;p=helm.git

diff --git a/helm/gTopLevel/proofEngine.ml b/helm/gTopLevel/proofEngine.ml
index 972ae962a..55531c2aa 100644
--- a/helm/gTopLevel/proofEngine.ml
+++ b/helm/gTopLevel/proofEngine.ml
@@ -144,56 +144,6 @@ in
   incr next_fresh_index ;
   "fresh_name" ^ string_of_int !next_fresh_index
 
-let reduction_tactic reduction_function term =
- let curi,metasenv,pbo,pty =
-  match !proof with
-     None -> assert false
-   | Some (curi,metasenv,bo,ty) -> curi,metasenv,bo,ty
- in
- let metano,context,ty =
-  match !goal with
-     None -> assert false
-   | Some metano -> List.find (function (m,_,_) -> m=metano) metasenv
- in
-  (* We don't know if [term] is a subterm of [ty] or a subterm of *)
-  (* the type of one metavariable. So we replace it everywhere.   *)
-  (*CSC: Il vero problema e' che non sapendo dove sia il term non *)
-  (*CSC: sappiamo neppure quale sia il suo contesto!!!! Insomma,  *)
-  (*CSC: e' meglio prima cercare il termine e scoprirne il        *)
-  (*CSC: contesto, poi ridurre e infine rimpiazzare.              *)
-   let replace context where=
-(*CSC: Per il momento se la riduzione fallisce significa solamente che *)
-(*CSC: siamo nel contesto errato. Metto il try, ma che schifo!!!!      *)
-(*CSC: Anche perche' cosi' catturo anche quelle del replace che non dovrei *)
-   try
-    let term' = reduction_function context term in
-     ProofEngineReduction.replace ~equality:(==) ~what:term ~with_what:term'
-      ~where:where
-   with
-    _ -> where
-   in
-    let ty' = replace context ty in
-    let context' =
-     List.fold_right
-      (fun entry context ->
-        match entry with
-           Some (name,Cic.Def  t) ->
-            (Some (name,Cic.Def  (replace context t)))::context
-         | Some (name,Cic.Decl t) ->
-            (Some (name,Cic.Decl (replace context t)))::context
-         | None -> None::context
-      ) context []
-    in
-     let metasenv' = 
-      List.map
-       (function
-           (n,_,_) when n = metano -> (metano,context',ty')
-         | _ as t -> t
-       ) metasenv
-     in
-      proof := Some (curi,metasenv',pbo,pty) ;
-      goal := Some metano
-
 (* Reduces [term] using [reduction_function] in the current scratch goal [ty] *)
 let reduction_tactic_in_scratch reduction_function term ty =
  let metasenv =
@@ -209,55 +159,11 @@ let reduction_tactic_in_scratch reduction_function term ty =
   let term' = reduction_function context term in
    ProofEngineReduction.replace
     ~equality:(==) ~what:term ~with_what:term' ~where:ty
-
-let whd    = reduction_tactic CicReduction.whd
-let reduce = reduction_tactic ProofEngineReduction.reduce
-let simpl  = reduction_tactic ProofEngineReduction.simpl
+;;
 
 let whd_in_scratch    = reduction_tactic_in_scratch CicReduction.whd
-let reduce_in_scratch =
- reduction_tactic_in_scratch ProofEngineReduction.reduce
-let simpl_in_scratch  =
- reduction_tactic_in_scratch ProofEngineReduction.simpl
-
-(* It is just the opposite of whd. The code should probably be merged. *)
-let fold term =
- let curi,metasenv,pbo,pty =
-  match !proof with
-     None -> assert false
-   | Some (curi,metasenv,bo,ty) -> curi,metasenv,bo,ty
- in
- let metano,context,ty =
-  match !goal with
-     None -> assert false
-   | Some metano -> List.find (function (m,_,_) -> m=metano) metasenv
- in
-  let term' = CicReduction.whd context term in
-   (* We don't know if [term] is a subterm of [ty] or a subterm of *)
-   (* the type of one metavariable. So we replace it everywhere.   *)
-   (*CSC: ma si potrebbe ovviare al problema. Ma non credo *)
-   (*CSC: che si guadagni nulla in fatto di efficienza.    *) 
-   let replace =
-    ProofEngineReduction.replace ~equality:(=) ~what:term' ~with_what:term
-   in
-    let ty' = replace ty in
-    let context' =
-     List.map
-      (function
-          Some (n,Cic.Decl t) -> Some (n,Cic.Decl (replace t))
-        | Some (n,Cic.Def t)  -> Some (n,Cic.Def  (replace t))
-        | None -> None
-      ) context
-    in
-     let metasenv' = 
-      List.map
-       (function
-           (n,_,_) when n = metano -> (metano,context',ty')
-         | _ as t -> t
-       ) metasenv
-     in
-      proof := Some (curi,metasenv',pbo,pty) ;
-      goal := Some metano
+let reduce_in_scratch = reduction_tactic_in_scratch ProofEngineReduction.reduce
+let simpl_in_scratch  = reduction_tactic_in_scratch ProofEngineReduction.simpl
 
 (************************************************************)
 (*              Tactics defined elsewhere                   *)
@@ -282,9 +188,37 @@ let change ~goal_input:what ~input:with_what =
 let clearbody hyp = apply_tactic (ProofEngineStructuralRules.clearbody ~hyp)
 let clear hyp = apply_tactic (ProofEngineStructuralRules.clear ~hyp)
 
+  (* reduction tactics *)
+
+let whd term =
+ apply_tactic
+  (ReductionTactics.whd_tac ~also_in_hypotheses:true ~term:(Some term))
+let reduce term =
+ apply_tactic
+  (ReductionTactics.reduce_tac ~also_in_hypotheses:true ~term:(Some term))
+let simpl term =
+ apply_tactic
+  (ReductionTactics.simpl_tac ~also_in_hypotheses:true ~term:(Some term))
+
+let fold term =
+ apply_tactic (ReductionTactics.fold_tac ~also_in_hypotheses:true ~term)
+
   (* other tactics *)
 
 let elim_type term = apply_tactic (Ring.elim_type_tac ~term)
 let ring () = apply_tactic Ring.ring_tac
 let fourier () = apply_tactic FourierR.fourier_tac
 let rewrite_simpl term = apply_tactic (FourierR.rewrite_simpl_tac ~term)
+
+let reflexivity () = apply_tactic VariousTactics.reflexivity_tac
+let symmetry () = apply_tactic VariousTactics.symmetry_tac
+let transitivity term = apply_tactic (VariousTactics.transitivity_tac ~term)
+
+let left () = apply_tactic VariousTactics.left_tac
+let right () = apply_tactic VariousTactics.right_tac
+
+let assumption () = apply_tactic VariousTactics.assumption_tac
+(*
+let prova_tatticali () = apply_tactic Tacticals.prova_tac
+*)
+