(* Title: HOL/WF.ML
ID: $Id$
Author: Konrad Slind
Copyright 1996 TU Munich
For WF1.thy.
*)
open WF1;
(* TFL variants *)
goal WF.thy
"!R. wf R --> (!P. (!x. (!y. (y,x):R --> P y) --> P x) --> (!x. P x))";
by (strip_tac 1);
by (res_inst_tac [("r","R"),("P","P"), ("a","x")] wf_induct 1);
by (assume_tac 1);
by (fast_tac HOL_cs 1);
qed"tfl_wf_induct";
goal WF.thy "!f R. (x,a):R --> (cut f R a)(x) = f(x)";
by (strip_tac 1);
by (rtac cut_apply 1);
by (assume_tac 1);
qed"tfl_cut_apply";
goal WF.thy "!M R f. (f=wfrec R M) --> wf R --> (!x. f x = M (cut f R x) x)";
by (strip_tac 1);
by (res_inst_tac [("r","R"), ("H","M"),
("a","x"), ("f","f")] (eq_reflection RS def_wfrec) 1);
by (assume_tac 1);
by (assume_tac 1);
qed "tfl_wfrec";
(*----------------------------------------------------------------------------
* Proof that the inverse image into a wellfounded relation is wellfounded.
* The proof is relatively sloppy - I map to another version of
* wellfoundedness (every n.e. set has an R-minimal element) and transport
* the proof for that formulation over. I also didn't remember the existence
* of "set_cs" so no doubt the proof can be dramatically shortened!
*---------------------------------------------------------------------------*)
goal HOL.thy "(~(!x. P x)) = (? x. ~(P x))";
by (fast_tac HOL_cs 1);
val th1 = result();
goal HOL.thy "(~(? x. P x)) = (!x. ~(P x))";
by (fast_tac HOL_cs 1);
val th2 = result();
goal HOL.thy "(~(x-->y)) = (x & (~ y))";
by (fast_tac HOL_cs 1);
val th3 = result();
goal HOL.thy "((~ x) | y) = (x --> y)";
by (fast_tac HOL_cs 1);
val th4 = result();
goal HOL.thy "(~(x & y)) = ((~ x) | (~ y))";
by (fast_tac HOL_cs 1);
val th5 = result();
goal HOL.thy "(~(x | y)) = ((~ x) & (~ y))";
by (fast_tac HOL_cs 1);
val th6 = result();
goal HOL.thy "(~(~x)) = x";
by (fast_tac HOL_cs 1);
val th7 = result();
(* Using [th1,th2,th3,th4,th5,th6,th7] as rewrites drives negation inwards. *)
val NNF_rews = map (fn th => th RS eq_reflection)[th1,th2,th3,th4,th5,th6,th7];
(* The name "contrapos" is already taken. *)
goal HOL.thy "(P --> Q) = ((~ Q) --> (~ P))";
by (fast_tac HOL_cs 1);
val ol_contrapos = result();
(* Maps to another version of wellfoundedness *)
val [p1] = goalw WF.thy [wf_def]
"wf(R) ==> (!Q. (? x. Q x) --> (? min. Q min & (!b. (b,min):R --> (~ Q b))))";
by (rtac allI 1);
by (rtac (ol_contrapos RS ssubst) 1);
by (rewrite_tac NNF_rews);
by (rtac impI 1);
by (rtac ((p1 RS spec) RS mp) 1);
by (fast_tac HOL_cs 1);
val wf_minimal = result();
goalw WF.thy [wf_def]
"(!Q. (? x. Q x) --> (? min. Q min & (!b. (b,min):R --> (~ Q b)))) --> wf R";
by (rtac impI 1);
by (rtac allI 1);
by (rtac (ol_contrapos RS ssubst) 1);
by (rewrite_tac NNF_rews);
by (rtac impI 1);
by (etac allE 1);
by (dtac mp 1);
by (assume_tac 1);
by (fast_tac HOL_cs 1);
val minimal_wf = result();
val wf_eq_minimal =
standard ((wf_minimal COMP ((minimal_wf RS mp) COMP iffI)) RS sym);
goalw WF1.thy [inv_image_def,wf_eq_minimal RS eq_reflection]
"wf(R) --> wf(inv_image R (f::'a=>'b))";
by (strip_tac 1);
by (etac exE 1);
by (subgoal_tac "? (w::'b). ? (x::'a). Q x & (f x = w)" 1);
by (rtac exI 2);
by (rtac exI 2);
by (rtac conjI 2);
by (assume_tac 2);
by (rtac refl 2);
by (etac allE 1);
by (dtac mp 1);
by (assume_tac 1);
by (eres_inst_tac [("P","? min. (? x. Q x & f x = min) & \
\ (! b. (b, min) : R --> ~ (? x. Q x & f x = b))")] rev_mp 1);
by (etac thin_rl 1);
by (etac thin_rl 1);
by (rewrite_tac NNF_rews);
by (rtac impI 1);
by (etac exE 1);
by (etac conjE 1);
by (etac exE 1);
by (rtac exI 1);
by (etac conjE 1);
by (rtac conjI 1);
by (assume_tac 1);
by (hyp_subst_tac 1);
by (rtac allI 1);
by (rtac impI 1);
by (etac CollectE 1);
by (etac allE 1);
by (dtac mp 1);
by (rewrite_tac[fst_conv RS eq_reflection,snd_conv RS eq_reflection]);
by (assume_tac 1);
by (fast_tac HOL_cs 1);
val wf_inv_image = result() RS mp;
(* from Nat.ML *)
goalw WF1.thy [wf_def] "wf(pred_nat)";
by (strip_tac 1);
by (nat_ind_tac "x" 1);
by (fast_tac (HOL_cs addSEs [mp, pred_natE, Pair_inject,
make_elim Suc_inject]) 2);
by (fast_tac (HOL_cs addSEs [mp, pred_natE, Pair_inject, Zero_neq_Suc]) 1);
val wf_pred_nat = result();
goalw WF1.thy [wf_def,pred_list_def] "wf(pred_list)";
by (strip_tac 1);
by (List.list.induct_tac "x" 1);
by (etac allE 1);
by (etac impE 1);
by (assume_tac 2);
by (strip_tac 1);
by (etac CollectE 1);
by (asm_full_simp_tac (!simpset) 1);
by (etac allE 1);
by (etac impE 1);
by (assume_tac 2);
by (strip_tac 1);
by (etac CollectE 1);
by (etac exE 1);
by (asm_full_simp_tac (!simpset) 1);
by (etac conjE 1);
by (hyp_subst_tac 1);
by (assume_tac 1);
qed "wf_pred_list";
(*----------------------------------------------------------------------------
* All measures are wellfounded.
*---------------------------------------------------------------------------*)
goalw WF1.thy [measure_def] "wf (measure f)";
by (rtac wf_inv_image 1);
by (rtac wf_trancl 1);
by (rtac wf_pred_nat 1);
qed "wf_measure";
(*----------------------------------------------------------------------------
* Wellfoundedness of lexicographic combinations
*---------------------------------------------------------------------------*)
val prems = goal Prod.thy "!a b. P((a,b)) ==> !p. P(p)";
by (cut_facts_tac prems 1);
by (rtac allI 1);
by (rtac (surjective_pairing RS ssubst) 1);
by (fast_tac HOL_cs 1);
qed "split_all_pair";
val [wfa,wfb] = goalw WF1.thy [wf_def,lex_prod_def]
"[| wf(ra); wf(rb) |] ==> wf(ra**rb)";
by (EVERY1 [rtac allI,rtac impI, rtac split_all_pair]);
by (rtac (wfa RS spec RS mp) 1);
by (EVERY1 [rtac allI,rtac impI]);
by (rtac (wfb RS spec RS mp) 1);
by (fast_tac (set_cs addSEs [Pair_inject]) 1);
qed "wf_lex_prod";
(*----------------------------------------------------------------------------
* Wellfoundedness of relational product
*---------------------------------------------------------------------------*)
val [wfa,wfb] = goalw WF1.thy [wf_def,rprod_def]
"[| wf(ra); wf(rb) |] ==> wf(rprod ra rb)";
by (EVERY1 [rtac allI,rtac impI, rtac split_all_pair]);
by (rtac (wfa RS spec RS mp) 1);
by (EVERY1 [rtac allI,rtac impI]);
by (rtac (wfb RS spec RS mp) 1);
by (fast_tac (set_cs addSEs [Pair_inject]) 1);
qed "wf_rel_prod";
(*---------------------------------------------------------------------------
* Wellfoundedness of subsets
*---------------------------------------------------------------------------*)
goalw WF1.thy [wf_eq_minimal RS eq_reflection]
"wf(r) --> (!x y. (x,y):p --> (x,y):r) --> wf(p)";
by (fast_tac set_cs 1);
qed "wf_subset";
(*---------------------------------------------------------------------------
* Wellfoundedness of the empty relation.
*---------------------------------------------------------------------------*)
goalw WF1.thy [wf_eq_minimal RS eq_reflection,emptyr_def]
"wf(emptyr)";
by (fast_tac set_cs 1);
qed "wf_emptyr";