got rid of the dependency of Lifting_* on the function package; use the original rel constants for basic BNFs;
authortraytel
Tue Aug 13 18:22:55 2013 +0200 (2013-08-13)
changeset 53026e1a548c11845
parent 53025 c820c9e9e8f4
child 53027 1774d569b604
got rid of the dependency of Lifting_* on the function package; use the original rel constants for basic BNFs;
src/HOL/BNF/Basic_BNFs.thy
src/HOL/BNF/Examples/Process.thy
src/HOL/BNF/More_BNFs.thy
src/HOL/Library/Mapping.thy
src/HOL/Library/Quotient_Option.thy
src/HOL/Library/Quotient_Sum.thy
src/HOL/Lifting_Option.thy
src/HOL/Lifting_Sum.thy
     1.1 --- a/src/HOL/BNF/Basic_BNFs.thy	Wed Aug 14 00:15:03 2013 +0200
     1.2 +++ b/src/HOL/BNF/Basic_BNFs.thy	Tue Aug 13 18:22:55 2013 +0200
     1.3 @@ -48,11 +48,6 @@
     1.4  
     1.5  lemmas sum_set_defs = setl_def[abs_def] setr_def[abs_def]
     1.6  
     1.7 -definition sum_rel :: "('a \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> ('c \<Rightarrow> 'd \<Rightarrow> bool) \<Rightarrow> 'a + 'c \<Rightarrow> 'b + 'd \<Rightarrow> bool" where
     1.8 -"sum_rel \<phi> \<psi> x y =
     1.9 - (case x of Inl a1 \<Rightarrow> (case y of Inl a2 \<Rightarrow> \<phi> a1 a2 | Inr _ \<Rightarrow> False)
    1.10 -          | Inr b1 \<Rightarrow> (case y of Inl _ \<Rightarrow> False | Inr b2 \<Rightarrow> \<psi> b1 b2))"
    1.11 -
    1.12  bnf sum_map [setl, setr] "\<lambda>_::'a + 'b. natLeq" [Inl, Inr] sum_rel
    1.13  proof -
    1.14    show "sum_map id id = id" by (rule sum_map.id)
    1.15 @@ -153,9 +148,6 @@
    1.16  
    1.17  lemmas prod_set_defs = fsts_def[abs_def] snds_def[abs_def]
    1.18  
    1.19 -definition prod_rel :: "('a \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> ('c \<Rightarrow> 'd \<Rightarrow> bool) \<Rightarrow> 'a \<times> 'c \<Rightarrow> 'b \<times> 'd \<Rightarrow> bool" where
    1.20 -"prod_rel \<phi> \<psi> p1 p2 = (case p1 of (a1, b1) \<Rightarrow> case p2 of (a2, b2) \<Rightarrow> \<phi> a1 a2 \<and> \<psi> b1 b2)"
    1.21 -
    1.22  bnf map_pair [fsts, snds] "\<lambda>_::'a \<times> 'b. natLeq" [Pair] prod_rel
    1.23  proof (unfold prod_set_defs)
    1.24    show "map_pair id id = id" by (rule map_pair.id)
     2.1 --- a/src/HOL/BNF/Examples/Process.thy	Wed Aug 14 00:15:03 2013 +0200
     2.2 +++ b/src/HOL/BNF/Examples/Process.thy	Tue Aug 13 18:22:55 2013 +0200
     2.3 @@ -11,8 +11,6 @@
     2.4  imports "../BNF"
     2.5  begin
     2.6  
     2.7 -hide_fact (open) Lifting_Product.prod_rel_def
     2.8 -
     2.9  codatatype 'a process =
    2.10    isAction: Action (prefOf: 'a) (contOf: "'a process") |
    2.11    isChoice: Choice (ch1Of: "'a process") (ch2Of: "'a process")
     3.1 --- a/src/HOL/BNF/More_BNFs.thy	Wed Aug 14 00:15:03 2013 +0200
     3.2 +++ b/src/HOL/BNF/More_BNFs.thy	Tue Aug 13 18:22:55 2013 +0200
     3.3 @@ -68,7 +68,7 @@
     3.4    show "option_rel R =
     3.5          (Grp {x. Option.set x \<subseteq> Collect (split R)} (Option.map fst))\<inverse>\<inverse> OO
     3.6           Grp {x. Option.set x \<subseteq> Collect (split R)} (Option.map snd)"
     3.7 -  unfolding option_rel_unfold Grp_def relcompp.simps conversep.simps fun_eq_iff prod.cases
     3.8 +  unfolding option_rel_def Grp_def relcompp.simps conversep.simps fun_eq_iff prod.cases
     3.9    by (auto simp: trans[OF eq_commute option_map_is_None] trans[OF eq_commute option_map_eq_Some]
    3.10             split: option.splits)
    3.11  qed
     4.1 --- a/src/HOL/Library/Mapping.thy	Wed Aug 14 00:15:03 2013 +0200
     4.2 +++ b/src/HOL/Library/Mapping.thy	Tue Aug 13 18:22:55 2013 +0200
     4.3 @@ -33,7 +33,7 @@
     4.4  definition equal_None :: "'a option \<Rightarrow> bool" where "equal_None x \<equiv> x = None"
     4.5  
     4.6  lemma [transfer_rule]: "(option_rel A ===> op=) equal_None equal_None" 
     4.7 -unfolding fun_rel_def option_rel_unfold equal_None_def by (auto split: option.split)
     4.8 +unfolding fun_rel_def option_rel_def equal_None_def by (auto split: option.split)
     4.9  
    4.10  lemma dom_transfer:
    4.11    assumes [transfer_rule]: "bi_total A"
     5.1 --- a/src/HOL/Library/Quotient_Option.thy	Wed Aug 14 00:15:03 2013 +0200
     5.2 +++ b/src/HOL/Library/Quotient_Option.thy	Tue Aug 13 18:22:55 2013 +0200
     5.3 @@ -12,11 +12,11 @@
     5.4  
     5.5  lemma option_rel_map1:
     5.6    "option_rel R (Option.map f x) y \<longleftrightarrow> option_rel (\<lambda>x. R (f x)) x y"
     5.7 -  by (simp add: option_rel_unfold split: option.split)
     5.8 +  by (simp add: option_rel_def split: option.split)
     5.9  
    5.10  lemma option_rel_map2:
    5.11    "option_rel R x (Option.map f y) \<longleftrightarrow> option_rel (\<lambda>x y. R x (f y)) x y"
    5.12 -  by (simp add: option_rel_unfold split: option.split)
    5.13 +  by (simp add: option_rel_def split: option.split)
    5.14  
    5.15  lemma option_map_id [id_simps]:
    5.16    "Option.map id = id"
    5.17 @@ -24,15 +24,15 @@
    5.18  
    5.19  lemma option_rel_eq [id_simps]:
    5.20    "option_rel (op =) = (op =)"
    5.21 -  by (simp add: option_rel_unfold fun_eq_iff split: option.split)
    5.22 +  by (simp add: option_rel_def fun_eq_iff split: option.split)
    5.23  
    5.24  lemma option_symp:
    5.25    "symp R \<Longrightarrow> symp (option_rel R)"
    5.26 -  unfolding symp_def split_option_all option_rel.simps by fast
    5.27 +  unfolding symp_def split_option_all option_rel_simps by fast
    5.28  
    5.29  lemma option_transp:
    5.30    "transp R \<Longrightarrow> transp (option_rel R)"
    5.31 -  unfolding transp_def split_option_all option_rel.simps by fast
    5.32 +  unfolding transp_def split_option_all option_rel_simps by fast
    5.33  
    5.34  lemma option_equivp [quot_equiv]:
    5.35    "equivp R \<Longrightarrow> equivp (option_rel R)"
    5.36 @@ -44,7 +44,7 @@
    5.37    apply (rule Quotient3I)
    5.38    apply (simp_all add: Option.map.compositionality comp_def Option.map.identity option_rel_eq option_rel_map1 option_rel_map2 Quotient3_abs_rep [OF assms] Quotient3_rel_rep [OF assms])
    5.39    using Quotient3_rel [OF assms]
    5.40 -  apply (simp add: option_rel_unfold split: option.split)
    5.41 +  apply (simp add: option_rel_def split: option.split)
    5.42    done
    5.43  
    5.44  declare [[mapQ3 option = (option_rel, option_quotient)]]
     6.1 --- a/src/HOL/Library/Quotient_Sum.thy	Wed Aug 14 00:15:03 2013 +0200
     6.2 +++ b/src/HOL/Library/Quotient_Sum.thy	Tue Aug 13 18:22:55 2013 +0200
     6.3 @@ -12,11 +12,11 @@
     6.4  
     6.5  lemma sum_rel_map1:
     6.6    "sum_rel R1 R2 (sum_map f1 f2 x) y \<longleftrightarrow> sum_rel (\<lambda>x. R1 (f1 x)) (\<lambda>x. R2 (f2 x)) x y"
     6.7 -  by (simp add: sum_rel_unfold split: sum.split)
     6.8 +  by (simp add: sum_rel_def split: sum.split)
     6.9  
    6.10  lemma sum_rel_map2:
    6.11    "sum_rel R1 R2 x (sum_map f1 f2 y) \<longleftrightarrow> sum_rel (\<lambda>x y. R1 x (f1 y)) (\<lambda>x y. R2 x (f2 y)) x y"
    6.12 -  by (simp add: sum_rel_unfold split: sum.split)
    6.13 +  by (simp add: sum_rel_def split: sum.split)
    6.14  
    6.15  lemma sum_map_id [id_simps]:
    6.16    "sum_map id id = id"
    6.17 @@ -24,15 +24,15 @@
    6.18  
    6.19  lemma sum_rel_eq [id_simps]:
    6.20    "sum_rel (op =) (op =) = (op =)"
    6.21 -  by (simp add: sum_rel_unfold fun_eq_iff split: sum.split)
    6.22 +  by (simp add: sum_rel_def fun_eq_iff split: sum.split)
    6.23  
    6.24  lemma sum_symp:
    6.25    "symp R1 \<Longrightarrow> symp R2 \<Longrightarrow> symp (sum_rel R1 R2)"
    6.26 -  unfolding symp_def split_sum_all sum_rel.simps by fast
    6.27 +  unfolding symp_def split_sum_all sum_rel_simps by fast
    6.28  
    6.29  lemma sum_transp:
    6.30    "transp R1 \<Longrightarrow> transp R2 \<Longrightarrow> transp (sum_rel R1 R2)"
    6.31 -  unfolding transp_def split_sum_all sum_rel.simps by fast
    6.32 +  unfolding transp_def split_sum_all sum_rel_simps by fast
    6.33  
    6.34  lemma sum_equivp [quot_equiv]:
    6.35    "equivp R1 \<Longrightarrow> equivp R2 \<Longrightarrow> equivp (sum_rel R1 R2)"
    6.36 @@ -46,7 +46,7 @@
    6.37    apply (simp_all add: sum_map.compositionality comp_def sum_map.identity sum_rel_eq sum_rel_map1 sum_rel_map2
    6.38      Quotient3_abs_rep [OF q1] Quotient3_rel_rep [OF q1] Quotient3_abs_rep [OF q2] Quotient3_rel_rep [OF q2])
    6.39    using Quotient3_rel [OF q1] Quotient3_rel [OF q2]
    6.40 -  apply (simp add: sum_rel_unfold comp_def split: sum.split)
    6.41 +  apply (simp add: sum_rel_def comp_def split: sum.split)
    6.42    done
    6.43  
    6.44  declare [[mapQ3 sum = (sum_rel, sum_quotient)]]
     7.1 --- a/src/HOL/Lifting_Option.thy	Wed Aug 14 00:15:03 2013 +0200
     7.2 +++ b/src/HOL/Lifting_Option.thy	Tue Aug 13 18:22:55 2013 +0200
     7.3 @@ -5,52 +5,45 @@
     7.4  header {* Setup for Lifting/Transfer for the option type *}
     7.5  
     7.6  theory Lifting_Option
     7.7 -imports Lifting FunDef
     7.8 +imports Lifting
     7.9  begin
    7.10  
    7.11  subsection {* Relator and predicator properties *}
    7.12  
    7.13 -fun
    7.14 +definition
    7.15    option_rel :: "('a \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> 'a option \<Rightarrow> 'b option \<Rightarrow> bool"
    7.16  where
    7.17 -  "option_rel R None None = True"
    7.18 -| "option_rel R (Some x) None = False"
    7.19 -| "option_rel R None (Some x) = False"
    7.20 -| "option_rel R (Some x) (Some y) = R x y"
    7.21 -
    7.22 -lemma option_rel_unfold:
    7.23    "option_rel R x y = (case (x, y) of (None, None) \<Rightarrow> True
    7.24      | (Some x, Some y) \<Rightarrow> R x y
    7.25      | _ \<Rightarrow> False)"
    7.26 -  by (cases x) (cases y, simp_all)+
    7.27  
    7.28 -fun option_pred :: "('a \<Rightarrow> bool) \<Rightarrow> 'a option \<Rightarrow> bool"
    7.29 -where
    7.30 -  "option_pred R None = True"
    7.31 -| "option_pred R (Some x) = R x"
    7.32 +lemma option_rel_simps[simp]:
    7.33 +  "option_rel R None None = True"
    7.34 +  "option_rel R (Some x) None = False"
    7.35 +  "option_rel R None (Some y) = False"
    7.36 +  "option_rel R (Some x) (Some y) = R x y"
    7.37 +  unfolding option_rel_def by simp_all
    7.38  
    7.39 -lemma option_pred_unfold:
    7.40 -  "option_pred P x = (case x of None \<Rightarrow> True
    7.41 -    | Some x \<Rightarrow> P x)"
    7.42 -by (cases x) simp_all
    7.43 +abbreviation (input) option_pred :: "('a \<Rightarrow> bool) \<Rightarrow> 'a option \<Rightarrow> bool" where
    7.44 +  "option_pred \<equiv> option_case True"
    7.45  
    7.46  lemma option_rel_eq [relator_eq]:
    7.47    "option_rel (op =) = (op =)"
    7.48 -  by (simp add: option_rel_unfold fun_eq_iff split: option.split)
    7.49 +  by (simp add: option_rel_def fun_eq_iff split: option.split)
    7.50  
    7.51  lemma option_rel_mono[relator_mono]:
    7.52    assumes "A \<le> B"
    7.53    shows "(option_rel A) \<le> (option_rel B)"
    7.54 -using assms by (auto simp: option_rel_unfold split: option.splits)
    7.55 +using assms by (auto simp: option_rel_def split: option.splits)
    7.56  
    7.57  lemma option_rel_OO[relator_distr]:
    7.58    "(option_rel A) OO (option_rel B) = option_rel (A OO B)"
    7.59 -by (rule ext)+ (auto simp: option_rel_unfold OO_def split: option.split)
    7.60 +by (rule ext)+ (auto simp: option_rel_def OO_def split: option.split)
    7.61  
    7.62  lemma Domainp_option[relator_domain]:
    7.63    assumes "Domainp A = P"
    7.64    shows "Domainp (option_rel A) = (option_pred P)"
    7.65 -using assms unfolding Domainp_iff[abs_def] option_rel_unfold[abs_def] option_pred_unfold[abs_def]
    7.66 +using assms unfolding Domainp_iff[abs_def] option_rel_def[abs_def]
    7.67  by (auto iff: fun_eq_iff split: option.split)
    7.68  
    7.69  lemma reflp_option_rel[reflexivity_rule]:
    7.70 @@ -91,7 +84,7 @@
    7.71    assumes "Quotient R Abs Rep T"
    7.72    shows "Quotient (option_rel R) (Option.map Abs)
    7.73      (Option.map Rep) (option_rel T)"
    7.74 -  using assms unfolding Quotient_alt_def option_rel_unfold
    7.75 +  using assms unfolding Quotient_alt_def option_rel_def
    7.76    by (simp split: option.split)
    7.77  
    7.78  subsection {* Transfer rules for the Transfer package *}
     8.1 --- a/src/HOL/Lifting_Sum.thy	Wed Aug 14 00:15:03 2013 +0200
     8.2 +++ b/src/HOL/Lifting_Sum.thy	Tue Aug 13 18:22:55 2013 +0200
     8.3 @@ -5,59 +5,52 @@
     8.4  header {* Setup for Lifting/Transfer for the sum type *}
     8.5  
     8.6  theory Lifting_Sum
     8.7 -imports Lifting FunDef
     8.8 +imports Lifting
     8.9  begin
    8.10  
    8.11  subsection {* Relator and predicator properties *}
    8.12  
    8.13 -fun
    8.14 -  sum_rel :: "('a \<Rightarrow> 'c \<Rightarrow> bool) \<Rightarrow> ('b \<Rightarrow> 'd \<Rightarrow> bool) \<Rightarrow> 'a + 'b \<Rightarrow> 'c + 'd \<Rightarrow> bool"
    8.15 +definition
    8.16 +   sum_rel :: "('a \<Rightarrow> 'c \<Rightarrow> bool) \<Rightarrow> ('b \<Rightarrow> 'd \<Rightarrow> bool) \<Rightarrow> 'a + 'b \<Rightarrow> 'c + 'd \<Rightarrow> bool"
    8.17  where
    8.18 -  "sum_rel R1 R2 (Inl a1) (Inl b1) = R1 a1 b1"
    8.19 -| "sum_rel R1 R2 (Inl a1) (Inr b2) = False"
    8.20 -| "sum_rel R1 R2 (Inr a2) (Inl b1) = False"
    8.21 -| "sum_rel R1 R2 (Inr a2) (Inr b2) = R2 a2 b2"
    8.22 +   "sum_rel R1 R2 x y =
    8.23 +     (case (x, y) of (Inl x, Inl y) \<Rightarrow> R1 x y
    8.24 +     | (Inr x, Inr y) \<Rightarrow> R2 x y
    8.25 +     | _ \<Rightarrow> False)"
    8.26  
    8.27 -lemma sum_rel_unfold:
    8.28 -  "sum_rel R1 R2 x y = (case (x, y) of (Inl x, Inl y) \<Rightarrow> R1 x y
    8.29 -    | (Inr x, Inr y) \<Rightarrow> R2 x y
    8.30 -    | _ \<Rightarrow> False)"
    8.31 -  by (cases x) (cases y, simp_all)+
    8.32 +lemma sum_rel_simps[simp]:
    8.33 +  "sum_rel R1 R2 (Inl a1) (Inl b1) = R1 a1 b1"
    8.34 +  "sum_rel R1 R2 (Inl a1) (Inr b2) = False"
    8.35 +  "sum_rel R1 R2 (Inr a2) (Inl b1) = False"
    8.36 +  "sum_rel R1 R2 (Inr a2) (Inr b2) = R2 a2 b2"
    8.37 +  unfolding sum_rel_def by simp_all
    8.38  
    8.39 -fun sum_pred :: "('a \<Rightarrow> bool) \<Rightarrow> ('b \<Rightarrow> bool) \<Rightarrow> 'a + 'b \<Rightarrow> bool"
    8.40 -where
    8.41 -  "sum_pred P1 P2 (Inl a) = P1 a"
    8.42 -| "sum_pred P1 P2 (Inr a) = P2 a"
    8.43 -
    8.44 -lemma sum_pred_unfold:
    8.45 -  "sum_pred P1 P2 x = (case x of Inl x \<Rightarrow> P1 x
    8.46 -    | Inr x \<Rightarrow> P2 x)"
    8.47 -by (cases x) simp_all
    8.48 +abbreviation (input) "sum_pred \<equiv> sum_case"
    8.49  
    8.50  lemma sum_rel_eq [relator_eq]:
    8.51    "sum_rel (op =) (op =) = (op =)"
    8.52 -  by (simp add: sum_rel_unfold fun_eq_iff split: sum.split)
    8.53 +  by (simp add: sum_rel_def fun_eq_iff split: sum.split)
    8.54  
    8.55  lemma sum_rel_mono[relator_mono]:
    8.56    assumes "A \<le> C"
    8.57    assumes "B \<le> D"
    8.58    shows "(sum_rel A B) \<le> (sum_rel C D)"
    8.59 -using assms by (auto simp: sum_rel_unfold split: sum.splits)
    8.60 +using assms by (auto simp: sum_rel_def split: sum.splits)
    8.61  
    8.62  lemma sum_rel_OO[relator_distr]:
    8.63    "(sum_rel A B) OO (sum_rel C D) = sum_rel (A OO C) (B OO D)"
    8.64 -by (rule ext)+ (auto simp add: sum_rel_unfold OO_def split_sum_ex split: sum.split)
    8.65 +by (rule ext)+ (auto simp add: sum_rel_def OO_def split_sum_ex split: sum.split)
    8.66  
    8.67  lemma Domainp_sum[relator_domain]:
    8.68    assumes "Domainp R1 = P1"
    8.69    assumes "Domainp R2 = P2"
    8.70    shows "Domainp (sum_rel R1 R2) = (sum_pred P1 P2)"
    8.71  using assms
    8.72 -by (auto simp add: Domainp_iff split_sum_ex sum_pred_unfold iff: fun_eq_iff split: sum.split)
    8.73 +by (auto simp add: Domainp_iff split_sum_ex iff: fun_eq_iff split: sum.split)
    8.74  
    8.75  lemma reflp_sum_rel[reflexivity_rule]:
    8.76    "reflp R1 \<Longrightarrow> reflp R2 \<Longrightarrow> reflp (sum_rel R1 R2)"
    8.77 -  unfolding reflp_def split_sum_all sum_rel.simps by fast
    8.78 +  unfolding reflp_def split_sum_all sum_rel_simps by fast
    8.79  
    8.80  lemma left_total_sum_rel[reflexivity_rule]:
    8.81    "left_total R1 \<Longrightarrow> left_total R2 \<Longrightarrow> left_total (sum_rel R1 R2)"
    8.82 @@ -85,7 +78,7 @@
    8.83  
    8.84  lemma sum_invariant_commute [invariant_commute]: 
    8.85    "sum_rel (Lifting.invariant P1) (Lifting.invariant P2) = Lifting.invariant (sum_pred P1 P2)"
    8.86 -  by (auto simp add: fun_eq_iff Lifting.invariant_def sum_rel_unfold sum_pred_unfold split: sum.split)
    8.87 +  by (auto simp add: fun_eq_iff Lifting.invariant_def sum_rel_def split: sum.split)
    8.88  
    8.89  subsection {* Quotient theorem for the Lifting package *}
    8.90  
    8.91 @@ -111,7 +104,7 @@
    8.92  
    8.93  lemma sum_case_transfer [transfer_rule]:
    8.94    "((A ===> C) ===> (B ===> C) ===> sum_rel A B ===> C) sum_case sum_case"
    8.95 -  unfolding fun_rel_def sum_rel_unfold by (simp split: sum.split)
    8.96 +  unfolding fun_rel_def sum_rel_def by (simp split: sum.split)
    8.97  
    8.98  end
    8.99