Nominal/Ex/TypeSchemes.thy
changeset 2617 e44551d067e6
parent 2611 3d101f2f817c
child 2622 e6e6a3da81aa
equal deleted inserted replaced
2616:dd7490fdd998 2617:e44551d067e6
     6 
     6 
     7 atom_decl name 
     7 atom_decl name 
     8 
     8 
     9 
     9 
    10 (* defined as a single nominal datatype *)
    10 (* defined as a single nominal datatype *)
    11 
       
    12 thm finite_set
       
    13 
    11 
    14 nominal_datatype ty =
    12 nominal_datatype ty =
    15   Var "name"
    13   Var "name"
    16 | Fun "ty" "ty"
    14 | Fun "ty" "ty"
    17 and tys =
    15 and tys =
    18   All xs::"name fset" ty::"ty" bind (res) xs in ty
    16   All xs::"name fset" ty::"ty" bind (res) xs in ty
    19 
    17 
    20 thm ty_tys.distinct
    18 thm ty_tys.distinct
    21 thm ty_tys.induct
    19 thm ty_tys.induct
    22 thm ty_tys.exhaust
    20 thm ty_tys.inducts
       
    21 thm ty_tys.exhaust ty_tys.strong_exhaust
    23 thm ty_tys.fv_defs
    22 thm ty_tys.fv_defs
    24 thm ty_tys.bn_defs
    23 thm ty_tys.bn_defs
    25 thm ty_tys.perm_simps
    24 thm ty_tys.perm_simps
    26 thm ty_tys.eq_iff
    25 thm ty_tys.eq_iff
    27 thm ty_tys.fv_bn_eqvt
    26 thm ty_tys.fv_bn_eqvt
    39 nominal_datatype tys2 =
    38 nominal_datatype tys2 =
    40   All2 xs::"name fset" ty::"ty2" bind (res) xs in ty
    39   All2 xs::"name fset" ty::"ty2" bind (res) xs in ty
    41 
    40 
    42 thm tys2.distinct
    41 thm tys2.distinct
    43 thm tys2.induct
    42 thm tys2.induct
    44 thm tys2.exhaust
    43 thm tys2.exhaust tys2.strong_exhaust
    45 thm tys2.fv_defs
    44 thm tys2.fv_defs
    46 thm tys2.bn_defs
    45 thm tys2.bn_defs
    47 thm tys2.perm_simps
    46 thm tys2.perm_simps
    48 thm tys2.eq_iff
    47 thm tys2.eq_iff
    49 thm tys2.fv_bn_eqvt
    48 thm tys2.fv_bn_eqvt
    50 thm tys2.size_eqvt
    49 thm tys2.size_eqvt
    51 thm tys2.supports
    50 thm tys2.supports
    52 thm tys2.supp
    51 thm tys2.supp
    53 thm tys2.fresh
    52 thm tys2.fresh
    54 
    53 
    55 
       
    56 lemma strong_exhaust:
       
    57   fixes c::"'a::fs"
       
    58   assumes "\<And>names ty. \<lbrakk>fset (map_fset atom names) \<sharp>* c; y = All2 names ty\<rbrakk> \<Longrightarrow> P"
       
    59   shows "P"
       
    60 apply(rule_tac y="y" in tys2.exhaust)
       
    61 apply(rename_tac names ty2)
       
    62 apply(subgoal_tac "\<exists>q. (q \<bullet> (fset (map_fset atom names))) \<sharp>* c \<and> supp (All2 names ty2) \<sharp>* q")
       
    63 apply(erule exE)
       
    64 apply(perm_simp)
       
    65 apply(erule conjE)
       
    66 apply(rule assms(1))
       
    67 apply(assumption)
       
    68 apply(clarify)
       
    69 apply(drule supp_perm_eq[symmetric])
       
    70 apply(simp)
       
    71 apply(rule at_set_avoiding2)
       
    72 apply(simp add: finite_supp)
       
    73 apply(simp add: finite_supp)
       
    74 apply(simp add: finite_supp)
       
    75 apply(simp)
       
    76 apply(simp add: fresh_star_def)
       
    77 apply(simp add: tys2.fresh)
       
    78 done
       
    79 
       
    80 
       
    81 lemma strong_induct:
    54 lemma strong_induct:
    82   fixes c::"'a::fs"
    55   fixes c::"'a::fs"
    83   assumes "\<And>names ty2 c. fset (map_fset atom names) \<sharp>* c \<Longrightarrow> P c (All2 names ty2)"
    56   assumes "\<And>names ty2 c. fset (map_fset atom names) \<sharp>* c \<Longrightarrow> P c (All2 names ty2)"
    84   shows "P c tys"
    57   shows "P c tys"
    85 using assms
    58 using assms
    86 apply(induction_schema)
    59 apply(induction_schema)
    87 apply(rule_tac y="tys" in strong_exhaust)
    60 apply(rule_tac y="tys" in tys2.strong_exhaust)
    88 apply(blast)
    61 apply(blast)
    89 apply(relation "measure (\<lambda>(x,y). size y)")
    62 apply(relation "measure (\<lambda>(x,y). size y)")
    90 apply(simp_all add: tys2.size)
    63 apply(simp_all add: tys2.size)
    91 done
    64 done
    92 
    65