src/FOLP/IFOLP.ML
changeset 25990 d98da4a40a79
parent 19046 bc5c6c9b114e
equal deleted inserted replaced
25989:3267d0694d93 25990:d98da4a40a79
    30 qed "all_dupE";
    30 qed "all_dupE";
    31 
    31 
    32 
    32 
    33 (*** Negation rules, which translate between ~P and P-->False ***)
    33 (*** Negation rules, which translate between ~P and P-->False ***)
    34 
    34 
    35 val notI = prove_goalw (the_context ()) [not_def]  "(!!x. x:P ==> q(x):False) ==> ?p:~P"
    35 bind_thm ("notI", prove_goalw (the_context ()) [not_def]  "(!!x. x:P ==> q(x):False) ==> ?p:~P"
    36  (fn prems=> [ (REPEAT (ares_tac (prems@[impI]) 1)) ]);
    36  (fn prems=> [ (REPEAT (ares_tac (prems@[impI]) 1)) ]));
    37 
    37 
    38 val notE = prove_goalw (the_context ()) [not_def] "[| p:~P;  q:P |] ==> ?p:R"
    38 bind_thm ("notE", prove_goalw (the_context ()) [not_def] "[| p:~P;  q:P |] ==> ?p:R"
    39  (fn prems=>
    39  (fn prems=>
    40   [ (resolve_tac [mp RS FalseE] 1),
    40   [ (resolve_tac [mp RS FalseE] 1),
    41     (REPEAT (resolve_tac prems 1)) ]);
    41     (REPEAT (resolve_tac prems 1)) ]));
    42 
    42 
    43 (*This is useful with the special implication rules for each kind of P. *)
    43 (*This is useful with the special implication rules for each kind of P. *)
    44 val prems= Goal
    44 val prems= Goal
    45     "[| p:~P;  !!x. x:(P-->False) ==> q(x):Q |] ==> ?p:Q";
    45     "[| p:~P;  !!x. x:(P-->False) ==> q(x):Q |] ==> ?p:Q";
    46 by (REPEAT (ares_tac (prems@[impI,notE]) 1)) ;
    46 by (REPEAT (ares_tac (prems@[impI,notE]) 1)) ;
    94 fun int_uniq_mp_tac i = eresolve_tac [notE,impE] i  THEN  uniq_assume_tac i;
    94 fun int_uniq_mp_tac i = eresolve_tac [notE,impE] i  THEN  uniq_assume_tac i;
    95 
    95 
    96 
    96 
    97 (*** If-and-only-if ***)
    97 (*** If-and-only-if ***)
    98 
    98 
    99 val iffI = prove_goalw (the_context ()) [iff_def]
    99 bind_thm ("iffI", prove_goalw (the_context ()) [iff_def]
   100    "[| !!x. x:P ==> q(x):Q;  !!x. x:Q ==> r(x):P |] ==> ?p:P<->Q"
   100    "[| !!x. x:P ==> q(x):Q;  !!x. x:Q ==> r(x):P |] ==> ?p:P<->Q"
   101  (fn prems=> [ (REPEAT (ares_tac (prems@[conjI, impI]) 1)) ]);
   101  (fn prems=> [ (REPEAT (ares_tac (prems@[conjI, impI]) 1)) ]));
   102 
   102 
   103 
   103 
   104 (*Observe use of rewrite_rule to unfold "<->" in meta-assumptions (prems) *)
   104 (*Observe use of rewrite_rule to unfold "<->" in meta-assumptions (prems) *)
   105 val iffE = prove_goalw (the_context ()) [iff_def]
   105 bind_thm ("iffE", prove_goalw (the_context ()) [iff_def]
   106     "[| p:P <-> Q;  !!x y.[| x:P-->Q; y:Q-->P |] ==> q(x,y):R |] ==> ?p:R"
   106     "[| p:P <-> Q;  !!x y.[| x:P-->Q; y:Q-->P |] ==> q(x,y):R |] ==> ?p:R"
   107  (fn prems => [ (rtac conjE 1), (REPEAT (ares_tac prems 1)) ]);
   107  (fn prems => [ (rtac conjE 1), (REPEAT (ares_tac prems 1)) ]));
   108 
   108 
   109 (* Destruct rules for <-> similar to Modus Ponens *)
   109 (* Destruct rules for <-> similar to Modus Ponens *)
   110 
   110 
   111 val iffD1 = prove_goalw (the_context ()) [iff_def] "[| p:P <-> Q;  q:P |] ==> ?p:Q"
   111 bind_thm ("iffD1", prove_goalw (the_context ()) [iff_def] "[| p:P <-> Q;  q:P |] ==> ?p:Q"
   112  (fn prems => [ (rtac (conjunct1 RS mp) 1), (REPEAT (ares_tac prems 1)) ]);
   112  (fn prems => [ (rtac (conjunct1 RS mp) 1), (REPEAT (ares_tac prems 1)) ]));
   113 
   113 
   114 val iffD2 = prove_goalw (the_context ()) [iff_def] "[| p:P <-> Q;  q:Q |] ==> ?p:P"
   114 bind_thm ("iffD2", prove_goalw (the_context ()) [iff_def] "[| p:P <-> Q;  q:Q |] ==> ?p:P"
   115  (fn prems => [ (rtac (conjunct2 RS mp) 1), (REPEAT (ares_tac prems 1)) ]);
   115  (fn prems => [ (rtac (conjunct2 RS mp) 1), (REPEAT (ares_tac prems 1)) ]));
   116 
   116 
   117 Goal "?p:P <-> P";
   117 Goal "?p:P <-> P";
   118 by (REPEAT (ares_tac [iffI] 1)) ;
   118 by (REPEAT (ares_tac [iffI] 1)) ;
   119 qed "iff_refl";
   119 qed "iff_refl";
   120 
   120 
   155 (*Use iffE on a premise.  For conj_cong, imp_cong, all_cong, ex_cong*)
   155 (*Use iffE on a premise.  For conj_cong, imp_cong, all_cong, ex_cong*)
   156 fun iff_tac prems i =
   156 fun iff_tac prems i =
   157     resolve_tac (prems RL [iffE]) i THEN
   157     resolve_tac (prems RL [iffE]) i THEN
   158     REPEAT1 (eresolve_tac [asm_rl,mp] i);
   158     REPEAT1 (eresolve_tac [asm_rl,mp] i);
   159 
   159 
   160 val conj_cong = prove_goal (the_context ())
   160 bind_thm ("conj_cong", prove_goal (the_context ())
   161     "[| p:P <-> P';  !!x. x:P' ==> q(x):Q <-> Q' |] ==> ?p:(P&Q) <-> (P'&Q')"
   161     "[| p:P <-> P';  !!x. x:P' ==> q(x):Q <-> Q' |] ==> ?p:(P&Q) <-> (P'&Q')"
   162  (fn prems =>
   162  (fn prems =>
   163   [ (cut_facts_tac prems 1),
   163   [ (cut_facts_tac prems 1),
   164     (REPEAT  (ares_tac [iffI,conjI] 1
   164     (REPEAT  (ares_tac [iffI,conjI] 1
   165       ORELSE  eresolve_tac [iffE,conjE,mp] 1
   165       ORELSE  eresolve_tac [iffE,conjE,mp] 1
   166       ORELSE  iff_tac prems 1)) ]);
   166       ORELSE  iff_tac prems 1)) ]));
   167 
   167 
   168 val disj_cong = prove_goal (the_context ())
   168 bind_thm ("disj_cong", prove_goal (the_context ())
   169     "[| p:P <-> P';  q:Q <-> Q' |] ==> ?p:(P|Q) <-> (P'|Q')"
   169     "[| p:P <-> P';  q:Q <-> Q' |] ==> ?p:(P|Q) <-> (P'|Q')"
   170  (fn prems =>
   170  (fn prems =>
   171   [ (cut_facts_tac prems 1),
   171   [ (cut_facts_tac prems 1),
   172     (REPEAT  (eresolve_tac [iffE,disjE,disjI1,disjI2] 1
   172     (REPEAT  (eresolve_tac [iffE,disjE,disjI1,disjI2] 1
   173       ORELSE  ares_tac [iffI] 1
   173       ORELSE  ares_tac [iffI] 1
   174       ORELSE  mp_tac 1)) ]);
   174       ORELSE  mp_tac 1)) ]));
   175 
   175 
   176 val imp_cong = prove_goal (the_context ())
   176 bind_thm ("imp_cong", prove_goal (the_context ())
   177     "[| p:P <-> P';  !!x. x:P' ==> q(x):Q <-> Q' |] ==> ?p:(P-->Q) <-> (P'-->Q')"
   177     "[| p:P <-> P';  !!x. x:P' ==> q(x):Q <-> Q' |] ==> ?p:(P-->Q) <-> (P'-->Q')"
   178  (fn prems =>
   178  (fn prems =>
   179   [ (cut_facts_tac prems 1),
   179   [ (cut_facts_tac prems 1),
   180     (REPEAT   (ares_tac [iffI,impI] 1
   180     (REPEAT   (ares_tac [iffI,impI] 1
   181       ORELSE  etac iffE 1
   181       ORELSE  etac iffE 1
   182       ORELSE  mp_tac 1 ORELSE iff_tac prems 1)) ]);
   182       ORELSE  mp_tac 1 ORELSE iff_tac prems 1)) ]));
   183 
   183 
   184 val iff_cong = prove_goal (the_context ())
   184 bind_thm ("iff_cong", prove_goal (the_context ())
   185     "[| p:P <-> P';  q:Q <-> Q' |] ==> ?p:(P<->Q) <-> (P'<->Q')"
   185     "[| p:P <-> P';  q:Q <-> Q' |] ==> ?p:(P<->Q) <-> (P'<->Q')"
   186  (fn prems =>
   186  (fn prems =>
   187   [ (cut_facts_tac prems 1),
   187   [ (cut_facts_tac prems 1),
   188     (REPEAT   (etac iffE 1
   188     (REPEAT   (etac iffE 1
   189       ORELSE  ares_tac [iffI] 1
   189       ORELSE  ares_tac [iffI] 1
   190       ORELSE  mp_tac 1)) ]);
   190       ORELSE  mp_tac 1)) ]));
   191 
   191 
   192 val not_cong = prove_goal (the_context ())
   192 bind_thm ("not_cong", prove_goal (the_context ())
   193     "p:P <-> P' ==> ?p:~P <-> ~P'"
   193     "p:P <-> P' ==> ?p:~P <-> ~P'"
   194  (fn prems =>
   194  (fn prems =>
   195   [ (cut_facts_tac prems 1),
   195   [ (cut_facts_tac prems 1),
   196     (REPEAT   (ares_tac [iffI,notI] 1
   196     (REPEAT   (ares_tac [iffI,notI] 1
   197       ORELSE  mp_tac 1
   197       ORELSE  mp_tac 1
   198       ORELSE  eresolve_tac [iffE,notE] 1)) ]);
   198       ORELSE  eresolve_tac [iffE,notE] 1)) ]));
   199 
   199 
   200 val all_cong = prove_goal (the_context ())
   200 bind_thm ("all_cong", prove_goal (the_context ())
   201     "(!!x. f(x):P(x) <-> Q(x)) ==> ?p:(ALL x. P(x)) <-> (ALL x. Q(x))"
   201     "(!!x. f(x):P(x) <-> Q(x)) ==> ?p:(ALL x. P(x)) <-> (ALL x. Q(x))"
   202  (fn prems =>
   202  (fn prems =>
   203   [ (REPEAT   (ares_tac [iffI,allI] 1
   203   [ (REPEAT   (ares_tac [iffI,allI] 1
   204       ORELSE   mp_tac 1
   204       ORELSE   mp_tac 1
   205       ORELSE   etac allE 1 ORELSE iff_tac prems 1)) ]);
   205       ORELSE   etac allE 1 ORELSE iff_tac prems 1)) ]));
   206 
   206 
   207 val ex_cong = prove_goal (the_context ())
   207 bind_thm ("ex_cong", prove_goal (the_context ())
   208     "(!!x. f(x):P(x) <-> Q(x)) ==> ?p:(EX x. P(x)) <-> (EX x. Q(x))"
   208     "(!!x. f(x):P(x) <-> Q(x)) ==> ?p:(EX x. P(x)) <-> (EX x. Q(x))"
   209  (fn prems =>
   209  (fn prems =>
   210   [ (REPEAT   (etac exE 1 ORELSE ares_tac [iffI,exI] 1
   210   [ (REPEAT   (etac exE 1 ORELSE ares_tac [iffI,exI] 1
   211       ORELSE   mp_tac 1
   211       ORELSE   mp_tac 1
   212       ORELSE   iff_tac prems 1)) ]);
   212       ORELSE   iff_tac prems 1)) ]));
   213 
   213 
   214 (*NOT PROVED
   214 (*NOT PROVED
   215 val ex1_cong = prove_goal (the_context ())
   215 bind_thm ("ex1_cong", prove_goal (the_context ())
   216     "(!!x.f(x):P(x) <-> Q(x)) ==> ?p:(EX! x.P(x)) <-> (EX! x.Q(x))"
   216     "(!!x.f(x):P(x) <-> Q(x)) ==> ?p:(EX! x.P(x)) <-> (EX! x.Q(x))"
   217  (fn prems =>
   217  (fn prems =>
   218   [ (REPEAT   (eresolve_tac [ex1E, spec RS mp] 1 ORELSE ares_tac [iffI,ex1I] 1
   218   [ (REPEAT   (eresolve_tac [ex1E, spec RS mp] 1 ORELSE ares_tac [iffI,ex1I] 1
   219       ORELSE   mp_tac 1
   219       ORELSE   mp_tac 1
   220       ORELSE   iff_tac prems 1)) ]);
   220       ORELSE   iff_tac prems 1)) ]));
   221 *)
   221 *)
   222 
   222 
   223 (*** Equality rules ***)
   223 (*** Equality rules ***)
   224 
   224 
   225 val refl = ieqI;
   225 bind_thm ("refl", ieqI);
   226 
   226 
   227 val subst = prove_goal (the_context ()) "[| p:a=b;  q:P(a) |] ==> ?p : P(b)"
   227 bind_thm ("subst", prove_goal (the_context ()) "[| p:a=b;  q:P(a) |] ==> ?p : P(b)"
   228  (fn [prem1,prem2] => [ rtac (prem2 RS rev_mp) 1, (rtac (prem1 RS ieqE) 1),
   228  (fn [prem1,prem2] => [ rtac (prem2 RS rev_mp) 1, (rtac (prem1 RS ieqE) 1),
   229                         rtac impI 1, atac 1 ]);
   229                         rtac impI 1, atac 1 ]));
   230 
   230 
   231 Goal "q:a=b ==> ?c:b=a";
   231 Goal "q:a=b ==> ?c:b=a";
   232 by (etac subst 1);
   232 by (etac subst 1);
   233 by (rtac refl 1) ;
   233 by (rtac refl 1) ;
   234 qed "sym";
   234 qed "sym";
   242 by (etac contrapos 1);
   242 by (etac contrapos 1);
   243 by (etac sym 1) ;
   243 by (etac sym 1) ;
   244 qed "not_sym";
   244 qed "not_sym";
   245 
   245 
   246 (*calling "standard" reduces maxidx to 0*)
   246 (*calling "standard" reduces maxidx to 0*)
   247 val ssubst = standard (sym RS subst);
   247 bind_thm ("ssubst", standard (sym RS subst));
   248 
   248 
   249 (*A special case of ex1E that would otherwise need quantifier expansion*)
   249 (*A special case of ex1E that would otherwise need quantifier expansion*)
   250 Goal "[| p:EX! x. P(x);  q:P(a);  r:P(b) |] ==> ?d:a=b";
   250 Goal "[| p:EX! x. P(x);  q:P(a);  r:P(b) |] ==> ?d:a=b";
   251 by (etac ex1E 1);
   251 by (etac ex1E 1);
   252 by (rtac trans 1);
   252 by (rtac trans 1);
   306 by (DEPTH_SOLVE (eresolve_tac [asm_rl, subst, ssubst] 1)) ;
   306 by (DEPTH_SOLVE (eresolve_tac [asm_rl, subst, ssubst] 1)) ;
   307 qed "pred3_cong";
   307 qed "pred3_cong";
   308 
   308 
   309 (*special cases for free variables P, Q, R, S -- up to 3 arguments*)
   309 (*special cases for free variables P, Q, R, S -- up to 3 arguments*)
   310 
   310 
   311 val pred_congs =
   311 bind_thms ("pred_congs",
   312     List.concat (map (fn c =>
   312     List.concat (map (fn c =>
   313                map (fn th => read_instantiate [("P",c)] th)
   313                map (fn th => read_instantiate [("P",c)] th)
   314                    [pred1_cong,pred2_cong,pred3_cong])
   314                    [pred1_cong,pred2_cong,pred3_cong])
   315                (explode"PQRS"));
   315                (explode"PQRS")));
   316 
   316 
   317 (*special case for the equality predicate!*)
   317 (*special case for the equality predicate!*)
   318 val eq_cong = read_instantiate [("P","op =")] pred2_cong;
   318 bind_thm ("eq_cong", read_instantiate [("P","op =")] pred2_cong);
   319 
   319 
   320 
   320 
   321 (*** Simplifications of assumed implications.
   321 (*** Simplifications of assumed implications.
   322      Roy Dyckhoff has proved that conj_impE, disj_impE, and imp_impE
   322      Roy Dyckhoff has proved that conj_impE, disj_impE, and imp_impE
   323      used with mp_tac (restricted to atomic formulae) is COMPLETE for
   323      used with mp_tac (restricted to atomic formulae) is COMPLETE for