src/HOL/FunDef.thy
author wenzelm
Wed Sep 17 21:27:14 2008 +0200 (2008-09-17)
changeset 28263 69eaa97e7e96
parent 27271 ba2a00d35df1
child 29125 d41182a8135c
permissions -rw-r--r--
moved global ML bindings to global place;
     1 (*  Title:      HOL/FunDef.thy
     2     ID:         $Id$
     3     Author:     Alexander Krauss, TU Muenchen
     4 *)
     5 
     6 header {* General recursive function definitions *}
     7 
     8 theory FunDef
     9 imports Wellfounded
    10 uses
    11   ("Tools/function_package/fundef_lib.ML")
    12   ("Tools/function_package/fundef_common.ML")
    13   ("Tools/function_package/inductive_wrap.ML")
    14   ("Tools/function_package/context_tree.ML")
    15   ("Tools/function_package/fundef_core.ML")
    16   ("Tools/function_package/sum_tree.ML")
    17   ("Tools/function_package/mutual.ML")
    18   ("Tools/function_package/pattern_split.ML")
    19   ("Tools/function_package/fundef_package.ML")
    20   ("Tools/function_package/auto_term.ML")
    21   ("Tools/function_package/measure_functions.ML")
    22   ("Tools/function_package/lexicographic_order.ML")
    23   ("Tools/function_package/fundef_datatype.ML")
    24   ("Tools/function_package/induction_scheme.ML")
    25 begin
    26 
    27 text {* Definitions with default value. *}
    28 
    29 definition
    30   THE_default :: "'a \<Rightarrow> ('a \<Rightarrow> bool) \<Rightarrow> 'a" where
    31   "THE_default d P = (if (\<exists>!x. P x) then (THE x. P x) else d)"
    32 
    33 lemma THE_defaultI': "\<exists>!x. P x \<Longrightarrow> P (THE_default d P)"
    34   by (simp add: theI' THE_default_def)
    35 
    36 lemma THE_default1_equality:
    37     "\<lbrakk>\<exists>!x. P x; P a\<rbrakk> \<Longrightarrow> THE_default d P = a"
    38   by (simp add: the1_equality THE_default_def)
    39 
    40 lemma THE_default_none:
    41     "\<not>(\<exists>!x. P x) \<Longrightarrow> THE_default d P = d"
    42   by (simp add:THE_default_def)
    43 
    44 
    45 lemma fundef_ex1_existence:
    46   assumes f_def: "f == (\<lambda>x::'a. THE_default (d x) (\<lambda>y. G x y))"
    47   assumes ex1: "\<exists>!y. G x y"
    48   shows "G x (f x)"
    49   apply (simp only: f_def)
    50   apply (rule THE_defaultI')
    51   apply (rule ex1)
    52   done
    53 
    54 lemma fundef_ex1_uniqueness:
    55   assumes f_def: "f == (\<lambda>x::'a. THE_default (d x) (\<lambda>y. G x y))"
    56   assumes ex1: "\<exists>!y. G x y"
    57   assumes elm: "G x (h x)"
    58   shows "h x = f x"
    59   apply (simp only: f_def)
    60   apply (rule THE_default1_equality [symmetric])
    61    apply (rule ex1)
    62   apply (rule elm)
    63   done
    64 
    65 lemma fundef_ex1_iff:
    66   assumes f_def: "f == (\<lambda>x::'a. THE_default (d x) (\<lambda>y. G x y))"
    67   assumes ex1: "\<exists>!y. G x y"
    68   shows "(G x y) = (f x = y)"
    69   apply (auto simp:ex1 f_def THE_default1_equality)
    70   apply (rule THE_defaultI')
    71   apply (rule ex1)
    72   done
    73 
    74 lemma fundef_default_value:
    75   assumes f_def: "f == (\<lambda>x::'a. THE_default (d x) (\<lambda>y. G x y))"
    76   assumes graph: "\<And>x y. G x y \<Longrightarrow> D x"
    77   assumes "\<not> D x"
    78   shows "f x = d x"
    79 proof -
    80   have "\<not>(\<exists>y. G x y)"
    81   proof
    82     assume "\<exists>y. G x y"
    83     hence "D x" using graph ..
    84     with `\<not> D x` show False ..
    85   qed
    86   hence "\<not>(\<exists>!y. G x y)" by blast
    87 
    88   thus ?thesis
    89     unfolding f_def
    90     by (rule THE_default_none)
    91 qed
    92 
    93 definition in_rel_def[simp]:
    94   "in_rel R x y == (x, y) \<in> R"
    95 
    96 lemma wf_in_rel:
    97   "wf R \<Longrightarrow> wfP (in_rel R)"
    98   by (simp add: wfP_def)
    99 
   100 inductive is_measure :: "('a \<Rightarrow> nat) \<Rightarrow> bool"
   101 where is_measure_trivial: "is_measure f"
   102 
   103 use "Tools/function_package/fundef_lib.ML"
   104 use "Tools/function_package/fundef_common.ML"
   105 use "Tools/function_package/inductive_wrap.ML"
   106 use "Tools/function_package/context_tree.ML"
   107 use "Tools/function_package/fundef_core.ML"
   108 use "Tools/function_package/sum_tree.ML"
   109 use "Tools/function_package/mutual.ML"
   110 use "Tools/function_package/pattern_split.ML"
   111 use "Tools/function_package/auto_term.ML"
   112 use "Tools/function_package/fundef_package.ML"
   113 use "Tools/function_package/measure_functions.ML"
   114 use "Tools/function_package/lexicographic_order.ML"
   115 use "Tools/function_package/fundef_datatype.ML"
   116 use "Tools/function_package/induction_scheme.ML"
   117 
   118 setup {* 
   119   FundefPackage.setup 
   120   #> InductionScheme.setup
   121   #> MeasureFunctions.setup
   122   #> LexicographicOrder.setup 
   123   #> FundefDatatype.setup
   124 *}
   125 
   126 lemma let_cong [fundef_cong]:
   127   "M = N \<Longrightarrow> (\<And>x. x = N \<Longrightarrow> f x = g x) \<Longrightarrow> Let M f = Let N g"
   128   unfolding Let_def by blast
   129 
   130 lemmas [fundef_cong] =
   131   if_cong image_cong INT_cong UN_cong
   132   bex_cong ball_cong imp_cong
   133 
   134 lemma split_cong [fundef_cong]:
   135   "(\<And>x y. (x, y) = q \<Longrightarrow> f x y = g x y) \<Longrightarrow> p = q
   136     \<Longrightarrow> split f p = split g q"
   137   by (auto simp: split_def)
   138 
   139 lemma comp_cong [fundef_cong]:
   140   "f (g x) = f' (g' x') \<Longrightarrow> (f o g) x = (f' o g') x'"
   141   unfolding o_apply .
   142 
   143 subsection {* Setup for termination proofs *}
   144 
   145 text {* Rules for generating measure functions *}
   146 
   147 lemma [measure_function]: "is_measure size"
   148 by (rule is_measure_trivial)
   149 
   150 lemma [measure_function]: "is_measure f \<Longrightarrow> is_measure (\<lambda>p. f (fst p))"
   151 by (rule is_measure_trivial)
   152 lemma [measure_function]: "is_measure f \<Longrightarrow> is_measure (\<lambda>p. f (snd p))"
   153 by (rule is_measure_trivial)
   154 
   155 lemma termination_basic_simps[termination_simp]:
   156   "x < (y::nat) \<Longrightarrow> x < y + z" 
   157   "x < z \<Longrightarrow> x < y + z"
   158   "x \<le> y \<Longrightarrow> x \<le> y + (z::nat)"
   159   "x \<le> z \<Longrightarrow> x \<le> y + (z::nat)"
   160   "x < y \<Longrightarrow> x \<le> (y::nat)"
   161 by arith+
   162 
   163 declare le_imp_less_Suc[termination_simp]
   164 
   165 lemma prod_size_simp[termination_simp]:
   166   "prod_size f g p = f (fst p) + g (snd p) + Suc 0"
   167 by (induct p) auto
   168 
   169 
   170 end