src/HOL/FunDef.thy
author krauss
Thu Sep 21 12:22:05 2006 +0200 (2006-09-21)
changeset 20654 d80502f0d701
parent 20536 f088edff8af8
child 21051 c49467a9c1e1
permissions -rw-r--r--
1. Function package accepts a parameter (default "some_term"), which specifies the functions
behaviour outside its domain.
2. Bugfix: An exception occured when a function in a mutual definition
was declared but no equation was given.
wenzelm@20324
     1
(*  Title:      HOL/FunDef.thy
wenzelm@20324
     2
    ID:         $Id$
wenzelm@20324
     3
    Author:     Alexander Krauss, TU Muenchen
wenzelm@20324
     4
wenzelm@20324
     5
A package for general recursive function definitions. 
wenzelm@20324
     6
*)
wenzelm@20324
     7
krauss@19564
     8
theory FunDef
krauss@19770
     9
imports Accessible_Part Datatype Recdef
krauss@19564
    10
uses 
krauss@19770
    11
("Tools/function_package/sum_tools.ML")
krauss@19564
    12
("Tools/function_package/fundef_common.ML")
krauss@19564
    13
("Tools/function_package/fundef_lib.ML")
krauss@20523
    14
("Tools/function_package/inductive_wrap.ML")
krauss@19564
    15
("Tools/function_package/context_tree.ML")
krauss@19564
    16
("Tools/function_package/fundef_prep.ML")
krauss@19564
    17
("Tools/function_package/fundef_proof.ML")
krauss@19564
    18
("Tools/function_package/termination.ML")
krauss@19770
    19
("Tools/function_package/mutual.ML")
krauss@20270
    20
("Tools/function_package/pattern_split.ML")
krauss@19564
    21
("Tools/function_package/fundef_package.ML")
krauss@19770
    22
("Tools/function_package/fundef_datatype.ML")
krauss@19770
    23
("Tools/function_package/auto_term.ML")
krauss@19564
    24
begin
krauss@19564
    25
krauss@20536
    26
krauss@20536
    27
definition
krauss@20536
    28
  THE_default :: "'a \<Rightarrow> ('a \<Rightarrow> bool) \<Rightarrow> 'a"
krauss@20536
    29
  "THE_default d P = (if (\<exists>!x. P x) then (THE x. P x) else d)"
krauss@20536
    30
krauss@20536
    31
lemma THE_defaultI': "\<exists>!x. P x \<Longrightarrow> P (THE_default d P)"
krauss@20536
    32
  by (simp add:theI' THE_default_def)
krauss@20536
    33
krauss@20536
    34
lemma THE_default1_equality: 
krauss@20536
    35
  "\<lbrakk>\<exists>!x. P x; P a\<rbrakk> \<Longrightarrow> THE_default d P = a"
krauss@20536
    36
  by (simp add:the1_equality THE_default_def)
krauss@20536
    37
krauss@20536
    38
lemma THE_default_none:
krauss@20536
    39
  "\<not>(\<exists>!x. P x) \<Longrightarrow> THE_default d P = d"
krauss@20536
    40
by (simp add:THE_default_def)
krauss@20536
    41
krauss@20536
    42
krauss@19564
    43
lemma fundef_ex1_existence:
krauss@20654
    44
assumes f_def: "f \<equiv> \<lambda>x. THE_default (d x) (\<lambda>y. (x,y)\<in>G)"
krauss@19564
    45
assumes ex1: "\<exists>!y. (x,y)\<in>G"
krauss@19564
    46
shows "(x, f x)\<in>G"
krauss@20536
    47
  by (simp only:f_def, rule THE_defaultI', rule ex1)
krauss@19564
    48
krauss@19564
    49
lemma fundef_ex1_uniqueness:
krauss@20654
    50
assumes f_def: "f \<equiv> \<lambda>x. THE_default (d x) (\<lambda>y. (x,y)\<in>G)"
krauss@19564
    51
assumes ex1: "\<exists>!y. (x,y)\<in>G"
krauss@19564
    52
assumes elm: "(x, h x)\<in>G"
krauss@19564
    53
shows "h x = f x"
krauss@20536
    54
  by (simp only:f_def, rule THE_default1_equality[symmetric], rule ex1, rule elm)
krauss@19564
    55
krauss@19564
    56
lemma fundef_ex1_iff:
krauss@20654
    57
assumes f_def: "f \<equiv> \<lambda>x. THE_default (d x) (\<lambda>y. (x,y)\<in>G)"
krauss@19564
    58
assumes ex1: "\<exists>!y. (x,y)\<in>G"
krauss@19564
    59
shows "((x, y)\<in>G) = (f x = y)"
krauss@20536
    60
  apply (auto simp:ex1 f_def THE_default1_equality)
krauss@20536
    61
  by (rule THE_defaultI', rule ex1)
krauss@19564
    62
krauss@20654
    63
lemma fundef_default_value:
krauss@20654
    64
assumes f_def: "f \<equiv> \<lambda>x. THE_default (d x) (\<lambda>y. (x,y)\<in>G)"
krauss@20654
    65
assumes graph: "\<And>x y. (x,y) \<in> G \<Longrightarrow> x \<in> D"
krauss@20654
    66
assumes "x \<notin> D"
krauss@20654
    67
shows "f x = d x"
krauss@20654
    68
proof -
krauss@20654
    69
  have "\<not>(\<exists>y. (x, y) \<in> G)"
krauss@20654
    70
  proof
krauss@20654
    71
    assume "(\<exists>y. (x, y) \<in> G)"
krauss@20654
    72
    with graph and `x\<notin>D` show False by blast
krauss@20654
    73
  qed
krauss@20654
    74
  hence "\<not>(\<exists>!y. (x, y) \<in> G)" by blast
krauss@20654
    75
  
krauss@20654
    76
  thus ?thesis
krauss@20654
    77
    unfolding f_def
krauss@20654
    78
    by (rule THE_default_none)
krauss@20654
    79
qed
krauss@20654
    80
krauss@20654
    81
krauss@20654
    82
krauss@19564
    83
krauss@19770
    84
subsection {* Projections *}
krauss@19770
    85
consts
krauss@19770
    86
  lpg::"(('a + 'b) * 'a) set"
krauss@19770
    87
  rpg::"(('a + 'b) * 'b) set"
krauss@19770
    88
krauss@19770
    89
inductive lpg
krauss@19770
    90
intros
krauss@19770
    91
  "(Inl x, x) : lpg"
krauss@19770
    92
inductive rpg
krauss@19770
    93
intros
krauss@19770
    94
  "(Inr y, y) : rpg"
krauss@19770
    95
definition
krauss@19770
    96
  "lproj x = (THE y. (x,y) : lpg)"
krauss@19770
    97
  "rproj x = (THE y. (x,y) : rpg)"
krauss@19770
    98
krauss@19770
    99
lemma lproj_inl:
krauss@19770
   100
  "lproj (Inl x) = x"
krauss@19770
   101
  by (auto simp:lproj_def intro: the_equality lpg.intros elim: lpg.cases)
krauss@19770
   102
lemma rproj_inr:
krauss@19770
   103
  "rproj (Inr x) = x"
krauss@19770
   104
  by (auto simp:rproj_def intro: the_equality rpg.intros elim: rpg.cases)
krauss@19770
   105
krauss@19770
   106
krauss@19770
   107
krauss@19770
   108
krauss@19770
   109
use "Tools/function_package/sum_tools.ML"
krauss@19564
   110
use "Tools/function_package/fundef_common.ML"
krauss@19564
   111
use "Tools/function_package/fundef_lib.ML"
krauss@20523
   112
use "Tools/function_package/inductive_wrap.ML"
krauss@19564
   113
use "Tools/function_package/context_tree.ML"
krauss@19564
   114
use "Tools/function_package/fundef_prep.ML"
krauss@19564
   115
use "Tools/function_package/fundef_proof.ML"
krauss@19564
   116
use "Tools/function_package/termination.ML"
krauss@19770
   117
use "Tools/function_package/mutual.ML"
krauss@20270
   118
use "Tools/function_package/pattern_split.ML"
krauss@19564
   119
use "Tools/function_package/fundef_package.ML"
krauss@19564
   120
krauss@19564
   121
setup FundefPackage.setup
krauss@19564
   122
krauss@19770
   123
use "Tools/function_package/fundef_datatype.ML"
krauss@19770
   124
setup FundefDatatype.setup
krauss@19770
   125
krauss@19770
   126
use "Tools/function_package/auto_term.ML"
krauss@19770
   127
setup FundefAutoTerm.setup
krauss@19770
   128
krauss@19770
   129
krauss@19770
   130
lemmas [fundef_cong] = 
krauss@19770
   131
  let_cong if_cong image_cong INT_cong UN_cong bex_cong ball_cong imp_cong
krauss@19564
   132
krauss@19564
   133
krauss@19934
   134
lemma split_cong[fundef_cong]:
krauss@19934
   135
  "\<lbrakk> \<And>x y. (x, y) = q \<Longrightarrow> f x y = g x y; p = q \<rbrakk> 
krauss@19934
   136
  \<Longrightarrow> split f p = split g q"
krauss@19934
   137
  by (auto simp:split_def)
krauss@19934
   138
krauss@19934
   139
krauss@19564
   140
end