src/HOL/Inductive.thy
author wenzelm
Sat Oct 01 11:14:00 2016 +0200 (2016-10-01)
changeset 63976 c1a481bb82d3
parent 63863 d14e580c3b8f
child 63979 95c3ae4baba8
permissions -rw-r--r--
added lemma;
     1 (*  Title:      HOL/Inductive.thy
     2     Author:     Markus Wenzel, TU Muenchen
     3 *)
     4 
     5 section \<open>Knaster-Tarski Fixpoint Theorem and inductive definitions\<close>
     6 
     7 theory Inductive
     8   imports Complete_Lattices Ctr_Sugar
     9   keywords
    10     "inductive" "coinductive" "inductive_cases" "inductive_simps" :: thy_decl and
    11     "monos" and
    12     "print_inductives" :: diag and
    13     "old_rep_datatype" :: thy_goal and
    14     "primrec" :: thy_decl
    15 begin
    16 
    17 subsection \<open>Least and greatest fixed points\<close>
    18 
    19 context complete_lattice
    20 begin
    21 
    22 definition lfp :: "('a \<Rightarrow> 'a) \<Rightarrow> 'a"  \<comment> \<open>least fixed point\<close>
    23   where "lfp f = Inf {u. f u \<le> u}"
    24 
    25 definition gfp :: "('a \<Rightarrow> 'a) \<Rightarrow> 'a"  \<comment> \<open>greatest fixed point\<close>
    26   where "gfp f = Sup {u. u \<le> f u}"
    27 
    28 
    29 subsection \<open>Proof of Knaster-Tarski Theorem using @{term lfp}\<close>
    30 
    31 text \<open>@{term "lfp f"} is the least upper bound of the set @{term "{u. f u \<le> u}"}\<close>
    32 
    33 lemma lfp_lowerbound: "f A \<le> A \<Longrightarrow> lfp f \<le> A"
    34   by (auto simp add: lfp_def intro: Inf_lower)
    35 
    36 lemma lfp_greatest: "(\<And>u. f u \<le> u \<Longrightarrow> A \<le> u) \<Longrightarrow> A \<le> lfp f"
    37   by (auto simp add: lfp_def intro: Inf_greatest)
    38 
    39 end
    40 
    41 lemma lfp_lemma2: "mono f \<Longrightarrow> f (lfp f) \<le> lfp f"
    42   by (iprover intro: lfp_greatest order_trans monoD lfp_lowerbound)
    43 
    44 lemma lfp_lemma3: "mono f \<Longrightarrow> lfp f \<le> f (lfp f)"
    45   by (iprover intro: lfp_lemma2 monoD lfp_lowerbound)
    46 
    47 lemma lfp_unfold: "mono f \<Longrightarrow> lfp f = f (lfp f)"
    48   by (iprover intro: order_antisym lfp_lemma2 lfp_lemma3)
    49 
    50 lemma lfp_const: "lfp (\<lambda>x. t) = t"
    51   by (rule lfp_unfold) (simp add: mono_def)
    52 
    53 lemma lfp_eqI: "mono F \<Longrightarrow> F x = x \<Longrightarrow> (\<And>z. F z = z \<Longrightarrow> x \<le> z) \<Longrightarrow> lfp F = x"
    54   by (rule antisym) (simp_all add: lfp_lowerbound lfp_unfold[symmetric])
    55 
    56 
    57 subsection \<open>General induction rules for least fixed points\<close>
    58 
    59 lemma lfp_ordinal_induct [case_names mono step union]:
    60   fixes f :: "'a::complete_lattice \<Rightarrow> 'a"
    61   assumes mono: "mono f"
    62     and P_f: "\<And>S. P S \<Longrightarrow> S \<le> lfp f \<Longrightarrow> P (f S)"
    63     and P_Union: "\<And>M. \<forall>S\<in>M. P S \<Longrightarrow> P (Sup M)"
    64   shows "P (lfp f)"
    65 proof -
    66   let ?M = "{S. S \<le> lfp f \<and> P S}"
    67   from P_Union have "P (Sup ?M)" by simp
    68   also have "Sup ?M = lfp f"
    69   proof (rule antisym)
    70     show "Sup ?M \<le> lfp f"
    71       by (blast intro: Sup_least)
    72     then have "f (Sup ?M) \<le> f (lfp f)"
    73       by (rule mono [THEN monoD])
    74     then have "f (Sup ?M) \<le> lfp f"
    75       using mono [THEN lfp_unfold] by simp
    76     then have "f (Sup ?M) \<in> ?M"
    77       using P_Union by simp (intro P_f Sup_least, auto)
    78     then have "f (Sup ?M) \<le> Sup ?M"
    79       by (rule Sup_upper)
    80     then show "lfp f \<le> Sup ?M"
    81       by (rule lfp_lowerbound)
    82   qed
    83   finally show ?thesis .
    84 qed
    85 
    86 theorem lfp_induct:
    87   assumes mono: "mono f"
    88     and ind: "f (inf (lfp f) P) \<le> P"
    89   shows "lfp f \<le> P"
    90 proof (induct rule: lfp_ordinal_induct)
    91   case mono
    92   show ?case by fact
    93 next
    94   case (step S)
    95   then show ?case
    96     by (intro order_trans[OF _ ind] monoD[OF mono]) auto
    97 next
    98   case (union M)
    99   then show ?case
   100     by (auto intro: Sup_least)
   101 qed
   102 
   103 lemma lfp_induct_set:
   104   assumes lfp: "a \<in> lfp f"
   105     and mono: "mono f"
   106     and hyp: "\<And>x. x \<in> f (lfp f \<inter> {x. P x}) \<Longrightarrow> P x"
   107   shows "P a"
   108   by (rule lfp_induct [THEN subsetD, THEN CollectD, OF mono _ lfp]) (auto intro: hyp)
   109 
   110 lemma lfp_ordinal_induct_set:
   111   assumes mono: "mono f"
   112     and P_f: "\<And>S. P S \<Longrightarrow> P (f S)"
   113     and P_Union: "\<And>M. \<forall>S\<in>M. P S \<Longrightarrow> P (\<Union>M)"
   114   shows "P (lfp f)"
   115   using assms by (rule lfp_ordinal_induct)
   116 
   117 
   118 text \<open>Definition forms of \<open>lfp_unfold\<close> and \<open>lfp_induct\<close>, to control unfolding.\<close>
   119 
   120 lemma def_lfp_unfold: "h \<equiv> lfp f \<Longrightarrow> mono f \<Longrightarrow> h = f h"
   121   by (auto intro!: lfp_unfold)
   122 
   123 lemma def_lfp_induct: "A \<equiv> lfp f \<Longrightarrow> mono f \<Longrightarrow> f (inf A P) \<le> P \<Longrightarrow> A \<le> P"
   124   by (blast intro: lfp_induct)
   125 
   126 lemma def_lfp_induct_set:
   127   "A \<equiv> lfp f \<Longrightarrow> mono f \<Longrightarrow> a \<in> A \<Longrightarrow> (\<And>x. x \<in> f (A \<inter> {x. P x}) \<Longrightarrow> P x) \<Longrightarrow> P a"
   128   by (blast intro: lfp_induct_set)
   129 
   130 text \<open>Monotonicity of \<open>lfp\<close>!\<close>
   131 lemma lfp_mono: "(\<And>Z. f Z \<le> g Z) \<Longrightarrow> lfp f \<le> lfp g"
   132   by (rule lfp_lowerbound [THEN lfp_greatest]) (blast intro: order_trans)
   133 
   134 
   135 subsection \<open>Proof of Knaster-Tarski Theorem using \<open>gfp\<close>\<close>
   136 
   137 text \<open>@{term "gfp f"} is the greatest lower bound of the set @{term "{u. u \<le> f u}"}\<close>
   138 
   139 lemma gfp_upperbound: "X \<le> f X \<Longrightarrow> X \<le> gfp f"
   140   by (auto simp add: gfp_def intro: Sup_upper)
   141 
   142 lemma gfp_least: "(\<And>u. u \<le> f u \<Longrightarrow> u \<le> X) \<Longrightarrow> gfp f \<le> X"
   143   by (auto simp add: gfp_def intro: Sup_least)
   144 
   145 lemma gfp_lemma2: "mono f \<Longrightarrow> gfp f \<le> f (gfp f)"
   146   by (iprover intro: gfp_least order_trans monoD gfp_upperbound)
   147 
   148 lemma gfp_lemma3: "mono f \<Longrightarrow> f (gfp f) \<le> gfp f"
   149   by (iprover intro: gfp_lemma2 monoD gfp_upperbound)
   150 
   151 lemma gfp_unfold: "mono f \<Longrightarrow> gfp f = f (gfp f)"
   152   by (iprover intro: order_antisym gfp_lemma2 gfp_lemma3)
   153 
   154 lemma gfp_const: "gfp (\<lambda>x. t) = t"
   155   by (rule gfp_unfold) (simp add: mono_def)
   156 
   157 lemma gfp_eqI: "mono F \<Longrightarrow> F x = x \<Longrightarrow> (\<And>z. F z = z \<Longrightarrow> z \<le> x) \<Longrightarrow> gfp F = x"
   158   by (rule antisym) (simp_all add: gfp_upperbound gfp_unfold[symmetric])
   159 
   160 
   161 lemma lfp_le_gfp: "mono f \<Longrightarrow> lfp f \<le> gfp f"
   162   by (iprover intro: gfp_upperbound lfp_lemma3)
   163 
   164 
   165 subsection \<open>Coinduction rules for greatest fixed points\<close>
   166 
   167 text \<open>Weak version.\<close>
   168 lemma weak_coinduct: "a \<in> X \<Longrightarrow> X \<subseteq> f X \<Longrightarrow> a \<in> gfp f"
   169   by (rule gfp_upperbound [THEN subsetD]) auto
   170 
   171 lemma weak_coinduct_image: "a \<in> X \<Longrightarrow> g`X \<subseteq> f (g`X) \<Longrightarrow> g a \<in> gfp f"
   172   apply (erule gfp_upperbound [THEN subsetD])
   173   apply (erule imageI)
   174   done
   175 
   176 lemma coinduct_lemma: "X \<le> f (sup X (gfp f)) \<Longrightarrow> mono f \<Longrightarrow> sup X (gfp f) \<le> f (sup X (gfp f))"
   177   apply (frule gfp_lemma2)
   178   apply (drule mono_sup)
   179   apply (rule le_supI)
   180    apply assumption
   181   apply (rule order_trans)
   182    apply (rule order_trans)
   183     apply assumption
   184    apply (rule sup_ge2)
   185   apply assumption
   186   done
   187 
   188 text \<open>Strong version, thanks to Coen and Frost.\<close>
   189 lemma coinduct_set: "mono f \<Longrightarrow> a \<in> X \<Longrightarrow> X \<subseteq> f (X \<union> gfp f) \<Longrightarrow> a \<in> gfp f"
   190   by (rule weak_coinduct[rotated], rule coinduct_lemma) blast+
   191 
   192 lemma gfp_fun_UnI2: "mono f \<Longrightarrow> a \<in> gfp f \<Longrightarrow> a \<in> f (X \<union> gfp f)"
   193   by (blast dest: gfp_lemma2 mono_Un)
   194 
   195 lemma gfp_ordinal_induct[case_names mono step union]:
   196   fixes f :: "'a::complete_lattice \<Rightarrow> 'a"
   197   assumes mono: "mono f"
   198     and P_f: "\<And>S. P S \<Longrightarrow> gfp f \<le> S \<Longrightarrow> P (f S)"
   199     and P_Union: "\<And>M. \<forall>S\<in>M. P S \<Longrightarrow> P (Inf M)"
   200   shows "P (gfp f)"
   201 proof -
   202   let ?M = "{S. gfp f \<le> S \<and> P S}"
   203   from P_Union have "P (Inf ?M)" by simp
   204   also have "Inf ?M = gfp f"
   205   proof (rule antisym)
   206     show "gfp f \<le> Inf ?M"
   207       by (blast intro: Inf_greatest)
   208     then have "f (gfp f) \<le> f (Inf ?M)"
   209       by (rule mono [THEN monoD])
   210     then have "gfp f \<le> f (Inf ?M)"
   211       using mono [THEN gfp_unfold] by simp
   212     then have "f (Inf ?M) \<in> ?M"
   213       using P_Union by simp (intro P_f Inf_greatest, auto)
   214     then have "Inf ?M \<le> f (Inf ?M)"
   215       by (rule Inf_lower)
   216     then show "Inf ?M \<le> gfp f"
   217       by (rule gfp_upperbound)
   218   qed
   219   finally show ?thesis .
   220 qed
   221 
   222 lemma coinduct:
   223   assumes mono: "mono f"
   224     and ind: "X \<le> f (sup X (gfp f))"
   225   shows "X \<le> gfp f"
   226 proof (induct rule: gfp_ordinal_induct)
   227   case mono
   228   then show ?case by fact
   229 next
   230   case (step S)
   231   then show ?case
   232     by (intro order_trans[OF ind _] monoD[OF mono]) auto
   233 next
   234   case (union M)
   235   then show ?case
   236     by (auto intro: mono Inf_greatest)
   237 qed
   238 
   239 
   240 subsection \<open>Even Stronger Coinduction Rule, by Martin Coen\<close>
   241 
   242 text \<open>Weakens the condition @{term "X \<subseteq> f X"} to one expressed using both
   243   @{term lfp} and @{term gfp}\<close>
   244 lemma coinduct3_mono_lemma: "mono f \<Longrightarrow> mono (\<lambda>x. f x \<union> X \<union> B)"
   245   by (iprover intro: subset_refl monoI Un_mono monoD)
   246 
   247 lemma coinduct3_lemma:
   248   "X \<subseteq> f (lfp (\<lambda>x. f x \<union> X \<union> gfp f)) \<Longrightarrow> mono f \<Longrightarrow>
   249     lfp (\<lambda>x. f x \<union> X \<union> gfp f) \<subseteq> f (lfp (\<lambda>x. f x \<union> X \<union> gfp f))"
   250   apply (rule subset_trans)
   251    apply (erule coinduct3_mono_lemma [THEN lfp_lemma3])
   252   apply (rule Un_least [THEN Un_least])
   253     apply (rule subset_refl, assumption)
   254   apply (rule gfp_unfold [THEN equalityD1, THEN subset_trans], assumption)
   255   apply (rule monoD, assumption)
   256   apply (subst coinduct3_mono_lemma [THEN lfp_unfold], auto)
   257   done
   258 
   259 lemma coinduct3: "mono f \<Longrightarrow> a \<in> X \<Longrightarrow> X \<subseteq> f (lfp (\<lambda>x. f x \<union> X \<union> gfp f)) \<Longrightarrow> a \<in> gfp f"
   260   apply (rule coinduct3_lemma [THEN [2] weak_coinduct])
   261     apply (rule coinduct3_mono_lemma [THEN lfp_unfold, THEN ssubst])
   262      apply simp_all
   263   done
   264 
   265 text  \<open>Definition forms of \<open>gfp_unfold\<close> and \<open>coinduct\<close>, to control unfolding.\<close>
   266 
   267 lemma def_gfp_unfold: "A \<equiv> gfp f \<Longrightarrow> mono f \<Longrightarrow> A = f A"
   268   by (auto intro!: gfp_unfold)
   269 
   270 lemma def_coinduct: "A \<equiv> gfp f \<Longrightarrow> mono f \<Longrightarrow> X \<le> f (sup X A) \<Longrightarrow> X \<le> A"
   271   by (iprover intro!: coinduct)
   272 
   273 lemma def_coinduct_set: "A \<equiv> gfp f \<Longrightarrow> mono f \<Longrightarrow> a \<in> X \<Longrightarrow> X \<subseteq> f (X \<union> A) \<Longrightarrow> a \<in> A"
   274   by (auto intro!: coinduct_set)
   275 
   276 lemma def_Collect_coinduct:
   277   "A \<equiv> gfp (\<lambda>w. Collect (P w)) \<Longrightarrow> mono (\<lambda>w. Collect (P w)) \<Longrightarrow> a \<in> X \<Longrightarrow>
   278     (\<And>z. z \<in> X \<Longrightarrow> P (X \<union> A) z) \<Longrightarrow> a \<in> A"
   279   by (erule def_coinduct_set) auto
   280 
   281 lemma def_coinduct3: "A \<equiv> gfp f \<Longrightarrow> mono f \<Longrightarrow> a \<in> X \<Longrightarrow> X \<subseteq> f (lfp (\<lambda>x. f x \<union> X \<union> A)) \<Longrightarrow> a \<in> A"
   282   by (auto intro!: coinduct3)
   283 
   284 text \<open>Monotonicity of @{term gfp}!\<close>
   285 lemma gfp_mono: "(\<And>Z. f Z \<le> g Z) \<Longrightarrow> gfp f \<le> gfp g"
   286   by (rule gfp_upperbound [THEN gfp_least]) (blast intro: order_trans)
   287 
   288 
   289 subsection \<open>Rules for fixed point calculus\<close>
   290 
   291 lemma lfp_rolling:
   292   assumes "mono g" "mono f"
   293   shows "g (lfp (\<lambda>x. f (g x))) = lfp (\<lambda>x. g (f x))"
   294 proof (rule antisym)
   295   have *: "mono (\<lambda>x. f (g x))"
   296     using assms by (auto simp: mono_def)
   297   show "lfp (\<lambda>x. g (f x)) \<le> g (lfp (\<lambda>x. f (g x)))"
   298     by (rule lfp_lowerbound) (simp add: lfp_unfold[OF *, symmetric])
   299   show "g (lfp (\<lambda>x. f (g x))) \<le> lfp (\<lambda>x. g (f x))"
   300   proof (rule lfp_greatest)
   301     fix u
   302     assume u: "g (f u) \<le> u"
   303     then have "g (lfp (\<lambda>x. f (g x))) \<le> g (f u)"
   304       by (intro assms[THEN monoD] lfp_lowerbound)
   305     with u show "g (lfp (\<lambda>x. f (g x))) \<le> u"
   306       by auto
   307   qed
   308 qed
   309 
   310 lemma lfp_lfp:
   311   assumes f: "\<And>x y w z. x \<le> y \<Longrightarrow> w \<le> z \<Longrightarrow> f x w \<le> f y z"
   312   shows "lfp (\<lambda>x. lfp (f x)) = lfp (\<lambda>x. f x x)"
   313 proof (rule antisym)
   314   have *: "mono (\<lambda>x. f x x)"
   315     by (blast intro: monoI f)
   316   show "lfp (\<lambda>x. lfp (f x)) \<le> lfp (\<lambda>x. f x x)"
   317     by (intro lfp_lowerbound) (simp add: lfp_unfold[OF *, symmetric])
   318   show "lfp (\<lambda>x. lfp (f x)) \<ge> lfp (\<lambda>x. f x x)" (is "?F \<ge> _")
   319   proof (intro lfp_lowerbound)
   320     have *: "?F = lfp (f ?F)"
   321       by (rule lfp_unfold) (blast intro: monoI lfp_mono f)
   322     also have "\<dots> = f ?F (lfp (f ?F))"
   323       by (rule lfp_unfold) (blast intro: monoI lfp_mono f)
   324     finally show "f ?F ?F \<le> ?F"
   325       by (simp add: *[symmetric])
   326   qed
   327 qed
   328 
   329 lemma gfp_rolling:
   330   assumes "mono g" "mono f"
   331   shows "g (gfp (\<lambda>x. f (g x))) = gfp (\<lambda>x. g (f x))"
   332 proof (rule antisym)
   333   have *: "mono (\<lambda>x. f (g x))"
   334     using assms by (auto simp: mono_def)
   335   show "g (gfp (\<lambda>x. f (g x))) \<le> gfp (\<lambda>x. g (f x))"
   336     by (rule gfp_upperbound) (simp add: gfp_unfold[OF *, symmetric])
   337   show "gfp (\<lambda>x. g (f x)) \<le> g (gfp (\<lambda>x. f (g x)))"
   338   proof (rule gfp_least)
   339     fix u
   340     assume u: "u \<le> g (f u)"
   341     then have "g (f u) \<le> g (gfp (\<lambda>x. f (g x)))"
   342       by (intro assms[THEN monoD] gfp_upperbound)
   343     with u show "u \<le> g (gfp (\<lambda>x. f (g x)))"
   344       by auto
   345   qed
   346 qed
   347 
   348 lemma gfp_gfp:
   349   assumes f: "\<And>x y w z. x \<le> y \<Longrightarrow> w \<le> z \<Longrightarrow> f x w \<le> f y z"
   350   shows "gfp (\<lambda>x. gfp (f x)) = gfp (\<lambda>x. f x x)"
   351 proof (rule antisym)
   352   have *: "mono (\<lambda>x. f x x)"
   353     by (blast intro: monoI f)
   354   show "gfp (\<lambda>x. f x x) \<le> gfp (\<lambda>x. gfp (f x))"
   355     by (intro gfp_upperbound) (simp add: gfp_unfold[OF *, symmetric])
   356   show "gfp (\<lambda>x. gfp (f x)) \<le> gfp (\<lambda>x. f x x)" (is "?F \<le> _")
   357   proof (intro gfp_upperbound)
   358     have *: "?F = gfp (f ?F)"
   359       by (rule gfp_unfold) (blast intro: monoI gfp_mono f)
   360     also have "\<dots> = f ?F (gfp (f ?F))"
   361       by (rule gfp_unfold) (blast intro: monoI gfp_mono f)
   362     finally show "?F \<le> f ?F ?F"
   363       by (simp add: *[symmetric])
   364   qed
   365 qed
   366 
   367 
   368 subsection \<open>Inductive predicates and sets\<close>
   369 
   370 text \<open>Package setup.\<close>
   371 
   372 lemmas basic_monos =
   373   subset_refl imp_refl disj_mono conj_mono ex_mono all_mono if_bool_eq_conj
   374   Collect_mono in_mono vimage_mono
   375 
   376 lemma le_rel_bool_arg_iff: "X \<le> Y \<longleftrightarrow> X False \<le> Y False \<and> X True \<le> Y True"
   377   unfolding le_fun_def le_bool_def using bool_induct by auto
   378 
   379 lemma imp_conj_iff: "((P \<longrightarrow> Q) \<and> P) = (P \<and> Q)"
   380   by blast
   381 
   382 lemma meta_fun_cong: "P \<equiv> Q \<Longrightarrow> P a \<equiv> Q a"
   383   by auto
   384 
   385 ML_file "Tools/inductive.ML"
   386 
   387 lemmas [mono] =
   388   imp_refl disj_mono conj_mono ex_mono all_mono if_bool_eq_conj
   389   imp_mono not_mono
   390   Ball_def Bex_def
   391   induct_rulify_fallback
   392 
   393 
   394 subsection \<open>Inductive datatypes and primitive recursion\<close>
   395 
   396 text \<open>Package setup.\<close>
   397 
   398 ML_file "Tools/Old_Datatype/old_datatype_aux.ML"
   399 ML_file "Tools/Old_Datatype/old_datatype_prop.ML"
   400 ML_file "Tools/Old_Datatype/old_datatype_data.ML"
   401 ML_file "Tools/Old_Datatype/old_rep_datatype.ML"
   402 ML_file "Tools/Old_Datatype/old_datatype_codegen.ML"
   403 ML_file "Tools/Old_Datatype/old_primrec.ML"
   404 
   405 ML_file "Tools/BNF/bnf_fp_rec_sugar_util.ML"
   406 ML_file "Tools/BNF/bnf_lfp_rec_sugar.ML"
   407 
   408 text \<open>Lambda-abstractions with pattern matching:\<close>
   409 syntax (ASCII)
   410   "_lam_pats_syntax" :: "cases_syn \<Rightarrow> 'a \<Rightarrow> 'b"  ("(%_)" 10)
   411 syntax
   412   "_lam_pats_syntax" :: "cases_syn \<Rightarrow> 'a \<Rightarrow> 'b"  ("(\<lambda>_)" 10)
   413 parse_translation \<open>
   414   let
   415     fun fun_tr ctxt [cs] =
   416       let
   417         val x = Syntax.free (fst (Name.variant "x" (Term.declare_term_frees cs Name.context)));
   418         val ft = Case_Translation.case_tr true ctxt [x, cs];
   419       in lambda x ft end
   420   in [(@{syntax_const "_lam_pats_syntax"}, fun_tr)] end
   421 \<close>
   422 
   423 end