Nominal/Ex/ExPS8.thy
changeset 2481 3a5ebb2fcdbf
parent 2480 ac7dff1194e8
child 2482 0c2eb0ed30a0
--- a/Nominal/Ex/ExPS8.thy	Mon Sep 20 21:52:45 2010 +0800
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,99 +0,0 @@
-theory ExPS8
-imports "../Nominal2"
-begin
-
-(* example 8 from Peter Sewell's bestiary *)
-
-atom_decl name
-
-declare [[STEPS = 31]]
-
-nominal_datatype fun_pats: exp =
-  EVar name
-| EUnit 
-| EPair exp exp
-| ELetRec l::lrbs e::exp bind (set) "b_lrbs l" in l e
-and fnclause =
-  K x::name p::pat f::exp bind (set) "b_pat p" in f
-and fnclauses =
-  S fnclause
-| ORs fnclause fnclauses
-and lrb =
-  Clause fnclauses
-and lrbs =
-  Single lrb
-| More lrb lrbs
-and pat =
-  PVar name
-| PUnit
-| PPair pat pat
-binder
-  b_lrbs :: "lrbs \<Rightarrow> atom set" and
-  b_pat :: "pat \<Rightarrow> atom set" and
-  b_fnclauses :: "fnclauses \<Rightarrow> atom set" and
-  b_fnclause :: "fnclause \<Rightarrow> atom set" and
-  b_lrb :: "lrb \<Rightarrow> atom set"
-where
-  "b_lrbs (Single l) = b_lrb l"
-| "b_lrbs (More l ls) = b_lrb l \<union> b_lrbs ls"
-| "b_pat (PVar x) = {atom x}"
-| "b_pat (PUnit) = {}"
-| "b_pat (PPair p1 p2) = b_pat p1 \<union> b_pat p2"
-| "b_fnclauses (S fc) = (b_fnclause fc)"
-| "b_fnclauses (ORs fc fcs) = (b_fnclause fc) \<union> (b_fnclauses fcs)"
-| "b_lrb (Clause fcs) = (b_fnclauses fcs)"
-| "b_fnclause (K x pat exp) = {atom x}"
-
-thm fun_pats.distinct
-thm fun_pats.induct
-thm fun_pats.inducts
-thm fun_pats.exhaust
-thm fun_pats.fv_defs
-thm fun_pats.bn_defs
-thm fun_pats.perm_simps
-thm fun_pats.eq_iff
-thm fun_pats.fv_bn_eqvt
-thm fun_pats.size_eqvt
-thm fun_pats.supports
-thm fun_pats.fsupp
-thm fun_pats.supp
-
-lemma
-  "(fv_exp x = supp x) \<and>
-   (fv_fnclause xa = supp xa \<and> fv_b_lrb xa = supp_rel alpha_b_lrb xa) \<and>
-   (fv_fnclauses xb = supp xb \<and> fv_b_fnclauses xb = supp_rel alpha_b_fnclauses xb) \<and>
-   (fv_lrb xc = supp xc \<and> fv_b_fnclause xc = supp_rel alpha_b_fnclause xc) \<and>
-   (fv_lrbs xd = supp xd \<and> fv_b_lrbs xd = supp_rel alpha_b_lrbs xd) \<and>
-   (fv_pat xe = supp xe \<and> fv_b_pat xe = supp_rel alpha_b_pat xe)"
-apply(rule fun_pats.induct)
-apply(tactic {* ALLGOALS (TRY o rtac @{thm conjI})*})
-thm fun_pats.inducts
-oops
-
-
-lemma
-  "fv_exp x = supp x" and
-  "fv_fnclause y = supp y" and
-  "fv_fnclauses xb = supp xb" and
-  "fv_lrb xc = supp xc" and
-  "fv_lrbs xd = supp xd" and
-  "fv_pat xe = supp xe" and
-  "fv_b_lrbs xd = supp_rel alpha_b_lrbs xd" and
-  "fv_b_pat xe = supp_rel alpha_b_pat xe" and
-  "fv_b_fnclauses xb = supp_rel alpha_b_fnclauses xb" and 
-  "fv_b_fnclause xc = supp_rel alpha_b_fnclause xc" and
-  "fv_b_lrb y = supp_rel alpha_b_lrb y"
-thm fun_pats.inducts
-apply(induct rule: fun_pats.inducts(1)[where ?exp="x::exp"] 
-                   fun_pats.inducts(2)[where ?fnclause="y"]
-                   fun_pats.inducts(3)[where ?fnclauses="xb"]
-                   fun_pats.inducts(4)[where ?lrb="xc"] 
-                   fun_pats.inducts(5)[where ?lrbs="xd"]
-                   fun_pats.inducts(6)[where ?pat="xe"])
-thm fun_pats.inducts
-oops
-
-end
-
-
-