]> matita.cs.unibo.it Git - helm.git/commitdiff
Rearranged tactics in VariousTactics into new modules EqualityTactics, EliminationTac...
authorMichele Galatà <??>
Thu, 12 Dec 2002 09:08:38 +0000 (09:08 +0000)
committerMichele Galatà <??>
Thu, 12 Dec 2002 09:08:38 +0000 (09:08 +0000)
IntroductionTactics and NegationTactics.
Added new tactics: Rewrite <-, Replace.

helm/gTopLevel/.depend
helm/gTopLevel/Makefile
helm/gTopLevel/fourierR.ml
helm/gTopLevel/gTopLevel.ml
helm/gTopLevel/proofEngine.ml
helm/gTopLevel/proofEngine.mli
helm/gTopLevel/ring.ml
helm/gTopLevel/variousTactics.ml
helm/gTopLevel/variousTactics.mli

index 5e8706933e83e0cb67eea83b2ab9e63bc83e7e9b..03c071b5cb5e60ff8dd26bc6bc4012de3421ed73 100644 (file)
@@ -23,34 +23,58 @@ primitiveTactics.cmx: proofEngineHelpers.cmx proofEngineReduction.cmx \
     primitiveTactics.cmi 
 primitiveTactics.cmi: proofEngineTypes.cmo 
 variousTactics.cmo: primitiveTactics.cmi proofEngineHelpers.cmi \
-    proofEngineReduction.cmi proofEngineStructuralRules.cmi \
-    proofEngineTypes.cmo reductionTactics.cmi tacticals.cmi \
-    variousTactics.cmi 
+    proofEngineTypes.cmo tacticals.cmi variousTactics.cmi 
 variousTactics.cmx: primitiveTactics.cmx proofEngineHelpers.cmx \
-    proofEngineReduction.cmx proofEngineStructuralRules.cmx \
-    proofEngineTypes.cmx reductionTactics.cmx tacticals.cmx \
-    variousTactics.cmi 
+    proofEngineTypes.cmx tacticals.cmx variousTactics.cmi 
 variousTactics.cmi: proofEngineTypes.cmo 
-ring.cmo: primitiveTactics.cmi proofEngineStructuralRules.cmi \
-    proofEngineTypes.cmo tacticals.cmi variousTactics.cmi ring.cmi 
-ring.cmx: primitiveTactics.cmx proofEngineStructuralRules.cmx \
-    proofEngineTypes.cmx tacticals.cmx variousTactics.cmx ring.cmi 
+introductionTactics.cmo: primitiveTactics.cmi proofEngineTypes.cmo \
+    introductionTactics.cmi 
+introductionTactics.cmx: primitiveTactics.cmx proofEngineTypes.cmx \
+    introductionTactics.cmi 
+introductionTactics.cmi: proofEngineTypes.cmo 
+eliminationTactics.cmo: primitiveTactics.cmi proofEngineStructuralRules.cmi \
+    proofEngineTypes.cmo tacticals.cmi eliminationTactics.cmi 
+eliminationTactics.cmx: primitiveTactics.cmx proofEngineStructuralRules.cmx \
+    proofEngineTypes.cmx tacticals.cmx eliminationTactics.cmi 
+eliminationTactics.cmi: proofEngineTypes.cmo 
+negationTactics.cmo: eliminationTactics.cmi primitiveTactics.cmi \
+    proofEngineTypes.cmo tacticals.cmi variousTactics.cmi negationTactics.cmi 
+negationTactics.cmx: eliminationTactics.cmx primitiveTactics.cmx \
+    proofEngineTypes.cmx tacticals.cmx variousTactics.cmx negationTactics.cmi 
+negationTactics.cmi: proofEngineTypes.cmo 
+equalityTactics.cmo: introductionTactics.cmi primitiveTactics.cmi \
+    proofEngineHelpers.cmi proofEngineReduction.cmi \
+    proofEngineStructuralRules.cmi proofEngineTypes.cmo reductionTactics.cmi \
+    tacticals.cmi equalityTactics.cmi 
+equalityTactics.cmx: introductionTactics.cmx primitiveTactics.cmx \
+    proofEngineHelpers.cmx proofEngineReduction.cmx \
+    proofEngineStructuralRules.cmx proofEngineTypes.cmx reductionTactics.cmx \
+    tacticals.cmx equalityTactics.cmi 
+equalityTactics.cmi: proofEngineTypes.cmo 
+ring.cmo: eliminationTactics.cmi equalityTactics.cmi primitiveTactics.cmi \
+    proofEngineStructuralRules.cmi proofEngineTypes.cmo tacticals.cmi \
+    ring.cmi 
+ring.cmx: eliminationTactics.cmx equalityTactics.cmx primitiveTactics.cmx \
+    proofEngineStructuralRules.cmx proofEngineTypes.cmx tacticals.cmx \
+    ring.cmi 
 ring.cmi: proofEngineTypes.cmo 
-fourierR.cmo: fourier.cmo primitiveTactics.cmi proofEngineHelpers.cmi \
-    proofEngineTypes.cmo reductionTactics.cmi ring.cmi tacticals.cmi \
-    variousTactics.cmi fourierR.cmi 
-fourierR.cmx: fourier.cmx primitiveTactics.cmx proofEngineHelpers.cmx \
-    proofEngineTypes.cmx reductionTactics.cmx ring.cmx tacticals.cmx \
-    variousTactics.cmx fourierR.cmi 
+fourierR.cmo: equalityTactics.cmi fourier.cmo primitiveTactics.cmi \
+    proofEngineHelpers.cmi proofEngineTypes.cmo reductionTactics.cmi ring.cmi \
+    tacticals.cmi fourierR.cmi 
+fourierR.cmx: equalityTactics.cmx fourier.cmx primitiveTactics.cmx \
+    proofEngineHelpers.cmx proofEngineTypes.cmx reductionTactics.cmx ring.cmx \
+    tacticals.cmx fourierR.cmi 
 fourierR.cmi: proofEngineTypes.cmo 
-proofEngine.cmo: fourierR.cmi primitiveTactics.cmi proofEngineHelpers.cmi \
-    proofEngineReduction.cmi proofEngineStructuralRules.cmi \
-    proofEngineTypes.cmo reductionTactics.cmi ring.cmi variousTactics.cmi \
-    proofEngine.cmi 
-proofEngine.cmx: fourierR.cmx primitiveTactics.cmx proofEngineHelpers.cmx \
-    proofEngineReduction.cmx proofEngineStructuralRules.cmx \
-    proofEngineTypes.cmx reductionTactics.cmx ring.cmx variousTactics.cmx \
-    proofEngine.cmi 
+proofEngine.cmo: eliminationTactics.cmi equalityTactics.cmi fourierR.cmi \
+    introductionTactics.cmi negationTactics.cmi primitiveTactics.cmi \
+    proofEngineHelpers.cmi proofEngineReduction.cmi \
+    proofEngineStructuralRules.cmi proofEngineTypes.cmo reductionTactics.cmi \
+    ring.cmi variousTactics.cmi proofEngine.cmi 
+proofEngine.cmx: eliminationTactics.cmx equalityTactics.cmx fourierR.cmx \
+    introductionTactics.cmx negationTactics.cmx primitiveTactics.cmx \
+    proofEngineHelpers.cmx proofEngineReduction.cmx \
+    proofEngineStructuralRules.cmx proofEngineTypes.cmx reductionTactics.cmx \
+    ring.cmx variousTactics.cmx proofEngine.cmi 
 proofEngine.cmi: proofEngineTypes.cmo 
 doubleTypeInference.cmo: doubleTypeInference.cmi 
 doubleTypeInference.cmx: doubleTypeInference.cmi 
index e86d2c1794679ee8ab8f4cdcb9687401736e97b9..e4ece089e7b50aea1c6241e51e1e66b5dc0cf78e 100644 (file)
@@ -19,6 +19,8 @@ DEPOBJS = xml2Gdome.ml xml2Gdome.mli proofEngineTypes.ml proofEngineHelpers.ml \
           proofEngineStructuralRules.ml proofEngineStructuralRules.mli \
           tacticals.ml tacticals.mli reductionTactics.ml reductionTactics.mli \
           primitiveTactics.ml primitiveTactics.mli variousTactics.ml variousTactics.mli \
+          introductionTactics.ml introductionTactics.mli eliminationTactics.ml eliminationTactics.mli \
+          negationTactics.ml negationTactics.mli equalityTactics.ml equalityTactics.mli \
           ring.ml ring.mli fourier.ml fourierR.ml fourierR.mli\
          proofEngine.ml proofEngine.mli \
           doubleTypeInference.ml doubleTypeInference.mli cic2acic.ml \
@@ -29,7 +31,8 @@ DEPOBJS = xml2Gdome.ml xml2Gdome.mli proofEngineTypes.ml proofEngineHelpers.ml \
 TOPLEVELOBJS = xml2Gdome.cmo proofEngineTypes.cmo proofEngineHelpers.cmo \
               proofEngineReduction.cmo proofEngineStructuralRules.cmo \
                tacticals.cmo reductionTactics.cmo primitiveTactics.cmo \
-               variousTactics.cmo ring.cmo fourier.cmo fourierR.cmo \
+               variousTactics.cmo introductionTactics.cmo eliminationTactics.cmo \
+               negationTactics.cmo equalityTactics.cmo ring.cmo fourier.cmo fourierR.cmo \
                proofEngine.cmo doubleTypeInference.cmo cic2acic.cmo \
                cic2Xml.cmo logicalOperations.cmo sequentPp.cmo \
               mQueryLevels.cmo mQueryLevels2.cmo mQueryGenerator.cmo \
index bb1c2febf583893ed8c81fe387908782c39b0d3f..4008836fcb655fffaa272e766da77d27c2eb2e0c 100644 (file)
@@ -969,7 +969,7 @@ debug("inizio EQ\n");
    let metasenv' = (fresh_meta,context,a_eq_b)::metasenv in
 debug("chamo rewrite tac su"^CicPp.ppterm (C.Meta (fresh_meta,irl)));
    let (proof,goals) =
-    VariousTactics.rewrite_simpl_tac ~term:(C.Meta (fresh_meta,irl))
+    EqualityTactics.rewrite_simpl_tac ~term:(C.Meta (fresh_meta,irl))
      ~status:((curi,metasenv',pbo,pty),goal)
    in
    let new_goals = fresh_meta::goals in
@@ -984,7 +984,7 @@ let tcl_fail a ~status:(proof,goal) =
        |_-> (proof,[goal])
 ;;
 
-
+(* Galla: moved in variousTactics.ml 
 let assumption_tac ~status:(proof,goal)=
   let curi,metasenv,pbo,pty = proof in
   let metano,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
@@ -999,7 +999,8 @@ let assumption_tac ~status:(proof,goal)=
   in
   Tacticals.try_tactics ~tactics:tac_list ~status:(proof,goal)
 ;;
-
+*)
+(* Galla: moved in negationTactics.ml
 (* !!!!! fix !!!!!!!!!! *)
 let contradiction_tac ~status:(proof,goal)=
        Tacticals.then_ 
@@ -1010,6 +1011,7 @@ let contradiction_tac ~status:(proof,goal)=
                        ~continuation:(assumption_tac))
        ~status:(proof,goal) 
 ;;
+*)
 
 (* ********************* TATTICA ******************************** *)
 
index c78c5caff5c42e1f59d13f88d88e7575ca5dd54d..546a0308a96c786b2cc9210b52dacca11be59ff4 100644 (file)
@@ -2296,6 +2296,8 @@ let clearbody = call_tactic_with_hypothesis_input ProofEngine.clearbody;;
 let clear = call_tactic_with_hypothesis_input ProofEngine.clear;;
 let fourier = call_tactic ProofEngine.fourier;;
 let rewritesimpl = call_tactic_with_input ProofEngine.rewrite_simpl;;
+let rewritebacksimpl = call_tactic_with_input ProofEngine.rewrite_back_simpl;;
+let replace = call_tactic_with_input_and_goal_input ProofEngine.replace;;
 let reflexivity = call_tactic ProofEngine.reflexivity;;
 let symmetry = call_tactic ProofEngine.symmetry;;
 let transitivity = call_tactic_with_input ProofEngine.transitivity;;
@@ -2307,7 +2309,7 @@ let assumption = call_tactic ProofEngine.assumption;;
 let generalize = call_tactic_with_goal_input ProofEngine.generalize;;
 let absurd = call_tactic_with_input ProofEngine.absurd;;
 let contradiction = call_tactic ProofEngine.contradiction;;
-(* Galla: come dare alla tattica la lista di termini da decomporre?
+(* Galla chiede: come dare alla tattica la lista di termini da decomporre?
 let decompose = call_tactic_with_input_and_goal_input ProofEngine.decompose;;
 *)
 
@@ -3128,6 +3130,12 @@ object(self)
    let rewritesimplb =
     GButton.button ~label:"RewriteSimpl ->"
      ~packing:(hbox5#pack ~expand:false ~fill:false ~padding:5) () in
+   let rewritebacksimplb =
+    GButton.button ~label:"RewriteSimpl <-"
+     ~packing:(hbox5#pack ~expand:false ~fill:false ~padding:5) () in
+   let replaceb =
+    GButton.button ~label:"Replace"
+     ~packing:(hbox5#pack ~expand:false ~fill:false ~padding:5) () in
    let reflexivityb =
     GButton.button ~label:"Reflexivity"
      ~packing:(hbox5#pack ~expand:false ~fill:false ~padding:5) () in
@@ -3185,6 +3193,8 @@ object(self)
    ignore(clearb#connect#clicked clear) ;
    ignore(fourierb#connect#clicked fourier) ;
    ignore(rewritesimplb#connect#clicked rewritesimpl) ;
+   ignore(rewritebacksimplb#connect#clicked rewritebacksimpl) ;
+   ignore(replaceb#connect#clicked replace) ;
    ignore(reflexivityb#connect#clicked reflexivity) ;
    ignore(symmetryb#connect#clicked symmetry) ;
    ignore(transitivityb#connect#clicked transitivity) ;
index 81b2cd3e04540936f617433b26aed3b96ca36d8b..7d637551fdc693fef96b6ce9f2b4d3b7e7e02071 100644 (file)
@@ -206,28 +206,32 @@ let fold_simpl term =
 
   (* other tactics *)
 
-let elim_type term = apply_tactic (VariousTactics.elim_type_tac ~term)
+let elim_type term = apply_tactic (EliminationTactics.elim_type_tac ~term)
 let ring () = apply_tactic Ring.ring_tac
 let fourier () = apply_tactic FourierR.fourier_tac
-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 rewrite_simpl term = apply_tactic (EqualityTactics.rewrite_simpl_tac ~term)
+let rewrite_back_simpl term = apply_tactic (EqualityTactics.rewrite_back_simpl_tac ~term)
+let replace ~goal_input:what ~input:with_what = 
+  apply_tactic (EqualityTactics.replace_tac ~what ~with_what)
 
-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 reflexivity () = apply_tactic EqualityTactics.reflexivity_tac
+let symmetry () = apply_tactic EqualityTactics.symmetry_tac
+let transitivity term = apply_tactic (EqualityTactics.transitivity_tac ~term)
+
+let exists () = apply_tactic IntroductionTactics.exists_tac
+let split () = apply_tactic IntroductionTactics.split_tac 
+let left () = apply_tactic IntroductionTactics.left_tac
+let right () = apply_tactic IntroductionTactics.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 absurd term = apply_tactic (NegationTactics.absurd_tac ~term)
+let contradiction () = apply_tactic NegationTactics.contradiction_tac
 
-let decompose ~clist = apply_tactic (VariousTactics.decompose_tac ~clist)
+let decompose ~clist = apply_tactic (EliminationTactics.decompose_tac ~clist)
 
 (*
 let decide_equality () = apply_tactic VariousTactics.decide_equality_tac
index b53e3022d11cb0ffff7656b455fac848f2913e56..ab1b0285e978ce81cd2e762f0dea22562c7c189e 100644 (file)
@@ -62,6 +62,8 @@ val elim_type : Cic.term -> unit
 val ring : unit -> unit
 val fourier : unit -> unit
 val rewrite_simpl : Cic.term -> unit
+val rewrite_back_simpl : Cic.term -> unit
+val replace : goal_input:Cic.term -> input:Cic.term -> unit
 
 val reflexivity : unit -> unit
 val symmetry : unit -> unit
index 66541d1b0e18acb9f2855e649b9bac6f926b659e..25fa093f20601591b6041fa8eb79808800ebad5f 100644 (file)
@@ -423,8 +423,9 @@ let elim_type_tac ~term ~status =
     @param proof term used to prove second subgoal generated by elim_type
   *)
 let elim_type2_tac ~term ~proof ~status =
+  let module E = EliminationTactics in
   warn "in Ring.elim_type2";
-  Tacticals.thens ~start:(VariousTactics.elim_type_tac ~term)
+  Tacticals.thens ~start:(E.elim_type_tac ~term)
    ~continuations:[Tacticals.id_tac ; exact_tac ~term:proof] ~status
 
 (* Galla: spostata in variousTactics.ml
@@ -500,7 +501,7 @@ let ring_tac ~status:((proof, goal) as status) =
         Tacticals.try_tactics
           ~status
           ~tactics:[
-            "reflexivity", VariousTactics.reflexivity_tac ;
+            "reflexivity", EqualityTactics.reflexivity_tac ;
             "exact t1'_eq_t1''", exact_tac ~term:t1'_eq_t1'' ;
             "exact t2'_eq_t2''", exact_tac ~term:t2'_eq_t2'' ;
             "exact sym_eqt su t1 ...", exact_tac
@@ -572,7 +573,7 @@ let ring_tac ~status:((proof, goal) as status) =
                       in
                       try (* try to solve main goal *)
                         warn "trying reflexivity ....";
-                        VariousTactics.reflexivity_tac ~status:status'
+                        EqualityTactics.reflexivity_tac ~status:status'
                       with (Fail _) ->  (* leave conclusion to the user *)
                         warn "reflexivity failed, solution's left as an ex :-)";
                         purge_hyps_tac ~count:!new_hyps ~status:status')]
index 8f2dbce6ed8d03ffe5a1dac58f9a6f0eca5d1705..9e8b18b7d96b077d7074230d2c31148ba569f82e 100644 (file)
  *)
 
 
-let constructor_tac ~n ~status:(proof, goal) =
-  let module C = Cic in
-  let module R = CicReduction in
-   let (_,metasenv,_,_) = proof in
-    let metano,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
-     match (R.whd context ty) with  
-        (C.MutInd (uri, typeno, exp_named_subst))
-      | (C.Appl ((C.MutInd (uri, typeno, exp_named_subst))::_)) ->
-         PrimitiveTactics.apply_tac ~status:(proof, goal)
-          ~term: (C.MutConstruct (uri, typeno, n, exp_named_subst))
-      | _ -> raise (ProofEngineTypes.Fail "Constructor failed")
-;;
-
-
-let exists_tac ~status =
-  constructor_tac ~n:1 ~status
-;;
-
-
-let split_tac ~status =
-  constructor_tac ~n:1 ~status
-;;
-
-
-let left_tac ~status =
-  constructor_tac ~n:1 ~status
-;;
-
-
-let right_tac ~status =
-  constructor_tac ~n:2 ~status
-;;
-
-
-let reflexivity_tac =
-  constructor_tac ~n:1
-;;
-
-
-let symmetry_tac ~status:(proof, goal) =
-  let module C = Cic in
-  let module R = CicReduction in
-  let module U = UriManager in
-   let (_,metasenv,_,_) = proof in
-    let metano,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
-     match (R.whd context ty) with 
-        (C.Appl [(C.MutInd (uri, 0, [])); _; _; _]) when (U.eq uri (U.uri_of_string "cic:/Coq/Init/Logic/eq.ind")) ->
-         PrimitiveTactics.apply_tac ~status:(proof,goal)
-          ~term: (C.Const (U.uri_of_string "cic:/Coq/Init/Logic/sym_eq.con", []))
-
-      | (C.Appl [(C.MutInd (uri, 0, [])); _; _; _]) when (U.eq uri (U.uri_of_string "cic:/Coq/Init/Logic_Type/eqT.ind")) ->
-         PrimitiveTactics.apply_tac ~status:(proof,goal)
-          ~term: (C.Const (U.uri_of_string "cic:/Coq/Init/Logic_Type/sym_eqT.con", []))
-
-      | _ -> raise (ProofEngineTypes.Fail "Symmetry failed")
-;;
-
-
-let transitivity_tac ~term ~status:((proof, goal) as status) =
-  let module C = Cic in
-  let module R = CicReduction in
-  let module U = UriManager in
-  let module T = Tacticals in
-   let (_,metasenv,_,_) = proof in
-    let metano,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
-     match (R.whd context ty) with 
-        (C.Appl [(C.MutInd (uri, 0, [])); _; _; _]) when (uri = (U.uri_of_string "cic:/Coq/Init/Logic/eq.ind")) ->
-         T.thens
-          ~start:(PrimitiveTactics.apply_tac
-            ~term: (C.Const (U.uri_of_string "cic:/Coq/Init/Logic/trans_eq.con", [])))
-          ~continuations:
-            [T.id_tac ; T.id_tac ; PrimitiveTactics.exact_tac ~term]
-          ~status
-
-      | (C.Appl [(C.MutInd (uri, 0, [])); _; _; _]) when (uri = (U.uri_of_string "cic:/Coq/Init/Logic_Type/eqT.ind")) ->
-         T.thens 
-          ~start:(PrimitiveTactics.apply_tac
-            ~term: (C.Const (U.uri_of_string "cic:/Coq/Init/Logic_Type/trans_eqT.con", [])))
-          ~continuations:
-            [T.id_tac ; T.id_tac ; PrimitiveTactics.exact_tac ~term]
-          ~status
-
-      | _ -> raise (ProofEngineTypes.Fail "Transitivity failed")
-;;
-
-
 (* TODO se ce n'e' piu' di una, prende la prima che trova... sarebbe meglio chiedere *)
-
 let assumption_tac ~status:((proof,goal) as status) =
   let module C = Cic in
   let module R = CicReduction in
@@ -153,186 +66,86 @@ let assumption_tac ~status:(proof,goal)=
 (* ANCORA DA DEBUGGARE *)
 
 
-let elim_type_tac ~term ~status =
-  let module C = Cic in
-  let module P = PrimitiveTactics in
-  let module T = Tacticals in
-   T.thens 
-    ~start: (P.cut_tac ~term) 
-    ~continuations:[ P.elim_intros_simpl_tac ~term:(C.Rel 1) ; T.id_tac ]
-    ~status
-;;
+(* IN FASE DI IMPLEMENTAZIONE *)
 
-let absurd_tac ~term ~status:((proof,goal) as status) =
+let generalize_tac ~term ~status:((proof,goal) as status) =
   let module C = Cic in
-  let module U = UriManager in
   let module P = PrimitiveTactics in
+  let module T = Tacticals in
    let _,metasenv,_,_ = proof in
     let _,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
-     if ((CicTypeChecker.type_of_aux' metasenv context term) = (C.Sort C.Prop)) 
-      then P.apply_tac ~term:(C.Appl [(C.Const ((U.uri_of_string "cic:/Coq/Init/Logic/absurd.con") , [] )) ; term ; ty]) ~status
-      else raise (ProofEngineTypes.Fail "Absurd: Not a Proposition") 
-;;
 
-
-let contradiction_tac ~status =
-  let module C = Cic in
-  let module U = UriManager in
-  let module P = PrimitiveTactics in
-  let module T = Tacticals in
-   T.then_ 
-      ~start:P.intros_tac
-      ~continuation:(
-        T.then_ 
-           ~start: (elim_type_tac ~term:(C.MutInd (U.uri_of_string "cic:/Coq/Init/Logic/False.ind") 0 [] )) 
-           ~continuation: assumption_tac)
-    ~status
-;;
-
-(* Questa era in fourierR.ml 
-(* !!!!! fix !!!!!!!!!! *)
-let contradiction_tac ~status:(proof,goal)=
-        Tacticals.then_
-                ~start:(PrimitiveTactics.intros_tac ~name:"bo?" ) (*inutile sia questo che quello prima  della chiamata*)
-                ~continuation:(Tacticals.then_
-                        ~start:(VariousTactics.elim_type_tac ~term:_False)
-                        ~continuation:(assumption_tac))
-        ~status:(proof,goal)
-;;
+(*
+let uno = (C.Appl [
+             C.MutConstruct (UriManager.uri_of_string "cic:/Coq/Init/Datatypes/nat.ind", 0, 2, []) ; 
+             C.MutConstruct (UriManager.uri_of_string "cic:/Coq/Init/Datatypes/nat.ind", 0, 1, [])])  in 
+ let tuno = CicTypeChecker.type_of_aux' metasenv context uno in
+prerr_endline ("#### uno: " ^ CicPp.ppterm uno);
+prerr_endline ("#### tuno: " ^ CicPp.ppterm tuno);
 *)
+prerr_endline ("#### dummy: " ^ (CicPp.ppterm (CicTypeChecker.type_of_aux' metasenv context term)));
+prerr_endline ("#### with_what: " ^ CicPp.ppterm (C.Rel 1));
+prerr_endline ("#### term: " ^ CicPp.ppterm term);
+prerr_endline ("#### ty: " ^ CicPp.ppterm ty);
 
 
-(* IN FASE DI IMPLEMENTAZIONE *)
-
-
-let generalize_tac ~term ~status:((proof,goal) as status) =
-  let module C = Cic in
-  let module P = PrimitiveTactics in
-  let module T = Tacticals in
-  let struct_equality t a = (t == a) in
-   let _,metasenv,_,_ = proof in
-    let _,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
      T.thens 
       ~start:(P.cut_tac 
        ~term:(
-         C.Lambda (
+         C.Prod (
           (C.Name "dummy_for_gen"), 
           (CicTypeChecker.type_of_aux' metasenv context term), 
-          (ProofEngineReduction.replace 
+          (ProofEngineReduction.replace_lifting
             ~equality:(==) 
-            ~with_what:(C.Rel 1)(* (C.Name "dummy_for_gen") *) 
+            ~with_what:(C.Rel 1) (* C.Name "dummy_for_gen" *)  
             ~what:term 
-            ~where:ty))))       (* dove?? nel goal va bene?*)
+            ~where:ty))))
       ~continuations: 
-       [(P.apply_tac ~term:(C.Appl [(C.Rel 1); term])) ; T.id_tac]     (* in quest'ordine o viceversa? provare *)
+       [T.id_tac ; (P.apply_tac ~term:(C.Appl [(C.Rel 1); term]))]     (* in quest'ordine o viceversa? provare *)
+(*       [(P.apply_tac ~term:(C.Appl [(C.Rel 1); term])) ; T.id_tac]   (* in quest'ordine o viceversa? provare *)*)
       ~status
 ;;
 
-(* PROVE DI DECOMPOSE
-
-(* in realta' non so bene cosa contiene la lista what, io ho supposto contenga dei term (Const uri) *)
-let decompose_tac ~what ~where ~status:((proof,goal) as status) =  
-  let module C = Cic in
-  let module R = CicReduction in
-  let module P = PrimitiveTactics in
-  let module T = Tacticals in
-  let module S = ProofEngineStructuralRules in
-
-   let rec decomposing ty what = 
-    match (what) with 
-       [] -> C.Implicit (* qui mi servirebbe un termine per cui elim_simpl_intros fallisce *)
-     | hd::tl as what ->
-        match ty with
-           (C.Appl (hd::_)) -> hd
-         | _ -> decomposing ty tl
-    in
-
-   let (_,metasenv,_,_) = proof in
-    let _,context,_ = List.find (function (m,_,_) -> m=goal) metasenv in
-     T.repeat_tactic 
-       ~tactic:(T.then_ 
-                   ~start:(P.elim_simpl_intros_tac ~term:(decomposing (R.whd context where) what))
-                   ~continuation:(S.clear ~hyp:(Some ((C.Name "name"), (C.Decl where))))               (* ma che ipotesi sto cancellando??? *) 
-               )
-       ~status 
-;;
-
-
-let decompose_tac ~clist ~status:((proof,goal) as status) =
+(*
+let generalize_tac ~term ~status:((proof,goal) as status) =
   let module C = Cic in
-  let module R = CicReduction in
+  let module H = ProofEngineHelpers in
   let module P = PrimitiveTactics in
   let module T = Tacticals in
-  let module S = ProofEngineStructuralRules in
-   let (_,metasenv,_,_) = proof in
+   let _,metasenv,_,_ = proof in
     let _,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
 
-     let rec repeat_elim ~term ~status =               (* term -> status -> proof * (goal list) *)
-      try
-       let (proof, goallist) = 
-        T.then_
-           ~start:(P.elim_simpl_intros_tac ~term)
-           ~continuation:(S.clear ~hyp:(Some ((C.Name "name"), (C.Decl ty))))                (* non so che ipotesi sto cancellando??? *)
-           ~status
-        in
-         let rec step proof goallist =
-          match goallist with
-             [] -> (proof, [])
-           | hd::tl ->
-              let (proof', goallist') = repeat_elim ~term ~status:(proof, hd) in
-               let (proof'', goallist'') = step proof' tl in
-                proof'', goallist'@goallist''
-          in
-           step proof goallist
-       with
-        (Fail _) -> T.id_tac
-
-    in
-     let rec decomposing ty clist =            (* term -> (term list) -> bool *)
-      match (clist) with
-        [] -> false
-      | hd::tl as clist ->
-         match ty with
-           (C.Appl (hd::_)) -> true
-         | _ -> decomposing ty tl
-
-      in
-       let term = decomposing (R.whd context ty) clist in
-       if (term == C.Implicit) 
-         then (Fail "Decompose: nothing to decompose or no application")
-         else repeat_elim ~term ~status
-;; 
-*)
-
-let decompose_tac ~clist ~status =
-  let module C = Cic in
-  let module R = CicReduction in
-  let module P = PrimitiveTactics in
-  let module T = Tacticals in
-  let module S = ProofEngineStructuralRules in
-
-   let rec choose ty =
-    function
-       [] -> C.Implicit (* a cosa serve? *)
-     | hd::tl ->
-        match ty with
-           (C.Appl (hd::_)) -> hd
-         | _ -> choose ty tl
-     in
-
-    let decompose_one_tac ~clist ~status:((proof,goal) as status) =
-     let (_,metasenv,_,_) = proof in
-      let _,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
-       let term = choose (R.whd context ty) clist in
-        if (term == C.Implicit)
-         then raise (ProofEngineTypes.Fail "Decompose: nothing to decompose or no application")
-         else T.then_
-                 ~start:(P.elim_intros_simpl_tac ~term)
-                 ~continuation:(S.clear ~hyp:(Some ((C.Name "FOO") , (C.Decl ty))))                (* ma che ipotesi sto cancellando??? *)  
-                 ~status   
+     let add_decl_tac ~term ~status:(proof, goal) =
+      let module C = Cic in
+      let curi,metasenv,pbo,pty = proof in
+      let metano,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
+       let _ = CicTypeChecker.type_of_aux' metasenv context term in
+        let newmeta = H.new_meta ~proof in
+        let context_for_newmeta = (Some (C.Name "dummy_for_gen",C.Decl term))::context in
+        let irl = H.identity_relocation_list_for_metavariable context_for_newmeta in
+         let newmetaty = CicSubstitution.lift 1 ty in
+         let bo' = C.LetIn (C.Name "dummy_for_gen" , term , C.Meta (newmeta,irl)) in
+          let (newproof, _) = H.subst_meta_in_proof proof metano bo'[newmeta,context_for_newmeta,newmetaty]
+         in
+          (newproof, [newmeta])
+       
      in
-      T.repeat_tactic ~tactic:(decompose_one_tac ~clist) ~status
+      T.then_ 
+       ~start:(add_decl_tac ~term:(CicTypeChecker.type_of_aux' metasenv context term)) 
+       ~continuation:(
+T.id_tac) (*         T.thens 
+          ~start:(P.cut_tac ~term:(ProofEngineReduction.replace
+            ~equality:(==)
+            ~with_what:(C.Rel 1) (* dummy_for_gen *)
+            ~what:term
+            ~where:ty))
+          ~continuations:
+            [T.id_tac ; (P.apply_tac ~term:(C.Appl [term ; (C.Rel 1)]))])      (* in quest'ordine o viceversa? provare *)
+(*            [(P.apply_tac ~term:(C.Appl [term ; (C.Rel 1)])) ; T.id_tac])     in quest'ordine o viceversa? provare *)
+*)      ~status
 ;;
+*)
+
 
 
 let decide_equality_tac =
@@ -352,150 +165,19 @@ let compare_tac ~term1 ~term2 ~status:((proof, goal) as status) =
       then
        T.thens 
          ~start:P.cut_tac ~term:(* term1=term2->gty/\~term1=term2->gty *)
-         ~continuations:[split_tac ; intros_tac ~name:"FOO"]  
+         ~continuations:[split_tac ; P.intros_tac ~name:"FOO"]  
       else raise (ProofEngineTypes.Fail "Compare: Comparing terms of different types") 
 ;;
 *)
 
 
-let rewrite_tac ~term:equality ~status:(proof,goal) =
- let module C = Cic in
- let module U = UriManager in
-  let curi,metasenv,pbo,pty = proof in
-  let metano,context,gty = List.find (function (m,_,_) -> m=goal) metasenv in
-   let eq_ind_r,ty,t1,t2 =
-    match CicTypeChecker.type_of_aux' metasenv context equality with
-       C.Appl [C.MutInd (uri,0,[]) ; ty ; t1 ; t2]
-        when U.eq uri (U.uri_of_string "cic:/Coq/Init/Logic/eq.ind") ->
-         let eq_ind_r =
-          C.Const
-           (U.uri_of_string "cic:/Coq/Init/Logic/eq_ind_r.con",[])
-         in
-          eq_ind_r,ty,t1,t2
-     | C.Appl [C.MutInd (uri,0,[]) ; ty ; t1 ; t2]
-        when U.eq uri (U.uri_of_string "cic:/Coq/Init/Logic_Type/eqT.ind") ->
-         let eqT_ind_r =
-          C.Const
-           (U.uri_of_string "cic:/Coq/Init/Logic_Type/eqT_ind_r.con",[])
-         in
-          eqT_ind_r,ty,t1,t2
-     | _ ->
-       raise
-        (ProofEngineTypes.Fail
-          "Rewrite: the argument is not a proof of an equality")
-   in
-    let pred =
-     let gty' = CicSubstitution.lift 1 gty in
-     let t1' = CicSubstitution.lift 1 t1 in
-     let gty'' =
-      ProofEngineReduction.replace_lifting
-       ~equality:ProofEngineReduction.alpha_equivalence
-       ~what:t1' ~with_what:(C.Rel 1) ~where:gty'
-     in
-      C.Lambda (C.Name "dummy_for_rewrite", ty, gty'')
-    in
-prerr_endline ("#### Sintetizzato: " ^ CicPp.ppterm pred);
-    let fresh_meta = ProofEngineHelpers.new_meta proof in
-    let irl =
-     ProofEngineHelpers.identity_relocation_list_for_metavariable context in
-    let metasenv' = (fresh_meta,context,C.Appl [pred ; t2])::metasenv in
-
-     let (proof',goals) =
-      PrimitiveTactics.exact_tac
-       ~term:(C.Appl
-         [eq_ind_r ; ty ; t2 ; pred ; C.Meta (fresh_meta,irl) ; t1 ;equality])
-        ~status:((curi,metasenv',pbo,pty),goal)
-     in
-      assert (List.length goals = 0) ;
-      (proof',[fresh_meta])
-;;
-
-
-let rewrite_simpl_tac ~term ~status =
- Tacticals.then_ ~start:(rewrite_tac ~term)
-  ~continuation:
-   (ReductionTactics.simpl_tac ~also_in_hypotheses:false ~term:None)
-  ~status
-;;
-
-
-let rewrite_back_tac ~term:equality ~status:(proof,goal) = 
- let module C = Cic in
- let module U = UriManager in
-  let curi,metasenv,pbo,pty = proof in
-  let metano,context,gty = List.find (function (m,_,_) -> m=goal) metasenv in
-   let eq_ind_r,ty,t1,t2 =
-    match CicTypeChecker.type_of_aux' metasenv context equality with
-       C.Appl [C.MutInd (uri,0,[]) ; ty ; t1 ; t2]
-        when U.eq uri (U.uri_of_string "cic:/Coq/Init/Logic/eq.ind") ->
-         let eq_ind_r =
-          C.Const
-           (U.uri_of_string "cic:/Coq/Init/Logic/eq_ind.con",[])
-         in
-          eq_ind_r,ty,t1,t2
-     | C.Appl [C.MutInd (uri,0,[]) ; ty ; t1 ; t2]
-        when U.eq uri (U.uri_of_string "cic:/Coq/Init/Logic_Type/eqT.ind") ->
-         let eqT_ind_r =
-          C.Const
-           (U.uri_of_string "cic:/Coq/Init/Logic_Type/eqT_ind.con",[])
-         in
-          eqT_ind_r,ty,t1,t2
-     | _ ->
-       raise
-        (ProofEngineTypes.Fail
-          "Rewrite: the argument is not a proof of an equality")
-   in
-    let pred =
-     let gty' = CicSubstitution.lift 1 gty in
-     let t1' = CicSubstitution.lift 1 t1 in
-     let gty'' =
-      ProofEngineReduction.replace_lifting
-       ~equality:ProofEngineReduction.alpha_equivalence
-       ~what:t1' ~with_what:(C.Rel 1) ~where:gty'
-     in
-      C.Lambda (C.Name "dummy_for_rewrite", ty, gty'')
-    in
-prerr_endline ("#### Sintetizzato: " ^ CicPp.ppterm pred);
-    let fresh_meta = ProofEngineHelpers.new_meta proof in
-    let irl =
-     ProofEngineHelpers.identity_relocation_list_for_metavariable context in
-    let metasenv' = (fresh_meta,context,C.Appl [pred ; t2])::metasenv in
 
-     let (proof',goals) =
-      PrimitiveTactics.exact_tac
-       ~term:(C.Appl
-         [eq_ind_r ; ty ; t2 ; pred ; C.Meta (fresh_meta,irl) ; t1 ;equality])
-        ~status:((curi,metasenv',pbo,pty),goal)
-     in
-      assert (List.length goals = 0) ;
-      (proof',[fresh_meta])
-
-;;
+(*** DOMANDE ***
 
+- come faccio clear di un ipotesi di cui non so il nome?
+- differenza tra elim e induction ...e inversion?
+- come passo a decompose la lista di termini?
+- ma la rewrite funzionava?
+- come implemento la generalize?
 
-let replace_tac ~what ~with_what ~status:((proof, goal) as status) =
-  let module C = Cic in
-  let module U = UriManager in
-  let module P = PrimitiveTactics in
-  let module T = Tacticals in
-   let _,metasenv,_,_ = proof in
-    let _,context,_ = List.find (function (m,_,_) -> m=goal) metasenv in
-     let wty = CicTypeChecker.type_of_aux' metasenv context what in
-      if (wty = (CicTypeChecker.type_of_aux' metasenv context with_what))
-       then T.thens 
-              ~start:(P.cut_tac ~term:(C.Appl [(C.MutInd ((U.uri_of_string "cic:/Coq/Init/Logic/eq.ind"), 0, [])) ; wty ; what ; with_what]))  
-                                                       (* quale uguaglianza usare, eq o eqT ? *)
-              ~continuations:[
-                T.then_ 
-                   ~start:P.intros_tac
-                   ~continuation:(T.then_ 
-                                     ~start:(rewrite_back_tac ~term:(C.Rel 1)) (* C.Name "dummy_for_replace" *)
-                                     ~continuation:(ProofEngineStructuralRules.clear 
-                                                     ~hyp:(Some((C.Name "dummy_for_replace") , (C.Def C.Implicit) (* NO!! tipo di dummy *) ))
-                                                   )
-                                 ) ; 
-                T.id_tac]
-             ~status
-      else raise (ProofEngineTypes.Fail "Replace: terms not replaceable")
-;;
-
+*)
index 30887a60af12a4762399a19045cfd9e446827a7b..27b59682f45a4a4c1f7031b7445f8098db928b49 100644 (file)
  * http://cs.unibo.it/helm/.
  *)
 
-val reflexivity_tac: ProofEngineTypes.tactic
-val symmetry_tac: ProofEngineTypes.tactic
-val transitivity_tac: term:Cic.term -> ProofEngineTypes.tactic
-
-(*
-val constructor_tac: n:int -> ProofEngineTypes.tactic
-*)
-val exists_tac: ProofEngineTypes.tactic
-val split_tac: ProofEngineTypes.tactic
-val left_tac: ProofEngineTypes.tactic
-val right_tac: ProofEngineTypes.tactic
-
 val assumption_tac: ProofEngineTypes.tactic
 
 val generalize_tac: term:Cic.term -> ProofEngineTypes.tactic
 
-val elim_type_tac: term:Cic.term -> ProofEngineTypes.tactic
-
-val absurd_tac: term:Cic.term -> ProofEngineTypes.tactic
-val contradiction_tac: ProofEngineTypes.tactic
-
-val decompose_tac: clist:(Cic.term list) -> ProofEngineTypes.tactic
-
 (*
 val decide_equality_tac: ProofEngineTypes.tactic
 val compare_tac: term1:Cic.term -> term2:Cic.term -> ProofEngineTypes.tactic
 *)
 
-val rewrite_tac: term:Cic.term -> ProofEngineTypes.tactic
-val rewrite_simpl_tac: term:Cic.term -> ProofEngineTypes.tactic
-val rewrite_back_tac: term:Cic.term -> ProofEngineTypes.tactic
-val replace_tac: what:Cic.term -> with_what:Cic.term -> ProofEngineTypes.tactic