16 and succ :: "'n \<Rightarrow> 'n" |
16 and succ :: "'n \<Rightarrow> 'n" |
17 assumes succ_inject [simp]: "(succ m = succ n) = (m = n)" |
17 assumes succ_inject [simp]: "(succ m = succ n) = (m = n)" |
18 and succ_neq_zero [simp]: "succ m \<noteq> zero" |
18 and succ_neq_zero [simp]: "succ m \<noteq> zero" |
19 and induct [case_names zero succ, induct type: 'n]: |
19 and induct [case_names zero succ, induct type: 'n]: |
20 "P zero \<Longrightarrow> (\<And>n. P n \<Longrightarrow> P (succ n)) \<Longrightarrow> P n" |
20 "P zero \<Longrightarrow> (\<And>n. P n \<Longrightarrow> P (succ n)) \<Longrightarrow> P n" |
|
21 begin |
21 |
22 |
22 lemma (in NAT) zero_neq_succ [simp]: "zero \<noteq> succ m" |
23 lemma zero_neq_succ [simp]: "zero \<noteq> succ m" |
23 by (rule succ_neq_zero [symmetric]) |
24 by (rule succ_neq_zero [symmetric]) |
24 |
25 |
25 |
26 |
26 text {* |
27 text {* \medskip Primitive recursion as a (functional) relation -- polymorphic! *} |
27 Primitive recursion as a (functional) relation -- polymorphic! |
|
28 |
28 |
29 (We simulate a localized version of the inductive packages using |
29 inductive2 |
30 explicit premises + parameters, and an abbreviation.) *} |
30 Rec :: "'a \<Rightarrow> ('n \<Rightarrow> 'a \<Rightarrow> 'a) \<Rightarrow> 'n \<Rightarrow> 'a \<Rightarrow> bool" |
|
31 for e :: 'a and r :: "'n \<Rightarrow> 'a \<Rightarrow> 'a" |
|
32 where |
|
33 Rec_zero: "Rec e r zero e" |
|
34 | Rec_succ: "Rec e r m n \<Longrightarrow> Rec e r (succ m) (r m n)" |
31 |
35 |
32 consts |
36 lemma Rec_functional: |
33 REC :: "'n \<Rightarrow> ('n \<Rightarrow> 'n) \<Rightarrow> 'a \<Rightarrow> ('n \<Rightarrow> 'a \<Rightarrow> 'a) \<Rightarrow> ('n * 'a) set" |
|
34 inductive "REC zer succ e r" |
|
35 intros |
|
36 Rec_zero: "NAT zer succ \<Longrightarrow> (zer, e) \<in> REC zer succ e r" |
|
37 Rec_succ: "NAT zer succ \<Longrightarrow> (m, n) \<in> REC zer succ e r \<Longrightarrow> |
|
38 (succ m, r m n) \<in> REC zer succ e r" |
|
39 |
|
40 abbreviation (in NAT) |
|
41 "Rec == REC zero succ" |
|
42 |
|
43 lemma (in NAT) Rec_functional: |
|
44 fixes x :: 'n |
37 fixes x :: 'n |
45 shows "\<exists>!y::'a. (x, y) \<in> Rec e r" (is "\<exists>!y::'a. _ \<in> ?Rec") |
38 shows "\<exists>!y::'a. Rec e r x y" |
46 proof (induct x) |
39 proof - |
47 case zero |
40 let ?R = "Rec e r" |
48 show "\<exists>!y. (zero, y) \<in> ?Rec" |
41 show ?thesis |
49 proof |
42 proof (induct x) |
50 show "(zero, e) \<in> ?Rec" by (rule Rec_zero) |
43 case zero |
51 fix y assume "(zero, y) \<in> ?Rec" |
44 show "\<exists>!y. ?R zero y" |
52 then show "y = e" by cases simp_all |
45 proof |
53 qed |
46 show "?R zero e" by (rule Rec_zero) |
54 next |
47 fix y assume "?R zero y" |
55 case (succ m) |
48 then show "y = e" by cases simp_all |
56 from `\<exists>!y. (m, y) \<in> ?Rec` |
49 qed |
57 obtain y where y: "(m, y) \<in> ?Rec" |
50 next |
58 and yy': "\<And>y'. (m, y') \<in> ?Rec \<Longrightarrow> y = y'" by blast |
51 case (succ m) |
59 show "\<exists>!z. (succ m, z) \<in> ?Rec" |
52 from `\<exists>!y. ?R m y` |
60 proof |
53 obtain y where y: "?R m y" |
61 from _ y show "(succ m, r m y) \<in> ?Rec" by (rule Rec_succ) |
54 and yy': "\<And>y'. ?R m y' \<Longrightarrow> y = y'" by blast |
62 fix z assume "(succ m, z) \<in> ?Rec" |
55 show "\<exists>!z. ?R (succ m) z" |
63 then obtain u where "z = r m u" and "(m, u) \<in> ?Rec" by cases simp_all |
56 proof |
64 with yy' show "z = r m y" by (simp only:) |
57 from y show "?R (succ m) (r m y)" by (rule Rec_succ) |
|
58 fix z assume "?R (succ m) z" |
|
59 then obtain u where "z = r m u" and "?R m u" by cases simp_all |
|
60 with yy' show "z = r m y" by (simp only:) |
|
61 qed |
65 qed |
62 qed |
66 qed |
63 qed |
67 |
64 |
68 |
65 |
69 text {* The recursion operator -- polymorphic! *} |
66 text {* \medskip The recursion operator -- polymorphic! *} |
70 |
67 |
71 definition (in NAT) |
68 definition |
72 "rec e r x = (THE y. (x, y) \<in> Rec e r)" |
69 rec :: "'a \<Rightarrow> ('n \<Rightarrow> 'a \<Rightarrow> 'a) \<Rightarrow> 'n \<Rightarrow> 'a" |
|
70 "rec e r x = (THE y. Rec e r x y)" |
73 |
71 |
74 lemma (in NAT) rec_eval: |
72 lemma rec_eval: |
75 assumes Rec: "(x, y) \<in> Rec e r" |
73 assumes Rec: "Rec e r x y" |
76 shows "rec e r x = y" |
74 shows "rec e r x = y" |
77 unfolding rec_def |
75 unfolding rec_def |
78 using Rec_functional and Rec by (rule the1_equality) |
76 using Rec_functional and Rec by (rule the1_equality) |
79 |
77 |
80 lemma (in NAT) rec_zero: "rec e r zero = e" |
78 lemma rec_zero [simp]: "rec e r zero = e" |
81 proof (rule rec_eval) |
79 proof (rule rec_eval) |
82 show "(zero, e) \<in> Rec e r" by (rule Rec_zero) |
80 show "Rec e r zero e" by (rule Rec_zero) |
83 qed |
81 qed |
84 |
82 |
85 lemma (in NAT) rec_succ: "rec e r (succ m) = r m (rec e r m)" |
83 lemma rec_succ [simp]: "rec e r (succ m) = r m (rec e r m)" |
86 proof (rule rec_eval) |
84 proof (rule rec_eval) |
87 let ?Rec = "Rec e r" |
85 let ?R = "Rec e r" |
88 have "(m, rec e r m) \<in> ?Rec" |
86 have "?R m (rec e r m)" |
89 unfolding rec_def |
87 unfolding rec_def using Rec_functional by (rule theI') |
90 using Rec_functional by (rule theI') |
88 then show "?R (succ m) (r m (rec e r m))" by (rule Rec_succ) |
91 with _ show "(succ m, r m (rec e r m)) \<in> ?Rec" by (rule Rec_succ) |
|
92 qed |
89 qed |
93 |
90 |
94 |
91 |
95 text {* Just see that our abstract specification makes sense \dots *} |
92 text {* \medskip Example: addition (monomorphic) *} |
|
93 |
|
94 definition |
|
95 add :: "'n \<Rightarrow> 'n \<Rightarrow> 'n" |
|
96 "add m n = rec n (\<lambda>_ k. succ k) m" |
|
97 |
|
98 lemma add_zero [simp]: "add zero n = n" |
|
99 and add_succ [simp]: "add (succ m) n = succ (add m n)" |
|
100 unfolding add_def by simp_all |
|
101 |
|
102 lemma add_assoc: "add (add k m) n = add k (add m n)" |
|
103 by (induct k) simp_all |
|
104 |
|
105 lemma add_zero_right: "add m zero = m" |
|
106 by (induct m) simp_all |
|
107 |
|
108 lemma add_succ_right: "add m (succ n) = succ (add m n)" |
|
109 by (induct m) simp_all |
|
110 |
|
111 |
|
112 text {* \medskip Example: replication (polymorphic) *} |
|
113 |
|
114 definition |
|
115 repl :: "'n \<Rightarrow> 'a \<Rightarrow> 'a list" |
|
116 "repl n x = rec [] (\<lambda>_ xs. x # xs) n" |
|
117 |
|
118 lemma repl_zero [simp]: "repl zero x = []" |
|
119 and repl_succ [simp]: "repl (succ n) x = x # repl n x" |
|
120 unfolding repl_def by simp_all |
|
121 |
|
122 lemma "repl (succ (succ (succ zero))) True = [True, True, True]" |
|
123 by simp |
|
124 |
|
125 end |
|
126 |
|
127 |
|
128 text {* \medskip Just see that our abstract specification makes sense \dots *} |
96 |
129 |
97 interpretation NAT [0 Suc] |
130 interpretation NAT [0 Suc] |
98 proof (rule NAT.intro) |
131 proof (rule NAT.intro) |
99 fix m n |
132 fix m n |
100 show "(Suc m = Suc n) = (m = n)" by simp |
133 show "(Suc m = Suc n) = (m = n)" by simp |