--- 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
+