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

diff --git a/helm/gTopLevel/proofEngine.ml b/helm/gTopLevel/proofEngine.ml
index 972ae962a..73e2aa177 100644
--- a/helm/gTopLevel/proofEngine.ml
+++ b/helm/gTopLevel/proofEngine.ml
@@ -138,61 +138,10 @@ let perforate context term ty =
 
 (*CSC: generatore di nomi? Chiedere il nome? *)
 let fresh_name =
- let next_fresh_index = ref 0
-in
- function () ->
-  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
+ let next_fresh_index = ref 0 in
+  function () ->
+   incr next_fresh_index ;
+   "fresh_name" ^ string_of_int !next_fresh_index
 
 (* Reduces [term] using [reduction_function] in the current scratch goal [ty] *)
 let reduction_tactic_in_scratch reduction_function term ty =
@@ -209,55 +158,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                   *)
@@ -268,7 +173,7 @@ let fold term =
 let can_apply term = can_apply_tactic (PrimitiveTactics.apply_tac ~term)
 let apply term = apply_tactic (PrimitiveTactics.apply_tac ~term)
 let intros () =
-  apply_tactic (PrimitiveTactics.intros_tac ~name:(fresh_name ()))
+  apply_tactic (PrimitiveTactics.intros_tac ~mknames:fresh_name)
 let cut term = apply_tactic (PrimitiveTactics.cut_tac ~term)
 let letin term = apply_tactic (PrimitiveTactics.letin_tac ~term)
 let exact term = apply_tactic (PrimitiveTactics.exact_tac ~term)
@@ -282,9 +187,62 @@ 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_whd term =
+ apply_tactic
+  (ReductionTactics.fold_tac ~reduction:CicReduction.whd
+    ~also_in_hypotheses:true ~term)
+let fold_reduce term =
+ apply_tactic
+  (ReductionTactics.fold_tac ~reduction:ProofEngineReduction.reduce
+    ~also_in_hypotheses:true ~term)
+let fold_simpl term =
+ apply_tactic
+  (ReductionTactics.fold_tac ~reduction:ProofEngineReduction.simpl
+    ~also_in_hypotheses:true ~term)
+
   (* other tactics *)
 
-let elim_type term = apply_tactic (Ring.elim_type_tac ~term)
+let elim_type term = apply_tactic (VariousTactics.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 rewrite_simpl term = apply_tactic (VariousTactics.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 exists () = apply_tactic VariousTactics.exists_tac
+let split () = apply_tactic VariousTactics.split_tac 
+let left () = apply_tactic VariousTactics.left_tac
+let right () = apply_tactic VariousTactics.right_tac
+
+let assumption () = apply_tactic VariousTactics.assumption_tac
+
+let generalize term = apply_tactic (VariousTactics.generalize_tac ~term)
+
+let absurd term = apply_tactic (VariousTactics.absurd_tac ~term)
+let contradiction () = apply_tactic VariousTactics.contradiction_tac
+
+let decompose ~clist = apply_tactic (VariousTactics.decompose_tac ~clist)
+
+(*
+let decide_equality () = apply_tactic VariousTactics.decide_equality_tac
+let compare term1 term2 = apply_tactic (VariousTactics.compare_tac ~term1 ~term2)
+*)
+
+(*
+let prova_tatticali () = apply_tactic Tacticals.prova_tac
+*)
+