src/HOL/Library/While_Combinator.thy
 author bulwahn Tue Apr 05 09:38:28 2011 +0200 (2011-04-05) changeset 42231 bc1891226d00 parent 41764 5268aef2fe83 child 45834 9c232d370244 permissions -rw-r--r--
removing bounded_forall code equation for characters when loading Code_Char
1 (*  Title:      HOL/Library/While_Combinator.thy
2     Author:     Tobias Nipkow
3     Author:     Alexander Krauss
4     Copyright   2000 TU Muenchen
5 *)
7 header {* A general ``while'' combinator *}
9 theory While_Combinator
10 imports Main
11 begin
13 subsection {* Partial version *}
15 definition while_option :: "('a \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'a) \<Rightarrow> 'a \<Rightarrow> 'a option" where
16 "while_option b c s = (if (\<exists>k. ~ b ((c ^^ k) s))
17    then Some ((c ^^ (LEAST k. ~ b ((c ^^ k) s))) s)
18    else None)"
20 theorem while_option_unfold[code]:
21 "while_option b c s = (if b s then while_option b c (c s) else Some s)"
22 proof cases
23   assume "b s"
24   show ?thesis
25   proof (cases "\<exists>k. ~ b ((c ^^ k) s)")
26     case True
27     then obtain k where 1: "~ b ((c ^^ k) s)" ..
28     with `b s` obtain l where "k = Suc l" by (cases k) auto
29     with 1 have "~ b ((c ^^ l) (c s))" by (auto simp: funpow_swap1)
30     then have 2: "\<exists>l. ~ b ((c ^^ l) (c s))" ..
31     from 1
32     have "(LEAST k. ~ b ((c ^^ k) s)) = Suc (LEAST l. ~ b ((c ^^ Suc l) s))"
33       by (rule Least_Suc) (simp add: `b s`)
34     also have "... = Suc (LEAST l. ~ b ((c ^^ l) (c s)))"
35       by (simp add: funpow_swap1)
36     finally
37     show ?thesis
38       using True 2 `b s` by (simp add: funpow_swap1 while_option_def)
39   next
40     case False
41     then have "~ (\<exists>l. ~ b ((c ^^ Suc l) s))" by blast
42     then have "~ (\<exists>l. ~ b ((c ^^ l) (c s)))"
43       by (simp add: funpow_swap1)
44     with False  `b s` show ?thesis by (simp add: while_option_def)
45   qed
46 next
47   assume [simp]: "~ b s"
48   have least: "(LEAST k. ~ b ((c ^^ k) s)) = 0"
49     by (rule Least_equality) auto
50   moreover
51   have "\<exists>k. ~ b ((c ^^ k) s)" by (rule exI[of _ "0::nat"]) auto
52   ultimately show ?thesis unfolding while_option_def by auto
53 qed
55 lemma while_option_stop:
56 assumes "while_option b c s = Some t"
57 shows "~ b t"
58 proof -
59   from assms have ex: "\<exists>k. ~ b ((c ^^ k) s)"
60   and t: "t = (c ^^ (LEAST k. ~ b ((c ^^ k) s))) s"
61     by (auto simp: while_option_def split: if_splits)
62   from LeastI_ex[OF ex]
63   show "~ b t" unfolding t .
64 qed
66 theorem while_option_rule:
67 assumes step: "!!s. P s ==> b s ==> P (c s)"
68 and result: "while_option b c s = Some t"
69 and init: "P s"
70 shows "P t"
71 proof -
72   def k == "LEAST k. ~ b ((c ^^ k) s)"
73   from assms have t: "t = (c ^^ k) s"
74     by (simp add: while_option_def k_def split: if_splits)
75   have 1: "ALL i<k. b ((c ^^ i) s)"
76     by (auto simp: k_def dest: not_less_Least)
78   { fix i assume "i <= k" then have "P ((c ^^ i) s)"
79       by (induct i) (auto simp: init step 1) }
80   thus "P t" by (auto simp: t)
81 qed
84 subsection {* Total version *}
86 definition while :: "('a \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'a) \<Rightarrow> 'a \<Rightarrow> 'a"
87 where "while b c s = the (while_option b c s)"
89 lemma while_unfold:
90   "while b c s = (if b s then while b c (c s) else s)"
91 unfolding while_def by (subst while_option_unfold) simp
93 lemma def_while_unfold:
94   assumes fdef: "f == while test do"
95   shows "f x = (if test x then f(do x) else x)"
96 unfolding fdef by (fact while_unfold)
99 text {*
100  The proof rule for @{term while}, where @{term P} is the invariant.
101 *}
103 theorem while_rule_lemma:
104   assumes invariant: "!!s. P s ==> b s ==> P (c s)"
105     and terminate: "!!s. P s ==> \<not> b s ==> Q s"
106     and wf: "wf {(t, s). P s \<and> b s \<and> t = c s}"
107   shows "P s \<Longrightarrow> Q (while b c s)"
108   using wf
109   apply (induct s)
110   apply simp
111   apply (subst while_unfold)
112   apply (simp add: invariant terminate)
113   done
115 theorem while_rule:
116   "[| P s;
117       !!s. [| P s; b s  |] ==> P (c s);
118       !!s. [| P s; \<not> b s  |] ==> Q s;
119       wf r;
120       !!s. [| P s; b s  |] ==> (c s, s) \<in> r |] ==>
121    Q (while b c s)"
122   apply (rule while_rule_lemma)
123      prefer 4 apply assumption
124     apply blast
125    apply blast
126   apply (erule wf_subset)
127   apply blast
128   done
130 text{* Proving termination: *}
132 theorem wf_while_option_Some:
133   assumes "wf {(t, s). (P s \<and> b s) \<and> t = c s}"
134   and "!!s. P s \<Longrightarrow> b s \<Longrightarrow> P(c s)" and "P s"
135   shows "EX t. while_option b c s = Some t"
136 using assms(1,3)
137 apply (induct s)
138 using assms(2)
139 apply (subst while_option_unfold)
140 apply simp
141 done
143 theorem measure_while_option_Some: fixes f :: "'s \<Rightarrow> nat"
144 shows "(!!s. P s \<Longrightarrow> b s \<Longrightarrow> P(c s) \<and> f(c s) < f s)
145   \<Longrightarrow> P s \<Longrightarrow> EX t. while_option b c s = Some t"
146 by(blast intro: wf_while_option_Some[OF wf_if_measure, of P b f])
148 end