src/HOL/Nominal/Nominal.thy
changeset 44835 ff6b9eb9c5ef
parent 44833 9c6bd6204143
child 44838 096ec174be5d
equal deleted inserted replaced
44758:deb929f002b8 44835:ff6b9eb9c5ef
    49   perm_noption \<equiv> "perm :: 'x prm \<Rightarrow> 'a noption \<Rightarrow> 'a noption"   (unchecked)
    49   perm_noption \<equiv> "perm :: 'x prm \<Rightarrow> 'a noption \<Rightarrow> 'a noption"   (unchecked)
    50   perm_nprod   \<equiv> "perm :: 'x prm \<Rightarrow> ('a, 'b) nprod \<Rightarrow> ('a, 'b) nprod" (unchecked)
    50   perm_nprod   \<equiv> "perm :: 'x prm \<Rightarrow> ('a, 'b) nprod \<Rightarrow> ('a, 'b) nprod" (unchecked)
    51 begin
    51 begin
    52 
    52 
    53 definition
    53 definition
    54   perm_fun_def: "perm_fun pi (f::'a\<Rightarrow>'b) = (\<lambda>x. pi\<bullet>f((rev pi)\<bullet>x))"
    54   "perm_fun pi f = (\<lambda>x. pi \<bullet> f (rev pi \<bullet> x))"
    55 
    55 
    56 definition perm_bool :: "'x prm \<Rightarrow> bool \<Rightarrow> bool" where
    56 definition perm_bool :: "'x prm \<Rightarrow> bool \<Rightarrow> bool" where
    57   perm_bool_def: "perm_bool pi b = b"
    57   "perm_bool pi b = b"
    58 
    58 
    59 primrec perm_unit :: "'x prm \<Rightarrow> unit \<Rightarrow> unit"  where 
    59 primrec perm_unit :: "'x prm \<Rightarrow> unit \<Rightarrow> unit"  where 
    60   "perm_unit pi () = ()"
    60   "perm_unit pi () = ()"
    61   
    61   
    62 primrec perm_prod :: "'x prm \<Rightarrow> ('a\<times>'b) \<Rightarrow> ('a\<times>'b)" where
    62 primrec perm_prod :: "'x prm \<Rightarrow> ('a\<times>'b) \<Rightarrow> ('a\<times>'b)" where
    63   "perm_prod pi (x,y) = (pi\<bullet>x,pi\<bullet>y)"
    63   "perm_prod pi (x, y) = (pi\<bullet>x, pi\<bullet>y)"
    64 
    64 
    65 primrec perm_list :: "'x prm \<Rightarrow> 'a list \<Rightarrow> 'a list" where
    65 primrec perm_list :: "'x prm \<Rightarrow> 'a list \<Rightarrow> 'a list" where
    66   nil_eqvt:  "perm_list pi []     = []"
    66   nil_eqvt:  "perm_list pi []     = []"
    67 | cons_eqvt: "perm_list pi (x#xs) = (pi\<bullet>x)#(pi\<bullet>xs)"
    67 | cons_eqvt: "perm_list pi (x#xs) = (pi\<bullet>x)#(pi\<bullet>xs)"
    68 
    68 
    69 primrec perm_option :: "'x prm \<Rightarrow> 'a option \<Rightarrow> 'a option" where
    69 primrec perm_option :: "'x prm \<Rightarrow> 'a option \<Rightarrow> 'a option" where
    70   some_eqvt:  "perm_option pi (Some x) = Some (pi\<bullet>x)"
    70   some_eqvt:  "perm_option pi (Some x) = Some (pi\<bullet>x)"
    71 | none_eqvt:  "perm_option pi None     = None"
    71 | none_eqvt:  "perm_option pi None     = None"
    72 
    72 
    73 definition perm_char :: "'x prm \<Rightarrow> char \<Rightarrow> char" where
    73 definition perm_char :: "'x prm \<Rightarrow> char \<Rightarrow> char" where
    74   perm_char_def: "perm_char pi c = c"
    74   "perm_char pi c = c"
    75 
    75 
    76 definition perm_nat :: "'x prm \<Rightarrow> nat \<Rightarrow> nat" where
    76 definition perm_nat :: "'x prm \<Rightarrow> nat \<Rightarrow> nat" where
    77   perm_nat_def: "perm_nat pi i = i"
    77   "perm_nat pi i = i"
    78 
    78 
    79 definition perm_int :: "'x prm \<Rightarrow> int \<Rightarrow> int" where
    79 definition perm_int :: "'x prm \<Rightarrow> int \<Rightarrow> int" where
    80   perm_int_def: "perm_int pi i = i"
    80   "perm_int pi i = i"
    81 
    81 
    82 primrec perm_noption :: "'x prm \<Rightarrow> 'a noption \<Rightarrow> 'a noption" where
    82 primrec perm_noption :: "'x prm \<Rightarrow> 'a noption \<Rightarrow> 'a noption" where
    83   nsome_eqvt:  "perm_noption pi (nSome x) = nSome (pi\<bullet>x)"
    83   nsome_eqvt:  "perm_noption pi (nSome x) = nSome (pi\<bullet>x)"
    84 | nnone_eqvt:  "perm_noption pi nNone     = nNone"
    84 | nnone_eqvt:  "perm_noption pi nNone     = nNone"
    85 
    85 
   960 
   960 
   961 lemma dj_perm_set_forget:
   961 lemma dj_perm_set_forget:
   962   fixes pi::"'y prm"
   962   fixes pi::"'y prm"
   963   and   x ::"'x set"
   963   and   x ::"'x set"
   964   assumes dj: "disjoint TYPE('x) TYPE('y)"
   964   assumes dj: "disjoint TYPE('x) TYPE('y)"
   965   shows "(pi\<bullet>x)=x" 
   965   shows "pi\<bullet>x=x" 
   966   using dj by (simp_all add: perm_fun_def disjoint_def perm_bool)
   966   using dj by (simp_all add: perm_fun_def disjoint_def perm_bool)
   967 
   967 
   968 lemma dj_perm_perm_forget:
   968 lemma dj_perm_perm_forget:
   969   fixes pi1::"'x prm"
   969   fixes pi1::"'x prm"
   970   and   pi2::"'y prm"
   970   and   pi2::"'y prm"
  1026     have "pt TYPE('a \<Rightarrow> bool) TYPE('x)" by (rule pt_fun_inst)
  1026     have "pt TYPE('a \<Rightarrow> bool) TYPE('x)" by (rule pt_fun_inst)
  1027   then show ?thesis by (simp add: pt_def perm_set_def)
  1027   then show ?thesis by (simp add: pt_def perm_set_def)
  1028 qed
  1028 qed
  1029 
  1029 
  1030 lemma pt_unit_inst:
  1030 lemma pt_unit_inst:
  1031   shows  "pt TYPE(unit) TYPE('x)"
  1031   shows "pt TYPE(unit) TYPE('x)"
  1032   by (simp add: pt_def)
  1032   by (simp add: pt_def)
  1033 
  1033 
  1034 lemma pt_prod_inst:
  1034 lemma pt_prod_inst:
  1035   assumes pta: "pt TYPE('a) TYPE('x)"
  1035   assumes pta: "pt TYPE('a) TYPE('x)"
  1036   and     ptb: "pt TYPE('b) TYPE('x)"
  1036   and     ptb: "pt TYPE('b) TYPE('x)"
  2260   and   pi::"'x prm"
  2260   and   pi::"'x prm"
  2261   assumes pt: "pt TYPE('a) TYPE('x)"
  2261   assumes pt: "pt TYPE('a) TYPE('x)"
  2262   and     at: "at TYPE('x)"
  2262   and     at: "at TYPE('x)"
  2263   shows "pi\<bullet>(X_to_Un_supp X) = ((X_to_Un_supp (pi\<bullet>X))::'x set)"
  2263   shows "pi\<bullet>(X_to_Un_supp X) = ((X_to_Un_supp (pi\<bullet>X))::'x set)"
  2264   apply(simp add: X_to_Un_supp_def)
  2264   apply(simp add: X_to_Un_supp_def)
  2265   apply(simp add: UNION_f_eqvt[OF pt, OF at] perm_fun_def [where 'b="'x set"])
  2265   apply(simp add: UNION_f_eqvt[OF pt, OF at] perm_fun_def [where 'd="'x set"])
  2266   apply(simp add: pt_perm_supp[OF pt, OF at])
  2266   apply(simp add: pt_perm_supp[OF pt, OF at])
  2267   apply(simp add: pt_pi_rev[OF pt, OF at])
  2267   apply(simp add: pt_pi_rev[OF pt, OF at])
  2268   done
  2268   done
  2269 
  2269 
  2270 lemma Union_supports_set:
  2270 lemma Union_supports_set: