src/HOL/Nat.thy
changeset 24995 c26e0166e568
parent 24729 f5015dd2431b
child 25062 af5ef0d4d655
equal deleted inserted replaced
24994:c385c4eabb3b 24995:c26e0166e568
    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
   336   done
   344   done
   337 
   345 
   338 lemmas less_induct = nat_less_induct [rule_format, case_names less]
   346 lemmas less_induct = nat_less_induct [rule_format, case_names less]
   339 
   347 
   340 
   348 
   341 subsection {* Properties of "less than or equal" *}
   349 text {* Properties of "less than or equal" *}
   342 
   350 
   343 text {* Was @{text le_eq_less_Suc}, but this orientation is more useful *}
   351 text {* Was @{text le_eq_less_Suc}, but this orientation is more useful *}
   344 lemma less_Suc_eq_le: "(m < Suc n) = (m \<le> n)"
   352 lemma less_Suc_eq_le: "(m < Suc n) = (m \<le> n)"
   345   unfolding le_def by (rule not_less_eq [symmetric])
   353   unfolding le_def by (rule not_less_eq [symmetric])
   346 
   354 
   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