cleaned up a bit the examples; added equivariance to all examples
authorChristian Urban <urbanc@in.tum.de>
Sun, 09 May 2010 12:26:10 +0100
changeset 2082 0854af516f14
parent 2081 9e7cf0a996d3
child 2083 9568f9f31822
cleaned up a bit the examples; added equivariance to all examples
Nominal/Ex/Ex1rec.thy
Nominal/Ex/Ex2.thy
Nominal/Ex/Ex3.thy
Nominal/Ex/ExLF.thy
Nominal/Ex/ExLeroy.thy
Nominal/Ex/ExLet.thy
Nominal/Ex/ExLetMult.thy
Nominal/Ex/ExLetRec.thy
Nominal/Ex/ExNotRsp.thy
Nominal/Ex/ExPS3.thy
Nominal/Ex/ExPS6.thy
Nominal/Ex/ExPS7.thy
Nominal/Ex/ExPS8.thy
Nominal/Ex/Lambda.thy
Nominal/Ex/Term8.thy
Nominal/Ex/TestMorePerm.thy
Nominal/Ex/TypeSchemes.thy
--- a/Nominal/Ex/Ex1rec.thy	Sun May 09 11:43:24 2010 +0100
+++ b/Nominal/Ex/Ex1rec.thy	Sun May 09 12:26:10 2010 +0100
@@ -29,10 +29,11 @@
 ML {* Sign.of_sort @{theory} (@{typ lam}, @{sort fs}) *}
 thm lam_bp.fv[simplified lam_bp.supp(1-2)]
 
-(*declare permute_lam_raw_permute_bp_raw.simps[eqvt]
+declare permute_lam_raw_permute_bp_raw.simps[eqvt]
 declare alpha_gen_eqvt[eqvt]
+
 equivariance alpha_lam_raw
-*)
+
 
 end
 
--- a/Nominal/Ex/Ex2.thy	Sun May 09 11:43:24 2010 +0100
+++ b/Nominal/Ex/Ex2.thy	Sun May 09 12:26:10 2010 +0100
@@ -27,6 +27,12 @@
 thm trm_pat.distinct
 thm trm_pat.fv[simplified trm_pat.supp(1-2)]
 
+declare permute_trm_raw_permute_pat_raw.simps[eqvt]
+declare alpha_gen_eqvt[eqvt]
+
+equivariance alpha_trm_raw
+
+
 end
 
 
--- a/Nominal/Ex/Ex3.thy	Sun May 09 11:43:24 2010 +0100
+++ b/Nominal/Ex/Ex3.thy	Sun May 09 12:26:10 2010 +0100
@@ -30,6 +30,13 @@
 thm trm_pat.distinct
 thm trm_pat.fv[simplified trm_pat.supp(1-2)]
 
+
+declare permute_trm_raw_permute_pat_raw.simps[eqvt]
+declare alpha_gen_eqvt[eqvt]
+
+equivariance alpha_trm_raw
+
+
 end
 
 
--- a/Nominal/Ex/ExLF.thy	Sun May 09 11:43:24 2010 +0100
+++ b/Nominal/Ex/ExLF.thy	Sun May 09 12:26:10 2010 +0100
@@ -20,6 +20,14 @@
 
 thm kind_ty_trm.supp
 
+declare permute_kind_raw_permute_ty_raw_permute_trm_raw.simps[eqvt]
+declare alpha_gen_eqvt[eqvt]
+
+equivariance alpha_trm_raw
+
+
+
+
 end
 
 
--- a/Nominal/Ex/ExLeroy.thy	Sun May 09 11:43:24 2010 +0100
+++ b/Nominal/Ex/ExLeroy.thy	Sun May 09 12:26:10 2010 +0100
@@ -16,10 +16,10 @@
   Empty
 | Seq c::defn d::"body"     bind_set "cbinders c" in d
 and defn =
-  Type "name" "tyty"
+  Type "name" "ty"
 | Dty "name"
 | DStru "name" "mexp"
-| Val "name" "trmtrm"
+| Val "name" "trm"
 and sexp =
   Sig sbody
 | SFunc "name" "sexp" "sexp"
@@ -28,22 +28,22 @@
 | SSeq C::spec D::sbody    bind_set "Cbinders C" in D
 and spec =
   Type1 "name"
-| Type2 "name" "tyty"
+| Type2 "name" "ty"
 | SStru "name" "sexp"
-| SVal "name" "tyty"
-and tyty =
+| SVal "name" "ty"
+and ty =
   Tyref1 "name"
-| Tyref2 "path" "tyty"
-| Fun "tyty" "tyty"
+| Tyref2 "path" "ty"
+| Fun "ty" "ty"
 and path =
   Sref1 "name"
 | Sref2 "path" "name"
-and trmtrm =
+and trm =
   Tref1 "name"
 | Tref2 "path" "name"
-| Lam' v::"name" "tyty" M::"trmtrm"  bind_set v in M
-| App' "trmtrm" "trmtrm"
-| Let' "body" "trmtrm"
+| Lam' v::"name" "ty" M::"trm"  bind_set v in M
+| App' "trm" "trm"
+| Let' "body" "trm"
 binder
     cbinders :: "defn \<Rightarrow> atom set"
 and Cbinders :: "spec \<Rightarrow> atom set"
@@ -57,15 +57,21 @@
 | "Cbinders (SStru x S) = {atom x}"
 | "Cbinders (SVal v T) = {atom v}"
 
-thm mexp_body_defn_sexp_sbody_spec_tyty_path_trmtrm.fv
-thm mexp_body_defn_sexp_sbody_spec_tyty_path_trmtrm.eq_iff
-thm mexp_body_defn_sexp_sbody_spec_tyty_path_trmtrm.bn
-thm mexp_body_defn_sexp_sbody_spec_tyty_path_trmtrm.perm
-thm mexp_body_defn_sexp_sbody_spec_tyty_path_trmtrm.induct
-thm mexp_body_defn_sexp_sbody_spec_tyty_path_trmtrm.inducts
-thm mexp_body_defn_sexp_sbody_spec_tyty_path_trmtrm.distinct
-thm mexp_body_defn_sexp_sbody_spec_tyty_path_trmtrm.supp(1-3,5-7,9-10)
-thm mexp_body_defn_sexp_sbody_spec_tyty_path_trmtrm.fv[simplified mexp_body_defn_sexp_sbody_spec_tyty_path_trmtrm.supp(1-3,5-7,9-10)]
+thm mexp_body_defn_sexp_sbody_spec_ty_path_trm.fv
+thm mexp_body_defn_sexp_sbody_spec_ty_path_trm.eq_iff
+thm mexp_body_defn_sexp_sbody_spec_ty_path_trm.bn
+thm mexp_body_defn_sexp_sbody_spec_ty_path_trm.perm
+thm mexp_body_defn_sexp_sbody_spec_ty_path_trm.induct
+thm mexp_body_defn_sexp_sbody_spec_ty_path_trm.inducts
+thm mexp_body_defn_sexp_sbody_spec_ty_path_trm.distinct
+thm mexp_body_defn_sexp_sbody_spec_ty_path_trm.supp(1-3,5-7,9-10)
+thm mexp_body_defn_sexp_sbody_spec_ty_path_trm.fv[simplified mexp_body_defn_sexp_sbody_spec_ty_path_trm.supp(1-3,5-7,9-10)]
+
+declare permute_mexp_raw_permute_body_raw_permute_defn_raw_permute_sexp_raw_permute_sbody_raw_permute_spec_raw_permute_ty_raw_permute_path_raw_permute_trm_raw.simps[eqvt]
+declare alpha_gen_eqvt[eqvt]
+
+equivariance alpha_trm_raw
+
 
 end
 
--- a/Nominal/Ex/ExLet.thy	Sun May 09 11:43:24 2010 +0100
+++ b/Nominal/Ex/ExLet.thy	Sun May 09 12:26:10 2010 +0100
@@ -35,6 +35,13 @@
 thm trm_lts.fv[simplified trm_lts.supp(1-2)]
 
 
+declare permute_trm_raw_permute_lts_raw.simps[eqvt]
+declare alpha_gen_eqvt[eqvt]
+
+equivariance alpha_trm_raw
+
+
+
 primrec
   permute_bn_raw
 where
@@ -95,14 +102,14 @@
   apply (rule_tac x="q" in exI)
   apply (simp add: alphas)
   apply (simp add: perm_bn[symmetric])
-  apply (simp add: eqvts[symmetric])
-  apply (simp add: supp_abs)
+  apply(rule conjI)
+  apply(drule supp_perm_eq)
+  apply(simp add: abs_eq_iff)
+  apply(simp add: alphas_abs alphas)
+  apply(drule conjunct1)
   apply (simp add: trm_lts.supp)
-  apply (rule supp_perm_eq[symmetric])
-  apply (subst supp_finite_atom_set)
-  apply (rule finite_Diff)
-  apply (simp add: finite_supp)
-  apply (assumption)
+  apply(simp add: supp_abs)
+  apply (simp add: trm_lts.supp)
   done
 
 
--- a/Nominal/Ex/ExLetMult.thy	Sun May 09 11:43:24 2010 +0100
+++ b/Nominal/Ex/ExLetMult.thy	Sun May 09 12:26:10 2010 +0100
@@ -22,6 +22,12 @@
 thm trm_lts.induct
 thm trm_lts.fv[simplified trm_lts.supp]
 
+declare permute_trm_raw_permute_lts_raw.simps[eqvt]
+declare alpha_gen_eqvt[eqvt]
+
+equivariance alpha_trm_raw
+
+
 end
 
 
--- a/Nominal/Ex/ExLetRec.thy	Sun May 09 11:43:24 2010 +0100
+++ b/Nominal/Ex/ExLetRec.thy	Sun May 09 12:26:10 2010 +0100
@@ -30,6 +30,11 @@
 thm trm_lts.supp
 thm trm_lts.fv[simplified trm_lts.supp]
 
+declare permute_trm_raw_permute_lts_raw.simps[eqvt]
+declare alpha_gen_eqvt[eqvt]
+
+equivariance alpha_trm_raw
+
 (* why is this not in HOL simpset? *)
 lemma set_sub: "{a, b} - {b} = {a} - {b}"
 by auto
--- a/Nominal/Ex/ExNotRsp.thy	Sun May 09 11:43:24 2010 +0100
+++ b/Nominal/Ex/ExNotRsp.thy	Sun May 09 12:26:10 2010 +0100
@@ -1,46 +1,52 @@
 theory ExNotRsp
-imports "../Parser"
+imports "../NewParser"
 begin
 
 atom_decl name
 
-(* example 6 from Terms.thy *)
-
-nominal_datatype trm6 =
-  Vr6 "name"
-| Lm6 x::"name" t::"trm6"         bind x in t
-| Lt6 left::"trm6" right::"trm6"  bind "bv6 left" in right
+(* this example binds bound names and
+   so is not respectful *)
+(*
+nominal_datatype trm =
+  Vr "name"
+| Lm x::"name" t::"trm"         bind x in t
+| Lt left::"trm" right::"trm"   bind "bv left" in right
 binder
-  bv6
+  bv
 where
-  "bv6 (Vr6 n) = {}"
-| "bv6 (Lm6 n t) = {atom n} \<union> bv6 t"
-| "bv6 (Lt6 l r) = bv6 l \<union> bv6 r"
-
-(* example 7 from Terms.thy *)
-nominal_datatype trm7 =
-  Vr7 "name"
-| Lm7 l::"name" r::"trm7"   bind l in r
-| Lt7 l::"trm7" r::"trm7"   bind "bv7 l" in r
-binder
-  bv7
-where
-  "bv7 (Vr7 n) = {atom n}"
-| "bv7 (Lm7 n t) = bv7 t - {atom n}"
-| "bv7 (Lt7 l r) = bv7 l \<union> bv7 r"
+  "bv (Vr n) = {}"
+| "bv (Lm n t) = {atom n} \<union> bv t"
+| "bv (Lt l r) = bv l \<union> bv r"
 *)
 
-(* example 9 from Terms.thy *)
-nominal_datatype lam9 =
-  Var9 "name"
-| Lam9 n::"name" l::"lam9" bind n in l
-and bla9 =
-  Bla9 f::"lam9" s::"lam9" bind "bv9 f" in s
+(* this example uses "-" in the binding function; 
+   at the moment this is unsupported *)
+(*
+nominal_datatype trm' =
+  Vr' "name"
+| Lm' l::"name" r::"trm'"   bind l in r
+| Lt' l::"trm'" r::"trm'"   bind "bv' l" in r
 binder
-  bv9
+  bv'
 where
-  "bv9 (Var9 x) = {}"
-| "bv9 (Lam9 x b) = {atom x}"
+  "bv' (Vr' n) = {atom n}"
+| "bv' (Lm' n t) = bv' t - {atom n}"
+| "bv' (Lt' l r) = bv' l \<union> bv' r"
+*)
+
+(* this example again binds bound names  *)
+(*
+nominal_datatype trm'' =
+  Va'' "name"
+| Lm'' n::"name" l::"trm''" bind n in l
+and bla'' =
+  Bla'' f::"trm''" s::"trm''" bind "bv'' f" in s
+binder
+  bv''
+where
+  "bv'' (Vm'' x) = {}"
+| "bv'' (Lm'' x b) = {atom x}"
+*)
 
 end
 
--- a/Nominal/Ex/ExPS3.thy	Sun May 09 11:43:24 2010 +0100
+++ b/Nominal/Ex/ExPS3.thy	Sun May 09 12:26:10 2010 +0100
@@ -11,29 +11,35 @@
 ML {* val _ = cheat_alpha_bn_rsp := true *}
 
 nominal_datatype exp =
-  VarP "name"
-| AppP "exp" "exp"
-| LamP x::"name" e::"exp" bind_set x in e
-| LetP x::"name" p::"pat3" e1::"exp" e2::"exp" bind_set x in e2, bind_set "bp p" in e1
-and pat3 =
+  Var "name"
+| App "exp" "exp"
+| Lam x::"name" e::"exp" bind_set x in e
+| Let x::"name" p::"pat" e1::"exp" e2::"exp" bind_set x in e2, bind_set "bp p" in e1
+and pat =
   PVar "name"
 | PUnit
-| PPair "pat3" "pat3"
+| PPair "pat" "pat"
 binder
-  bp :: "pat3 \<Rightarrow> atom set"
+  bp :: "pat \<Rightarrow> atom set"
 where
   "bp (PVar x) = {atom x}"
 | "bp (PUnit) = {}"
 | "bp (PPair p1 p2) = bp p1 \<union> bp p2"
 
-thm exp_pat3.fv
-thm exp_pat3.eq_iff
-thm exp_pat3.bn
-thm exp_pat3.perm
-thm exp_pat3.induct
-thm exp_pat3.distinct
-thm exp_pat3.fv
-thm exp_pat3.supp(1-2)
+thm exp_pat.fv
+thm exp_pat.eq_iff
+thm exp_pat.bn
+thm exp_pat.perm
+thm exp_pat.induct
+thm exp_pat.distinct
+thm exp_pat.fv
+thm exp_pat.supp(1-2)
+
+declare permute_exp_raw_permute_pat_raw.simps[eqvt]
+declare alpha_gen_eqvt[eqvt]
+
+equivariance alpha_exp_raw
+
 
 end
 
--- a/Nominal/Ex/ExPS6.thy	Sun May 09 11:43:24 2010 +0100
+++ b/Nominal/Ex/ExPS6.thy	Sun May 09 12:26:10 2010 +0100
@@ -1,37 +1,42 @@
 theory ExPS6
-imports "../Parser"
+imports "../NewParser"
 begin
 
 (* example 6 from Peter Sewell's bestiary *)
 
 atom_decl name
 
-(* The binding structure is too complicated, so equivalence the
-   way we define it is not true *)
+(* Is this binding structure supported - I think not 
+   because e1 occurs twice as body *)
 
-ML {* val _ = recursive := false  *}
-nominal_datatype exp6 =
-  EVar name
-| EPair exp6 exp6
-| ELetRec x::name p::pat6 e1::exp6 e2::exp6 bind x in e1, bind x in e2, bind "bp6 p" in e1
-and pat6 =
-  PVar' name
-| PUnit'
-| PPair' pat6 pat6
+nominal_datatype exp =
+  Var name
+| Pair exp exp
+| LetRec x::name p::pat e1::exp e2::exp  bind x in e1 e2, bind "bp p" in e1
+and pat =
+  PVar name
+| PUnit
+| PPair pat pat
 binder
-  bp6 :: "pat6 \<Rightarrow> atom set"
+  bp :: "pat \<Rightarrow> atom list"
 where
-  "bp6 (PVar' x) = {atom x}"
-| "bp6 (PUnit') = {}"
-| "bp6 (PPair' p1 p2) = bp6 p1 \<union> bp6 p2"
+  "bp (PVar x) = [atom x]"
+| "bp (PUnit) = []"
+| "bp (PPair p1 p2) = bp p1 @ bp p2"
 
-thm exp6_pat6.fv
-thm exp6_pat6.eq_iff
-thm exp6_pat6.bn
-thm exp6_pat6.perm
-thm exp6_pat6.induct
-thm exp6_pat6.distinct
-thm exp6_pat6.supp
+thm exp_pat.fv
+thm exp_pat.eq_iff
+thm exp_pat.bn
+thm exp_pat.perm
+thm exp_pat.induct
+thm exp_pat.distinct
+thm exp_pat.supp
+
+declare permute_exp_raw_permute_pat_raw.simps[eqvt]
+declare alpha_gen_eqvt[eqvt]
+
+equivariance alpha_exp_raw
+
 
 end
 
--- a/Nominal/Ex/ExPS7.thy	Sun May 09 11:43:24 2010 +0100
+++ b/Nominal/Ex/ExPS7.thy	Sun May 09 12:26:10 2010 +0100
@@ -1,3 +1,4 @@
+
 theory ExPS7
 imports "../NewParser"
 begin
@@ -6,25 +7,31 @@
 
 atom_decl name
 
-nominal_datatype exp7 =
-  EVar name
-| EUnit
-| EPair exp7 exp7
-| ELetRec l::"lrbs" e::"exp7" bind_set "b7s l" in l e
+nominal_datatype exp =
+  Var name
+| Unit
+| Pair exp exp
+| LetRec l::"lrbs" e::"exp"  bind_set "bs l" in l e
 and lrb =
-  Assign name exp7
+  Assign name exp
 and lrbs =
   Single lrb
 | More lrb lrbs
 binder
-  b7 :: "lrb \<Rightarrow> atom set" and
-  b7s :: "lrbs \<Rightarrow> atom set"
+  b :: "lrb \<Rightarrow> atom set" and
+  bs :: "lrbs \<Rightarrow> atom set"
 where
-  "b7 (Assign x e) = {atom x}"
-| "b7s (Single a) = b7 a"
-| "b7s (More a as) = (b7 a) \<union> (b7s as)"
-thm exp7_lrb_lrbs.eq_iff
-thm exp7_lrb_lrbs.supp
+  "b (Assign x e) = {atom x}"
+| "bs (Single a) = b a"
+| "bs (More a as) = (b a) \<union> (bs as)"
+
+thm exp_lrb_lrbs.eq_iff
+thm exp_lrb_lrbs.supp
+
+declare permute_exp_raw_permute_lrb_raw_permute_lrbs_raw.simps[eqvt]
+declare alpha_gen_eqvt[eqvt]
+
+equivariance alpha_exp_raw
 
 end
 
--- a/Nominal/Ex/ExPS8.thy	Sun May 09 11:43:24 2010 +0100
+++ b/Nominal/Ex/ExPS8.thy	Sun May 09 12:26:10 2010 +0100
@@ -48,6 +48,11 @@
 thm exp_fnclause_fnclauses_lrb_lrbs_pat.fv
 thm exp_fnclause_fnclauses_lrb_lrbs_pat.eq_iff
 
+
+declare permute_exp_raw_permute_fnclause_raw_permute_fnclauses_raw_permute_lrb_raw_permute_lrbs_raw_permute_pat_raw.simps[eqvt]
+declare alpha_gen_eqvt[eqvt]
+
+equivariance alpha_exp_raw
 end
 
 
--- a/Nominal/Ex/Lambda.thy	Sun May 09 11:43:24 2010 +0100
+++ b/Nominal/Ex/Lambda.thy	Sun May 09 12:26:10 2010 +0100
@@ -15,6 +15,10 @@
 
 declare lam.perm[eqvt]
 
+declare permute_lam_raw.simps[eqvt]
+declare alpha_gen_eqvt[eqvt]
+equivariance alpha_lam_raw
+
 section {* Strong Induction Principles*}
 
 (*
--- a/Nominal/Ex/Term8.thy	Sun May 09 11:43:24 2010 +0100
+++ b/Nominal/Ex/Term8.thy	Sun May 09 12:26:10 2010 +0100
@@ -2,22 +2,27 @@
 imports "../NewParser"
 begin
 
-(* example 8 from Terms.thy *)
+(* example 8 *)
 
 atom_decl name
 
+(* this should work but gives an error at the moment:
+   seems like in the symmetry proof
+*)
+
 nominal_datatype foo =
   Foo0 "name"
 | Foo1 b::"bar" f::"foo" bind_set "bv b" in f
 and bar =
   Bar0 "name"
-| Bar1 "name" s::"name" b::"bar" bind_set s in b
+| Bar1 "name" s::"name" b::"bar" bind s in b
 binder
   bv
 where
   "bv (Bar0 x) = {}"
 | "bv (Bar1 v x b) = {atom v}"
 
+
 end
 
 
--- a/Nominal/Ex/TestMorePerm.thy	Sun May 09 11:43:24 2010 +0100
+++ b/Nominal/Ex/TestMorePerm.thy	Sun May 09 12:26:10 2010 +0100
@@ -1,35 +1,35 @@
 theory TestMorePerm
-imports "../Parser"
+imports "../NewParser"
 begin
 
 text {* 
   "Weirdo" example from Peter Sewell's bestiary. 
 
-  In case of deep binders, it is not coverd by our 
-  approach of defining alpha-equivalence with a 
-  single permutation.
-
-  Check whether it works with shallow binders as
-  defined below.
+  This example is not covered by our binding 
+  specification.
 
 *}
 ML {* val _ = cheat_equivp := true *}
 
 atom_decl name
 
-nominal_datatype foo =
+nominal_datatype weird =
   Foo_var "name"
-| Foo_pair "foo" "foo" 
-| Foo x::"name" y::"name" p1::"foo" p2::"foo" p3::"foo"
-    bind x in p1, bind x in p2, 
-    bind y in p2, bind y in p3
+| Foo_pair "weird" "weird" 
+| Foo x::"name" y::"name" p1::"weird" p2::"weird" p3::"weird"
+    bind x in p1 p2, 
+    bind y in p2 p3
 
-thm alpha_foo_raw.intros[no_vars]
+thm alpha_weird_raw.intros[no_vars]
 
 thm permute_weird_raw.simps[no_vars]
 thm alpha_weird_raw.intros[no_vars]
 thm fv_weird_raw.simps[no_vars]
 
+declare permute_weird_raw.simps[eqvt]
+declare alpha_gen_eqvt[eqvt]
+equivariance alpha_weird_raw
+
 
 end
 
--- a/Nominal/Ex/TypeSchemes.thy	Sun May 09 11:43:24 2010 +0100
+++ b/Nominal/Ex/TypeSchemes.thy	Sun May 09 12:26:10 2010 +0100
@@ -14,6 +14,11 @@
 
 lemmas ty_tys_supp = ty_tys.fv[simplified ty_tys.supp]
 
+declare permute_ty_raw_permute_tys_raw.simps[eqvt]
+declare alpha_gen_eqvt[eqvt]
+equivariance alpha_ty_raw
+
+
 (* below we define manually the function for size *)
 
 lemma size_eqvt_raw: