
diff -r 6e2dfe52b271 -r 1f3c01345c9e Nominal/Test.thy
--- a/Nominal/Test.thy	Wed Mar 10 13:29:12 2010 +0100
+++ b/Nominal/Test.thy	Wed Mar 10 14:24:27 2010 +0100
@@ -2,29 +2,14 @@
 imports "Parser" "../Attic/Prove"
 begin
 
-text {* weirdo example from Peter Sewell's bestiary *}
-
-nominal_datatype weird =
-  WBind x::"name" y::"name" p1::"weird" p2::"weird" p3::"weird"
-    bind x in p1, bind x in p2, bind y in p2, bind y in p3
-| WV "name"
-| WP "weird" "weird"
-
-thm permute_weird_raw.simps[no_vars]
-thm alpha_weird_raw.intros[no_vars]
-thm fv_weird_raw.simps[no_vars]
-
-
-text {* example 1 *}
-
-(* ML {* set show_hyps *} *)
+text {* example 1, equivalent to example 2 from Terms *}
 
 nominal_datatype lam =
   VAR "name"
 | APP "lam" "lam"
 | LET bp::"bp" t::"lam"   bind "bi bp" in t
-and bp = 
-  BP "name" "lam" 
+and bp =
+  BP "name" "lam"
 binder
   bi::"bp \<Rightarrow> atom set"
 where
@@ -44,19 +29,13 @@
 thm permute_lam_raw_permute_bp_raw.simps
 thm alpha_lam_raw_alpha_bp_raw_alpha_bi_raw.intros[no_vars]
 thm fv_lam_raw_fv_bp_raw.simps[no_vars]
-(*thm lam_bp_induct
-thm lam_bp_perm
-thm lam_bp_fv
-thm lam_bp_bn
-thm lam_bp_inject
-thm lam_bp_distinct*)
 
 text {* example 2 *}
 
 nominal_datatype trm' =
   Var "name"
 | App "trm'" "trm'"
-| Lam x::"name" t::"trm'"          bind x in t 
+| Lam x::"name" t::"trm'"          bind x in t
 | Let p::"pat'" "trm'" t::"trm'"   bind "f p" in t
 and pat' =
   PN
@@ -64,7 +43,7 @@
 | PD "name" "name"
 binder
   f::"pat' \<Rightarrow> atom set"
-where 
+where
   "f PN = {}"
 | "f (PD x y) = {atom x, atom y}"
 | "f (PS x) = {atom x}"
@@ -89,7 +68,7 @@
 nominal_datatype trm0 =
   Var0 "name"
 | App0 "trm0" "trm0"
-| Lam0 x::"name" t::"trm0"          bind x in t 
+| Lam0 x::"name" t::"trm0"          bind x in t
 | Let0 p::"pat0" "trm0" t::"trm0"   bind "f0 p" in t
 and pat0 =
   PN0
@@ -97,7 +76,7 @@
 | PD0 "pat0" "pat0"
 binder
   f0::"pat0 \<Rightarrow> atom set"
-where 
+where
   "f0 PN0 = {}"
 | "f0 (PS0 x) = {atom x}"
 | "f0 (PD0 p1 p2) = (f0 p1) \<union> (f0 p2)"
@@ -110,20 +89,10 @@
 
 text {* example type schemes *}
 
-(* does not work yet
 nominal_datatype t =
   Var "name"
 | Fun "t" "t"
-
-nominal_datatype tyS =
-  All xs::"name list" ty::"t_raw" bind xs in ty
-*)
-
-
-nominal_datatype t = 
-  Var "name" 
-| Fun "t" "t"
-and  tyS = 
+and  tyS =
   All xs::"name set" ty::"t" bind xs in ty
 
 (* example 1 from Terms.thy *)
@@ -131,8 +100,8 @@
 nominal_datatype trm1 =
   Vr1 "name"
 | Ap1 "trm1" "trm1"
-| Lm1 x::"name" t::"trm1"       bind x in t 
-| Lt1 p::"bp1" "trm1" t::"trm1" bind "bv1 p" in t 
+| Lm1 x::"name" t::"trm1"       bind x in t
+| Lt1 p::"bp1" "trm1" t::"trm1" bind "bv1 p" in t
 and bp1 =
   BUnit1
 | BV1 "name"
@@ -147,30 +116,6 @@
 
 thm bv1_raw.simps
 
-(* example 2 from Terms.thy *)
-
-nominal_datatype trm2 =
-  Vr2 "name"
-| Ap2 "trm2" "trm2"
-| Lm2 x::"name" t::"trm2"       bind x in t
-| Lt2 r::"assign" t::"trm2"    bind "bv2 r" in t
-and assign = 
-  As "name" "trm2"
-binder
-  bv2
-where
-  "bv2 (As x t) = {atom x}"
-
-(* compat should be
-compat (As x t) pi (As x' t') == pi o x = x' & alpha t t'
-*)
-
-
-thm fv_trm2_raw_fv_assign_raw.simps[no_vars]
-thm alpha_trm2_raw_alpha_assign_raw_alpha_bv2_raw.intros[no_vars]
-
-
-
 text {* example 3 from Terms.thy *}
 
 nominal_datatype trm3 =
@@ -193,18 +138,6 @@
 compat (ACons x t ts) pi (ACons x' t' ts') \<equiv> pi o x = x' \<and> alpha t t' \<and> compat ts pi ts'
 *)
 
-(* example 4 from Terms.thy *)
-
-(* fv_eqvt does not work, we need to repaire defined permute functions
-   defined fv and defined alpha... *)
-nominal_datatype trm4 =
-  Vr4 "name"
-| Ap4 "trm4" "trm4 list"
-| Lm4 x::"name" t::"trm4"  bind x in t
-
-thm alpha_trm4_raw_alpha_trm4_raw_list.intros[no_vars]
-thm fv_trm4_raw_fv_trm4_raw_list.simps[no_vars]
-
 (* example 5 from Terms.thy *)
 
 nominal_datatype trm5 =
@@ -220,61 +153,6 @@
   "bv5 Lnil = {}"
 | "bv5 (Lcons n t ltl) = {atom n} \<union> (bv5 ltl)"
 
-(* example 6 from Terms.thy *)
-
-(* BV is not respectful, needs to fail*)
-nominal_datatype trm6 =
-  Vr6 "name"
-| Lm6 x::"name" t::"trm6"         bind x in t
-| Lt6 left::"trm6" right::"trm6"  bind "bv6 left" in right
-binder
-  bv6
-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 *)
-
-(* BV is not respectful, needs to fail*)
-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"
-
-(* example 8 from Terms.thy *)
-
-nominal_datatype foo8 =
-  Foo0 "name"
-| Foo1 b::"bar8" f::"foo8" bind "bv8 b" in f --"check fo error if this is called foo"
-and bar8 =
-  Bar0 "name"
-| Bar1 "name" s::"name" b::"bar8" bind s in b
-binder 
-  bv8
-where
-  "bv8 (Bar0 x) = {}"
-| "bv8 (Bar1 v x b) = {atom v}"
-
-(* example 9 from Terms.thy *)
-
-(* BV is not respectful, needs to fail*)
-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
-binder
-  bv9
-where
-  "bv9 (Var9 x) = {}"
-| "bv9 (Lam9 x b) = {atom x}"
-
 (* example from my PHD *)
 
 atom_decl coname
@@ -303,7 +181,7 @@
 and body =
   Empty
 | Seq c::defn d::"body"     bind "cbinders c" in d
-and defn =  
+and defn =
   Type "name" "tyty"
 | Dty "name"
 | DStru "name" "mexp"
@@ -311,11 +189,11 @@
 and sexp =
   Sig sbody
 | SFunc "name" "sexp" "sexp"
-and sbody = 
+and sbody =
   SEmpty
 | SSeq C::spec D::sbody    bind "Cbinders C" in D
 and spec =
-  Type1 "name" 
+  Type1 "name"
 | Type2 "name" "tyty"
 | SStru "name" "sexp"
 | SVal "name" "tyty"
@@ -346,79 +224,6 @@
 | "Cbinders (SVal v T) = {atom v}"
 
 
-(* core haskell *)
-print_theorems
-
-atom_decl var
-atom_decl tvar
-
-
-(* there are types, coercion types and regular types *)
-nominal_datatype tkind = 
-  KStar
-| KFun "tkind" "tkind"
-and ckind =
-  CKEq "ty" "ty" 
-and ty =
-  TVar "tvar"
-| TC "string"
-| TApp "ty" "ty"
-| TFun "string" "ty list"
-| TAll tv::"tvar" "tkind" T::"ty"  bind tv in T
-| TEq "ty" "ty" "ty"
-and co =
-  CC "string"
-| CApp "co" "co"
-| CFun "string" "co list"
-| CAll tv::"tvar" "ckind" C::"co"  bind tv in C
-| CEq "co" "co" "co"
-| CSym "co"
-| CCir "co" "co"
-| CLeft "co"
-| CRight "co"
-| CSim "co"
-| CRightc "co"
-| CLeftc "co"
-| CCoe "co" "co"
-
-
-typedecl ty --"hack since ty is not yet defined"
-typedecl kind
-
-instance ty and kind:: pt
-sorry
-
-abbreviation 
-  "atoms A \<equiv> atom ` A"
-
-nominal_datatype trm =
-  Var "var"
-| C "string"
-| LAM tv::"tvar" "kind" t::"trm"   bind tv in t 
-| APP "trm" "ty"
-| Lam v::"var" "ty" t::"trm"       bind v in t
-| App "trm" "trm"
-| Let x::"var" "ty" "trm" t::"trm" bind x in t
-| Case "trm" "assoc list"
-| Cast "trm" "ty"                   --"ty is supposed to be a coercion type only"
-and assoc = 
-  A p::"pat" t::"trm" bind "bv p" in t 
-and pat = 
-  K "string" "(tvar \<times> kind) list" "(var \<times> ty) list"
-binder
- bv :: "pat \<Rightarrow> atom set"
-where
- "bv (K s ts vs) = (atoms (set (map fst ts))) \<union> (atoms (set (map fst vs)))"
-
-(*
-compat (K s ts vs) pi (K s' ts' vs') ==
-  s = s' & 
-
-*)
-
-
-(*thm bv_raw.simps*)
-
 (* example 3 from Peter Sewell's bestiary *)
 nominal_datatype exp =
   VarP "name"
@@ -454,6 +259,8 @@
 | "bp6 (PPair' p1 p2) = bp6 p1 \<union> bp6 p2"
 thm alpha_exp6_raw_alpha_pat6_raw_alpha_bp6_raw.intros
 
+(* THE REST ARE NOT SUPPOSED TO WORK YET *)
+
 (* example 7 from Peter Sewell's bestiary *)
 nominal_datatype exp7 =
   EVar name
@@ -512,6 +319,163 @@
 | "b_fnclause (K x pat exp8) = {atom x}"
 thm alpha_exp8_raw_alpha_fnclause_raw_alpha_fnclauses_raw_alpha_lrb8_raw_alpha_lrbs8_raw_alpha_pat8_raw.intros
 
+(* example 4 from Terms.thy *)
+(* fv_eqvt does not work, we need to repaire defined permute functions
+   defined fv and defined alpha... *)
+nominal_datatype trm4 =
+  Vr4 "name"
+| Ap4 "trm4" "trm4 list"
+| Lm4 x::"name" t::"trm4"  bind x in t
+
+thm alpha_trm4_raw_alpha_trm4_raw_list.intros[no_vars]
+thm fv_trm4_raw_fv_trm4_raw_list.simps[no_vars]
+
+(* core haskell *)
+atom_decl var
+atom_decl tvar
+
+(* there are types, coercion types and regular types *)
+nominal_datatype tkind =
+  KStar
+| KFun "tkind" "tkind"
+and ckind =
+  CKEq "ty" "ty"
+and ty =
+  TVar "tvar"
+| TC "string"
+| TApp "ty" "ty"
+| TFun "string" "ty list"
+| TAll tv::"tvar" "tkind" T::"ty"  bind tv in T
+| TEq "ty" "ty" "ty"
+and co =
+  CC "string"
+| CApp "co" "co"
+| CFun "string" "co list"
+| CAll tv::"tvar" "ckind" C::"co"  bind tv in C
+| CEq "co" "co" "co"
+| CSym "co"
+| CCir "co" "co"
+| CLeft "co"
+| CRight "co"
+| CSim "co"
+| CRightc "co"
+| CLeftc "co"
+| CCoe "co" "co"
+
+
+typedecl ty --"hack since ty is not yet defined"
+typedecl kind
+
+instance ty and kind:: pt
+sorry
+
+abbreviation
+  "atoms A \<equiv> atom ` A"
+
+nominal_datatype trm =
+  Var "var"
+| C "string"
+| LAM tv::"tvar" "kind" t::"trm"   bind tv in t
+| APP "trm" "ty"
+| Lam v::"var" "ty" t::"trm"       bind v in t
+| App "trm" "trm"
+| Let x::"var" "ty" "trm" t::"trm" bind x in t
+| Case "trm" "assoc list"
+| Cast "trm" "ty"                   --"ty is supposed to be a coercion type only"
+and assoc =
+  A p::"pat" t::"trm" bind "bv p" in t
+and pat =
+  K "string" "(tvar \<times> kind) list" "(var \<times> ty) list"
+binder
+ bv :: "pat \<Rightarrow> atom set"
+where
+ "bv (K s ts vs) = (atoms (set (map fst ts))) \<union> (atoms (set (map fst vs)))"
+
+(*
+compat (K s ts vs) pi (K s' ts' vs') ==
+  s = s' &
+
+*)
+
+
+
+text {* weirdo example from Peter Sewell's bestiary *}
+
+nominal_datatype weird =
+  WBind x::"name" y::"name" p1::"weird" p2::"weird" p3::"weird"
+    bind x in p1, bind x in p2, bind y in p2, bind y in p3
+| WV "name"
+| WP "weird" "weird"
+
+thm permute_weird_raw.simps[no_vars]
+thm alpha_weird_raw.intros[no_vars]
+thm fv_weird_raw.simps[no_vars]
+
+(* example 6 from Terms.thy *)
+
+(* BV is not respectful, needs to fail*)
+nominal_datatype trm6 =
+  Vr6 "name"
+| Lm6 x::"name" t::"trm6"         bind x in t
+| Lt6 left::"trm6" right::"trm6"  bind "bv6 left" in right
+binder
+  bv6
+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 *)
+
+(* BV is not respectful, needs to fail*)
+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"
+
+(* example 8 from Terms.thy *)
+
+(* Binding in a term under a bn, needs to fail *)
+nominal_datatype foo8 =
+  Foo0 "name"
+| Foo1 b::"bar8" f::"foo8" bind "bv8 b" in f --"check fo error if this is called foo"
+and bar8 =
+  Bar0 "name"
+| Bar1 "name" s::"name" b::"bar8" bind s in b
+binder
+  bv8
+where
+  "bv8 (Bar0 x) = {}"
+| "bv8 (Bar1 v x b) = {atom v}"
+
+(* example 9 from Terms.thy *)
+
+(* BV is not respectful, needs to fail*)
+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
+binder
+  bv9
+where
+  "bv9 (Var9 x) = {}"
+| "bv9 (Lam9 x b) = {atom x}"
+
+
+(* Type schemes with separate datatypes *)
+nominal_datatype t =
+  Var "name"
+| Fun "t" "t"
+
+nominal_datatype tyS =
+  All xs::"name list" ty::"t_raw" bind xs in ty
+
 
 
 




