wenzelm@20324: (*  Title:      HOL/FunDef.thy
wenzelm@20324:     ID:         $Id$
wenzelm@20324:     Author:     Alexander Krauss, TU Muenchen
wenzelm@20324: 
wenzelm@20324: A package for general recursive function definitions. 
wenzelm@20324: *)
wenzelm@20324: 
krauss@19564: theory FunDef
krauss@19770: imports Accessible_Part Datatype Recdef
krauss@19564: uses 
krauss@19770: ("Tools/function_package/sum_tools.ML")
krauss@19564: ("Tools/function_package/fundef_common.ML")
krauss@19564: ("Tools/function_package/fundef_lib.ML")
krauss@20523: ("Tools/function_package/inductive_wrap.ML")
krauss@19564: ("Tools/function_package/context_tree.ML")
krauss@19564: ("Tools/function_package/fundef_prep.ML")
krauss@19564: ("Tools/function_package/fundef_proof.ML")
krauss@19564: ("Tools/function_package/termination.ML")
krauss@19770: ("Tools/function_package/mutual.ML")
krauss@20270: ("Tools/function_package/pattern_split.ML")
krauss@19564: ("Tools/function_package/fundef_package.ML")
nipkow@21312: (*("Tools/function_package/fundef_datatype.ML")*)
krauss@19770: ("Tools/function_package/auto_term.ML")
krauss@19564: begin
krauss@19564: 
krauss@21051: section {* Wellfoundedness and Accessibility: Predicate versions *}
krauss@21051: 
krauss@21051: 
krauss@21051: constdefs
krauss@21051:   wfP         :: "('a \<Rightarrow> 'a \<Rightarrow> bool) => bool"
krauss@21051:   "wfP(r) == (!P. (!x. (!y. r y x --> P(y)) --> P(x)) --> (!x. P(x)))"
krauss@21051: 
krauss@21051: lemma wfP_induct: 
krauss@21051:     "[| wfP r;           
krauss@21051:         !!x.[| ALL y. r y x --> P(y) |] ==> P(x)  
krauss@21051:      |]  ==>  P(a)"
krauss@21051: by (unfold wfP_def, blast)
krauss@21051: 
krauss@21051: lemmas wfP_induct_rule = wfP_induct [rule_format, consumes 1, case_names less]
krauss@21051: 
krauss@21051: definition in_rel_def[simp]:
krauss@21051:   "in_rel R x y == (x, y) \<in> R"
krauss@21051: 
krauss@21051: lemma wf_in_rel:
krauss@21051:   "wf R \<Longrightarrow> wfP (in_rel R)"
krauss@21051:   unfolding wfP_def wf_def in_rel_def .
krauss@21051: 
krauss@21051: 
krauss@21051: inductive2 accP :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'a \<Rightarrow> bool"
krauss@21051:   for r :: "'a \<Rightarrow> 'a \<Rightarrow> bool"
wenzelm@21364: where
wenzelm@21364:   accPI: "(!!y. r y x ==> accP r y) ==> accP r x"
krauss@21051: 
krauss@21051: 
krauss@21051: theorem accP_induct:
krauss@21051:   assumes major: "accP r a"
krauss@21051:   assumes hyp: "!!x. accP r x ==> \<forall>y. r y x --> P y ==> P x"
krauss@21051:   shows "P a"
krauss@21051:   apply (rule major [THEN accP.induct])
krauss@21051:   apply (rule hyp)
krauss@21051:    apply (rule accPI)
krauss@21051:    apply fast
krauss@21051:   apply fast
krauss@21051:   done
krauss@21051: 
krauss@21051: theorems accP_induct_rule = accP_induct [rule_format, induct set: accP]
krauss@21051: 
krauss@21051: theorem accP_downward: "accP r b ==> r a b ==> accP r a"
krauss@21051:   apply (erule accP.cases)
krauss@21051:   apply fast
krauss@21051:   done
krauss@21051: 
krauss@21051: 
krauss@21051: lemma accP_subset:
krauss@21051:   assumes sub: "\<And>x y. R1 x y \<Longrightarrow> R2 x y"
krauss@21051:   shows "\<And>x. accP R2 x \<Longrightarrow> accP R1 x"
krauss@21051: proof-
krauss@21051:   fix x assume "accP R2 x"
krauss@21051:   then show "accP R1 x"
krauss@21051:   proof (induct x)
krauss@21051:     fix x
krauss@21051:     assume ih: "\<And>y. R2 y x \<Longrightarrow> accP R1 y"
krauss@21051:     with sub show "accP R1 x"
krauss@21051:       by (blast intro:accPI)
krauss@21051:   qed
krauss@21051: qed
krauss@21051: 
krauss@21051: 
krauss@21051: lemma accP_subset_induct:
krauss@21051:   assumes subset: "\<And>x. D x \<Longrightarrow> accP R x"
krauss@21051:     and dcl: "\<And>x z. \<lbrakk>D x; R z x\<rbrakk> \<Longrightarrow> D z"
krauss@21051:     and "D x"
krauss@21051:     and istep: "\<And>x. \<lbrakk>D x; (\<And>z. R z x \<Longrightarrow> P z)\<rbrakk> \<Longrightarrow> P x"
krauss@21051:   shows "P x"
krauss@21051: proof -
krauss@21051:   from subset and `D x` 
krauss@21051:   have "accP R x" .
krauss@21051:   then show "P x" using `D x`
krauss@21051:   proof (induct x)
krauss@21051:     fix x
krauss@21051:     assume "D x"
krauss@21051:       and "\<And>y. R y x \<Longrightarrow> D y \<Longrightarrow> P y"
krauss@21051:     with dcl and istep show "P x" by blast
krauss@21051:   qed
krauss@21051: qed
krauss@21051: 
krauss@21051: 
krauss@21051: section {* Definitions with default value *}
krauss@20536: 
krauss@20536: definition
wenzelm@21404:   THE_default :: "'a \<Rightarrow> ('a \<Rightarrow> bool) \<Rightarrow> 'a" where
krauss@20536:   "THE_default d P = (if (\<exists>!x. P x) then (THE x. P x) else d)"
krauss@20536: 
krauss@20536: lemma THE_defaultI': "\<exists>!x. P x \<Longrightarrow> P (THE_default d P)"
krauss@20536:   by (simp add:theI' THE_default_def)
krauss@20536: 
krauss@20536: lemma THE_default1_equality: 
krauss@20536:   "\<lbrakk>\<exists>!x. P x; P a\<rbrakk> \<Longrightarrow> THE_default d P = a"
krauss@20536:   by (simp add:the1_equality THE_default_def)
krauss@20536: 
krauss@20536: lemma THE_default_none:
krauss@20536:   "\<not>(\<exists>!x. P x) \<Longrightarrow> THE_default d P = d"
krauss@20536: by (simp add:THE_default_def)
krauss@20536: 
krauss@20536: 
krauss@19564: lemma fundef_ex1_existence:
krauss@21051: assumes f_def: "f == (\<lambda>x::'a. THE_default (d x) (\<lambda>y. G x y))"
krauss@21051: assumes ex1: "\<exists>!y. G x y"
krauss@21051: shows "G x (f x)"
krauss@20536:   by (simp only:f_def, rule THE_defaultI', rule ex1)
krauss@19564: 
krauss@21051: 
krauss@21051: 
krauss@21051: 
krauss@21051: 
krauss@19564: lemma fundef_ex1_uniqueness:
krauss@21051: assumes f_def: "f == (\<lambda>x::'a. THE_default (d x) (\<lambda>y. G x y))"
krauss@21051: assumes ex1: "\<exists>!y. G x y"
krauss@21051: assumes elm: "G x (h x)"
krauss@19564: shows "h x = f x"
krauss@20536:   by (simp only:f_def, rule THE_default1_equality[symmetric], rule ex1, rule elm)
krauss@19564: 
krauss@19564: lemma fundef_ex1_iff:
krauss@21051: assumes f_def: "f == (\<lambda>x::'a. THE_default (d x) (\<lambda>y. G x y))"
krauss@21051: assumes ex1: "\<exists>!y. G x y"
krauss@21051: shows "(G x y) = (f x = y)"
krauss@20536:   apply (auto simp:ex1 f_def THE_default1_equality)
krauss@20536:   by (rule THE_defaultI', rule ex1)
krauss@19564: 
krauss@20654: lemma fundef_default_value:
krauss@21051: assumes f_def: "f == (\<lambda>x::'a. THE_default (d x) (\<lambda>y. G x y))"
krauss@21051: assumes graph: "\<And>x y. G x y \<Longrightarrow> x \<in> D"
krauss@20654: assumes "x \<notin> D"
krauss@20654: shows "f x = d x"
krauss@20654: proof -
krauss@21051:   have "\<not>(\<exists>y. G x y)"
krauss@20654:   proof
krauss@21051:     assume "(\<exists>y. G x y)"
krauss@20654:     with graph and `x\<notin>D` show False by blast
krauss@20654:   qed
krauss@21051:   hence "\<not>(\<exists>!y. G x y)" by blast
krauss@20654:   
krauss@20654:   thus ?thesis
krauss@20654:     unfolding f_def
krauss@20654:     by (rule THE_default_none)
krauss@20654: qed
krauss@20654: 
krauss@20654: 
krauss@20654: 
krauss@21051: section {* Projections *}
krauss@19770: consts
krauss@19770:   lpg::"(('a + 'b) * 'a) set"
krauss@19770:   rpg::"(('a + 'b) * 'b) set"
krauss@19770: 
krauss@19770: inductive lpg
krauss@19770: intros
krauss@19770:   "(Inl x, x) : lpg"
krauss@19770: inductive rpg
krauss@19770: intros
krauss@19770:   "(Inr y, y) : rpg"
wenzelm@21404: 
wenzelm@21404: definition "lproj x = (THE y. (x,y) : lpg)"
wenzelm@21404: definition "rproj x = (THE y. (x,y) : rpg)"
krauss@19770: 
krauss@19770: lemma lproj_inl:
krauss@19770:   "lproj (Inl x) = x"
krauss@19770:   by (auto simp:lproj_def intro: the_equality lpg.intros elim: lpg.cases)
krauss@19770: lemma rproj_inr:
krauss@19770:   "rproj (Inr x) = x"
krauss@19770:   by (auto simp:rproj_def intro: the_equality rpg.intros elim: rpg.cases)
krauss@19770: 
krauss@19770: use "Tools/function_package/sum_tools.ML"
krauss@19564: use "Tools/function_package/fundef_common.ML"
krauss@19564: use "Tools/function_package/fundef_lib.ML"
krauss@20523: use "Tools/function_package/inductive_wrap.ML"
krauss@19564: use "Tools/function_package/context_tree.ML"
krauss@19564: use "Tools/function_package/fundef_prep.ML"
krauss@19564: use "Tools/function_package/fundef_proof.ML"
krauss@19564: use "Tools/function_package/termination.ML"
krauss@19770: use "Tools/function_package/mutual.ML"
krauss@20270: use "Tools/function_package/pattern_split.ML"
krauss@21319: use "Tools/function_package/auto_term.ML"
krauss@19564: use "Tools/function_package/fundef_package.ML"
krauss@19564: 
krauss@19564: setup FundefPackage.setup
krauss@19770: 
krauss@19770: lemmas [fundef_cong] = 
krauss@19770:   let_cong if_cong image_cong INT_cong UN_cong bex_cong ball_cong imp_cong
krauss@19564: 
krauss@19564: 
krauss@19934: lemma split_cong[fundef_cong]:
krauss@19934:   "\<lbrakk> \<And>x y. (x, y) = q \<Longrightarrow> f x y = g x y; p = q \<rbrakk> 
krauss@19934:   \<Longrightarrow> split f p = split g q"
krauss@19934:   by (auto simp:split_def)
krauss@19934: 
krauss@19934: 
krauss@19564: end