47 nat = Nat |
47 nat = Nat |
48 proof |
48 proof |
49 show "Zero_Rep : Nat" by (rule Nat.Zero_RepI) |
49 show "Zero_Rep : Nat" by (rule Nat.Zero_RepI) |
50 qed |
50 qed |
51 |
51 |
52 text {* Abstract constants and syntax *} |
|
53 |
|
54 consts |
52 consts |
55 Suc :: "nat => nat" |
53 Suc :: "nat => nat" |
56 |
54 |
57 local |
55 local |
58 |
56 |
|
57 instance nat :: zero |
|
58 Zero_nat_def: "0 == Abs_Nat Zero_Rep" .. |
|
59 lemmas [code func del] = Zero_nat_def |
|
60 |
59 defs |
61 defs |
60 Suc_def: "Suc == (%n. Abs_Nat (Suc_Rep (Rep_Nat n)))" |
62 Suc_def: "Suc == (%n. Abs_Nat (Suc_Rep (Rep_Nat n)))" |
61 |
|
62 definition |
|
63 pred_nat :: "(nat * nat) set" where |
|
64 "pred_nat = {(m, n). n = Suc m}" |
|
65 |
|
66 instance nat :: "{ord, zero, one}" |
|
67 Zero_nat_def: "0 == Abs_Nat Zero_Rep" |
|
68 One_nat_def [simp]: "1 == Suc 0" |
|
69 less_def: "m < n == (m, n) : pred_nat^+" |
|
70 le_def: "m \<le> (n::nat) == ~ (n < m)" .. |
|
71 |
|
72 lemmas [code func del] = Zero_nat_def less_def le_def |
|
73 |
|
74 text {* Induction *} |
|
75 |
63 |
76 theorem nat_induct: "P 0 ==> (!!n. P n ==> P (Suc n)) ==> P n" |
64 theorem nat_induct: "P 0 ==> (!!n. P n ==> P (Suc n)) ==> P n" |
77 apply (unfold Zero_nat_def Suc_def) |
65 apply (unfold Zero_nat_def Suc_def) |
78 apply (rule Rep_Nat_inverse [THEN subst]) -- {* types force good instantiation *} |
66 apply (rule Rep_Nat_inverse [THEN subst]) -- {* types force good instantiation *} |
79 apply (erule Rep_Nat [THEN Nat.induct]) |
67 apply (erule Rep_Nat [THEN Nat.induct]) |
80 apply (iprover elim: Abs_Nat_inverse [THEN subst]) |
68 apply (iprover elim: Abs_Nat_inverse [THEN subst]) |
81 done |
69 done |
82 |
70 |
83 text {* Distinctness of constructors *} |
|
84 |
|
85 lemma Suc_not_Zero [iff]: "Suc m \<noteq> 0" |
71 lemma Suc_not_Zero [iff]: "Suc m \<noteq> 0" |
86 by (simp add: Zero_nat_def Suc_def Abs_Nat_inject Rep_Nat Suc_RepI Zero_RepI |
72 by (simp add: Zero_nat_def Suc_def Abs_Nat_inject Rep_Nat Suc_RepI Zero_RepI |
87 Suc_Rep_not_Zero_Rep) |
73 Suc_Rep_not_Zero_Rep) |
88 |
74 |
89 lemma Zero_not_Suc [iff]: "0 \<noteq> Suc m" |
75 lemma Zero_not_Suc [iff]: "0 \<noteq> Suc m" |
90 by (rule not_sym, rule Suc_not_Zero not_sym) |
76 by (rule not_sym, rule Suc_not_Zero not_sym) |
91 |
77 |
92 lemma Suc_neq_Zero: "Suc m = 0 ==> R" |
|
93 by (rule notE, rule Suc_not_Zero) |
|
94 |
|
95 lemma Zero_neq_Suc: "0 = Suc m ==> R" |
|
96 by (rule Suc_neq_Zero, erule sym) |
|
97 |
|
98 text {* Injectiveness of @{term Suc} *} |
|
99 |
|
100 lemma inj_Suc[simp]: "inj_on Suc N" |
78 lemma inj_Suc[simp]: "inj_on Suc N" |
101 by (simp add: Suc_def inj_on_def Abs_Nat_inject Rep_Nat Suc_RepI |
79 by (simp add: Suc_def inj_on_def Abs_Nat_inject Rep_Nat Suc_RepI |
102 inj_Suc_Rep [THEN inj_eq] Rep_Nat_inject) |
80 inj_Suc_Rep [THEN inj_eq] Rep_Nat_inject) |
103 |
81 |
104 lemma Suc_inject: "Suc x = Suc y ==> x = y" |
|
105 by (rule inj_Suc [THEN injD]) |
|
106 |
|
107 lemma Suc_Suc_eq [iff]: "(Suc m = Suc n) = (m = n)" |
82 lemma Suc_Suc_eq [iff]: "(Suc m = Suc n) = (m = n)" |
108 by (rule inj_Suc [THEN inj_eq]) |
83 by (rule inj_Suc [THEN inj_eq]) |
109 |
|
110 lemma nat_not_singleton: "(\<forall>x. x = (0::nat)) = False" |
|
111 by auto |
|
112 |
|
113 text {* size of a datatype value *} |
|
114 |
|
115 use "Tools/function_package/size.ML" |
|
116 |
|
117 class size = type + |
|
118 fixes size :: "'a \<Rightarrow> nat" |
|
119 |
|
120 setup Size.setup |
|
121 |
84 |
122 rep_datatype nat |
85 rep_datatype nat |
123 distinct Suc_not_Zero Zero_not_Suc |
86 distinct Suc_not_Zero Zero_not_Suc |
124 inject Suc_Suc_eq |
87 inject Suc_Suc_eq |
125 induction nat_induct |
88 induction nat_induct |
131 and nat_rec_Suc = nat.recs(2) |
94 and nat_rec_Suc = nat.recs(2) |
132 |
95 |
133 lemmas nat_case_0 = nat.cases(1) |
96 lemmas nat_case_0 = nat.cases(1) |
134 and nat_case_Suc = nat.cases(2) |
97 and nat_case_Suc = nat.cases(2) |
135 |
98 |
|
99 |
|
100 text {* Injectiveness and distinctness lemmas *} |
|
101 |
|
102 lemma Suc_neq_Zero: "Suc m = 0 ==> R" |
|
103 by (rule notE, rule Suc_not_Zero) |
|
104 |
|
105 lemma Zero_neq_Suc: "0 = Suc m ==> R" |
|
106 by (rule Suc_neq_Zero, erule sym) |
|
107 |
|
108 lemma Suc_inject: "Suc x = Suc y ==> x = y" |
|
109 by (rule inj_Suc [THEN injD]) |
|
110 |
|
111 lemma nat_not_singleton: "(\<forall>x. x = (0::nat)) = False" |
|
112 by auto |
|
113 |
136 lemma n_not_Suc_n: "n \<noteq> Suc n" |
114 lemma n_not_Suc_n: "n \<noteq> Suc n" |
137 by (induct n) simp_all |
115 by (induct n) simp_all |
138 |
116 |
139 lemma Suc_n_not_n: "Suc t \<noteq> t" |
117 lemma Suc_n_not_n: "Suc t \<noteq> t" |
140 by (rule not_sym, rule n_not_Suc_n) |
118 by (rule not_sym, rule n_not_Suc_n) |
|
119 |
141 |
120 |
142 text {* A special form of induction for reasoning |
121 text {* A special form of induction for reasoning |
143 about @{term "m < n"} and @{term "m - n"} *} |
122 about @{term "m < n"} and @{term "m - n"} *} |
144 |
123 |
145 theorem diff_induct: "(!!x. P x 0) ==> (!!y. P 0 (Suc y)) ==> |
124 theorem diff_induct: "(!!x. P x 0) ==> (!!y. P 0 (Suc y)) ==> |
149 prefer 2 |
128 prefer 2 |
150 apply (rule allI) |
129 apply (rule allI) |
151 apply (induct_tac x, iprover+) |
130 apply (induct_tac x, iprover+) |
152 done |
131 done |
153 |
132 |
154 subsection {* Basic properties of "less than" *} |
133 |
|
134 subsection {* Arithmetic operators *} |
|
135 |
|
136 instance nat :: "{one, plus, minus, times}" |
|
137 One_nat_def [simp]: "1 == Suc 0" .. |
|
138 |
|
139 primrec |
|
140 add_0: "0 + n = n" |
|
141 add_Suc: "Suc m + n = Suc (m + n)" |
|
142 |
|
143 primrec |
|
144 diff_0: "m - 0 = m" |
|
145 diff_Suc: "m - Suc n = (case m - n of 0 => 0 | Suc k => k)" |
|
146 |
|
147 primrec |
|
148 mult_0: "0 * n = 0" |
|
149 mult_Suc: "Suc m * n = n + (m * n)" |
|
150 |
|
151 |
|
152 subsection {* Orders on @{typ nat} *} |
|
153 |
|
154 definition |
|
155 pred_nat :: "(nat * nat) set" where |
|
156 "pred_nat = {(m, n). n = Suc m}" |
|
157 |
|
158 instance nat :: ord |
|
159 less_def: "m < n == (m, n) : pred_nat^+" |
|
160 le_def: "m \<le> (n::nat) == ~ (n < m)" .. |
|
161 |
|
162 lemmas [code func del] = less_def le_def |
155 |
163 |
156 lemma wf_pred_nat: "wf pred_nat" |
164 lemma wf_pred_nat: "wf pred_nat" |
157 apply (unfold wf_def pred_nat_def, clarify) |
165 apply (unfold wf_def pred_nat_def, clarify) |
158 apply (induct_tac x, blast+) |
166 apply (induct_tac x, blast+) |
159 done |
167 done |
437 text {* Axiom @{text linorder_linear} of class @{text linorder}: *} |
445 text {* Axiom @{text linorder_linear} of class @{text linorder}: *} |
438 lemma nat_le_linear: "(m::nat) \<le> n | n \<le> m" |
446 lemma nat_le_linear: "(m::nat) \<le> n | n \<le> m" |
439 apply (simp add: le_eq_less_or_eq) |
447 apply (simp add: le_eq_less_or_eq) |
440 using less_linear by blast |
448 using less_linear by blast |
441 |
449 |
442 text {* Type {@typ nat} is a wellfounded linear order *} |
450 text {* Type @{typ nat} is a wellfounded linear order *} |
443 |
451 |
444 instance nat :: wellorder |
452 instance nat :: wellorder |
445 by intro_classes |
453 by intro_classes |
446 (assumption | |
454 (assumption | |
447 rule le_refl le_trans le_anti_sym nat_less_le nat_le_linear wf_less)+ |
455 rule le_refl le_trans le_anti_sym nat_less_le nat_le_linear wf_less)+ |
472 lemma zero_reorient: "(0 = x) = (x = 0)" |
480 lemma zero_reorient: "(0 = x) = (x = 0)" |
473 by auto |
481 by auto |
474 |
482 |
475 lemma one_reorient: "(1 = x) = (x = 1)" |
483 lemma one_reorient: "(1 = x) = (x = 1)" |
476 by auto |
484 by auto |
477 |
|
478 |
|
479 subsection {* Arithmetic operators *} |
|
480 |
|
481 class power = type + |
|
482 fixes power :: "'a \<Rightarrow> nat \<Rightarrow> 'a" (infixr "\<^loc>^" 80) |
|
483 |
|
484 text {* arithmetic operators @{text "+ -"} and @{text "*"} *} |
|
485 |
|
486 instance nat :: "{plus, minus, times}" .. |
|
487 |
|
488 primrec |
|
489 add_0: "0 + n = n" |
|
490 add_Suc: "Suc m + n = Suc (m + n)" |
|
491 |
|
492 primrec |
|
493 diff_0: "m - 0 = m" |
|
494 diff_Suc: "m - Suc n = (case m - n of 0 => 0 | Suc k => k)" |
|
495 |
|
496 primrec |
|
497 mult_0: "0 * n = 0" |
|
498 mult_Suc: "Suc m * n = n + (m * n)" |
|
499 |
485 |
500 text {* These two rules ease the use of primitive recursion. |
486 text {* These two rules ease the use of primitive recursion. |
501 NOTE USE OF @{text "=="} *} |
487 NOTE USE OF @{text "=="} *} |
502 lemma def_nat_rec_0: "(!!n. f n == nat_rec c h n) ==> f 0 = c" |
488 lemma def_nat_rec_0: "(!!n. f n == nat_rec c h n) ==> f 0 = c" |
503 by simp |
489 by simp |
1119 apply (fastsimp elim!: less_SucE) |
1105 apply (fastsimp elim!: less_SucE) |
1120 apply (fastsimp dest: mult_less_mono2) |
1106 apply (fastsimp dest: mult_less_mono2) |
1121 done |
1107 done |
1122 |
1108 |
1123 |
1109 |
|
1110 subsection {* size of a datatype value *} |
|
1111 |
|
1112 class size = type + |
|
1113 fixes size :: "'a \<Rightarrow> nat" |
|
1114 |
|
1115 use "Tools/function_package/size.ML" |
|
1116 |
|
1117 setup Size.setup |
|
1118 |
|
1119 lemma nat_size [simp, code func]: "size (n\<Colon>nat) = n" |
|
1120 by (induct n) simp_all |
|
1121 |
|
1122 lemma size_bool [code func]: |
|
1123 "size (b\<Colon>bool) = 0" by (cases b) auto |
|
1124 |
|
1125 declare "*.size" [noatp] |
|
1126 |
|
1127 |
1124 subsection {* Code generator setup *} |
1128 subsection {* Code generator setup *} |
1125 |
1129 |
1126 lemma one_is_Suc_zero [code inline]: "1 = Suc 0" |
1130 lemma one_is_Suc_zero [code inline]: "1 = Suc 0" |
1127 by simp |
1131 by simp |
1128 |
1132 |
1464 |
1468 |
1465 lemma of_nat_eq_id [simp]: "of_nat = (id :: nat => nat)" |
1469 lemma of_nat_eq_id [simp]: "of_nat = (id :: nat => nat)" |
1466 by (auto simp add: expand_fun_eq) |
1470 by (auto simp add: expand_fun_eq) |
1467 |
1471 |
1468 |
1472 |
|
1473 text {* the lattice order on @{typ nat} *} |
|
1474 |
1469 instance nat :: distrib_lattice |
1475 instance nat :: distrib_lattice |
1470 "inf \<equiv> min" |
1476 "inf \<equiv> min" |
1471 "sup \<equiv> max" |
1477 "sup \<equiv> max" |
1472 by intro_classes (auto simp add: inf_nat_def sup_nat_def) |
1478 by intro_classes |
1473 |
1479 (simp_all add: inf_nat_def sup_nat_def) |
1474 |
|
1475 subsection {* Size function declarations *} |
|
1476 |
|
1477 lemma nat_size [simp, code func]: "size (n\<Colon>nat) = n" |
|
1478 by (induct n) simp_all |
|
1479 |
|
1480 lemma size_bool [code func]: |
|
1481 "size (b\<Colon>bool) = 0" by (cases b) auto |
|
1482 |
|
1483 declare "*.size" [noatp] |
|
1484 |
1480 |
1485 |
1481 |
1486 subsection {* legacy bindings *} |
1482 subsection {* legacy bindings *} |
1487 |
1483 |
1488 ML |
1484 ML |