10251

1 
(* Title: HOL/Library/While.thy


2 
ID: $Id$


3 
Author: Tobias Nipkow


4 
Copyright 2000 TU Muenchen


5 
*)


6 


7 
header {*


8 
\title{A general ``while'' combinator}


9 
\author{Tobias Nipkow}


10 
*}


11 


12 
theory While_Combinator = Main:


13 


14 
text {*


15 
We define a whilecombinator @{term while} and prove: (a) an


16 
unrestricted unfolding law (even if while diverges!) (I got this


17 
idea from Wolfgang Goerigk), and (b) the invariant rule for reasoning


18 
about @{term while}.


19 
*}


20 


21 
consts while_aux :: "('a => bool) \<times> ('a => 'a) \<times> 'a => 'a"


22 
recdef while_aux


23 
"same_fst (\<lambda>b. True) (\<lambda>b. same_fst (\<lambda>c. True) (\<lambda>c.


24 
{(t, s). b s \<and> c s = t \<and>


25 
\<not> (\<exists>f. f 0 = s \<and> (\<forall>i. b (f i) \<and> c (f i) = f (i + 1)))}))"


26 
"while_aux (b, c, s) =


27 
(if (\<exists>f. f 0 = s \<and> (\<forall>i. b (f i) \<and> c (f i) = f (i + 1)))


28 
then arbitrary


29 
else if b s then while_aux (b, c, c s)


30 
else s)"


31 

10774

32 
recdef_tc while_aux_tc: while_aux


33 
apply (rule wf_same_fst)


34 
apply (rule wf_same_fst)


35 
apply (simp add: wf_iff_no_infinite_down_chain)


36 
apply blast


37 
done


38 

10251

39 
constdefs


40 
while :: "('a => bool) => ('a => 'a) => 'a => 'a"


41 
"while b c s == while_aux (b, c, s)"


42 


43 
lemma while_aux_unfold:


44 
"while_aux (b, c, s) =


45 
(if \<exists>f. f 0 = s \<and> (\<forall>i. b (f i) \<and> c (f i) = f (i + 1))


46 
then arbitrary


47 
else if b s then while_aux (b, c, c s)


48 
else s)"


49 
apply (rule while_aux_tc [THEN while_aux.simps [THEN trans]])


50 
apply (simp add: same_fst_def)


51 
apply (rule refl)


52 
done


53 


54 
text {*


55 
The recursion equation for @{term while}: directly executable!


56 
*}


57 


58 
theorem while_unfold:


59 
"while b c s = (if b s then while b c (c s) else s)"


60 
apply (unfold while_def)


61 
apply (rule while_aux_unfold [THEN trans])


62 
apply auto


63 
apply (subst while_aux_unfold)


64 
apply simp


65 
apply clarify


66 
apply (erule_tac x = "\<lambda>i. f (Suc i)" in allE)


67 
apply blast


68 
done


69 

10984

70 
hide const while_aux


71 

10251

72 
text {*


73 
The proof rule for @{term while}, where @{term P} is the invariant.


74 
*}


75 

10653

76 
theorem while_rule_lemma[rule_format]:

10984

77 
"[ !!s. P s ==> b s ==> P (c s);


78 
!!s. P s ==> \<not> b s ==> Q s;


79 
wf {(t, s). P s \<and> b s \<and> t = c s} ] ==>

10251

80 
P s > Q (while b c s)"


81 
proof 


82 
case antecedent


83 
assume wf: "wf {(t, s). P s \<and> b s \<and> t = c s}"


84 
show ?thesis


85 
apply (induct s rule: wf [THEN wf_induct])


86 
apply simp


87 
apply clarify


88 
apply (subst while_unfold)


89 
apply (simp add: antecedent)


90 
done


91 
qed


92 

10653

93 
theorem while_rule:

10984

94 
"[ P s;


95 
!!s. [ P s; b s ] ==> P (c s);


96 
!!s. [ P s; \<not> b s ] ==> Q s;


97 
wf r;


98 
!!s. [ P s; b s ] ==> (c s, s) \<in> r ] ==>


99 
Q (while b c s)"

10653

100 
apply (rule while_rule_lemma)


101 
prefer 4 apply assumption


102 
apply blast


103 
apply blast


104 
apply(erule wf_subset)


105 
apply blast


106 
done


107 

10984

108 
text {*


109 
\medskip An application: computation of the @{term lfp} on finite


110 
sets via iteration.


111 
*}


112 


113 
theorem lfp_conv_while:


114 
"[ mono f; finite U; f U = U ] ==>


115 
lfp f = fst (while (\<lambda>(A, fA). A \<noteq> fA) (\<lambda>(A, fA). (fA, f fA)) ({}, f {}))"


116 
apply (rule_tac P = "\<lambda>(A, B). (A \<subseteq> U \<and> B = f A \<and> A \<subseteq> B \<and> B \<subseteq> lfp f)" and


117 
r = "((Pow U <*> UNIV) <*> (Pow U <*> UNIV)) \<inter>


118 
inv_image finite_psubset (op  U o fst)" in while_rule)


119 
apply (subst lfp_unfold)


120 
apply assumption


121 
apply (simp add: monoD)


122 
apply (subst lfp_unfold)


123 
apply assumption


124 
apply clarsimp


125 
apply (blast dest: monoD)


126 
apply (fastsimp intro!: lfp_lowerbound)


127 
apply (blast intro: wf_finite_psubset Int_lower2 [THEN [2] wf_subset])


128 
apply (clarsimp simp add: inv_image_def finite_psubset_def order_less_le)


129 
apply (blast intro!: finite_Diff dest: monoD)


130 
done


131 


132 


133 
(*


134 
text {*


135 
An example of using the @{term while} combinator.


136 
*}


137 


138 
lemma aux: "{f n  n. A n \<or> B n} = {f n  n. A n} \<union> {f n  n. B n}"


139 
apply blast


140 
done


141 


142 
theorem "P (lfp (\<lambda>N::int set. {#0} \<union> {(n + #2) mod #6  n. n \<in> N})) =


143 
P {#0, #4, #2}"


144 
apply (subst lfp_conv_while [where ?U = "{#0, #1, #2, #3, #4, #5}"])


145 
apply (rule monoI)


146 
apply blast


147 
apply simp


148 
apply (simp add: aux set_eq_subset)


149 
txt {* The fixpoint computation is performed purely by rewriting: *}


150 
apply (simp add: while_unfold aux set_eq_subset del: subset_empty)


151 
done


152 
*)

10251

153 


154 
end
