diff -r fb201e383f1b -r da575186d492 Attic/Quot/Examples/Terms.thy --- a/Attic/Quot/Examples/Terms.thy Tue Feb 19 05:38:46 2013 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,271 +0,0 @@ -theory Terms -imports Nominal "../Quotient" "../Quotient_List" -begin - -atom_decl name - -text {* primrec seems to be genarally faster than fun *} - -section {*** lets with binding patterns ***} - -datatype trm1 = - Vr1 "name" -| Ap1 "trm1" "trm1" -| Lm1 "name" "trm1" --"name is bound in trm1" -| Lt1 "bp" "trm1" "trm1" --"all variables in bp are bound in the 2nd trm1" -and bp = - BUnit -| BVr "name" -| BPr "bp" "bp" - -(* to be given by the user *) -primrec - bv1 -where - "bv1 (BUnit) = {}" -| "bv1 (BVr x) = {x}" -| "bv1 (BPr bp1 bp2) = (bv1 bp1) \ (bv1 bp1)" - -(* needs to be calculated by the package *) -primrec - fv_trm1 and fv_bp -where - "fv_trm1 (Vr1 x) = {x}" -| "fv_trm1 (Ap1 t1 t2) = (fv_trm1 t1) \ (fv_trm1 t2)" -| "fv_trm1 (Lm1 x t) = (fv_trm1 t) - {x}" -| "fv_trm1 (Lt1 bp t1 t2) = (fv_trm1 t1) \ (fv_trm1 t2 - bv1 bp)" -| "fv_bp (BUnit) = {}" -| "fv_bp (BVr x) = {x}" -| "fv_bp (BPr b1 b2) = (fv_bp b1) \ (fv_bp b2)" - -(* needs to be stated by the package *) -overloading - perm_trm1 \ "perm :: 'x prm \ trm1 \ trm1" (unchecked) - perm_bp \ "perm :: 'x prm \ bp \ bp" (unchecked) -begin - -primrec - perm_trm1 and perm_bp -where - "perm_trm1 pi (Vr1 a) = Vr1 (pi \ a)" -| "perm_trm1 pi (Ap1 t1 t2) = Ap1 (perm_trm1 pi t1) (perm_trm1 pi t2)" -| "perm_trm1 pi (Lm1 a t) = Lm1 (pi \ a) (perm_trm1 pi t)" -| "perm_trm1 pi (Lt1 bp t1 t2) = Lt1 (perm_bp pi bp) (perm_trm1 pi t1) (perm_trm1 pi t2)" -| "perm_bp pi (BUnit) = BUnit" -| "perm_bp pi (BVr a) = BVr (pi \ a)" -| "perm_bp pi (BPr bp1 bp2) = BPr (perm_bp pi bp1) (perm_bp pi bp2)" - -end - -inductive - alpha1 :: "trm1 \ trm1 \ bool" ("_ \1 _" [100, 100] 100) -where - a1: "a = b \ (Vr1 a) \1 (Vr1 b)" -| a2: "\t1 \1 t2; s1 \1 s2\ \ Ap1 t1 s1 \1 Ap1 t2 s2" -| a3: "\pi::name prm. (fv_trm1 t - {a} = fv_trm1 s - {b} \ - (fv_trm1 t - {a})\* pi \ - (pi \ t) \1 s \ (pi \ a) = b) - \ Lm1 a t \1 Lm1 b s" -| a4: "\pi::name prm.( - t1 \1 t2 \ - (fv_trm1 s1 - fv_bp b1 = fv_trm1 s2 - fv_bp b2) \ - (fv_trm1 s1 - fv_bp b1) \* pi \ - (pi \ s1 = s2) (* Optional: \ (pi \ b1 = b2) *) - ) \ Lt1 b1 t1 s1 \1 Lt1 b2 t2 s2" - -lemma alpha1_equivp: "equivp alpha1" sorry - -quotient_type qtrm1 = trm1 / alpha1 - by (rule alpha1_equivp) - - -section {*** lets with single assignments ***} - -datatype trm2 = - Vr2 "name" -| Ap2 "trm2" "trm2" -| Lm2 "name" "trm2" -| Lt2 "assign" "trm2" -and assign = - As "name" "trm2" - -(* to be given by the user *) -primrec - bv2 -where - "bv2 (As x t) = {x}" - -(* needs to be calculated by the package *) -primrec - fv_trm2 and fv_assign -where - "fv_trm2 (Vr2 x) = {x}" -| "fv_trm2 (Ap2 t1 t2) = (fv_trm2 t1) \ (fv_trm2 t2)" -| "fv_trm2 (Lm2 x t) = (fv_trm2 t) - {x}" -| "fv_trm2 (Lt2 as t) = (fv_trm2 t - bv2 as) \ (fv_assign as)" -| "fv_assign (As x t) = (fv_trm2 t)" - -(* needs to be stated by the package *) -overloading - perm_trm2 \ "perm :: 'x prm \ trm2 \ trm2" (unchecked) - perm_assign \ "perm :: 'x prm \ assign \ assign" (unchecked) -begin - -primrec - perm_trm2 and perm_assign -where - "perm_trm2 pi (Vr2 a) = Vr2 (pi \ a)" -| "perm_trm2 pi (Ap2 t1 t2) = Ap2 (perm_trm2 pi t1) (perm_trm2 pi t2)" -| "perm_trm2 pi (Lm2 a t) = Lm2 (pi \ a) (perm_trm2 pi t)" -| "perm_trm2 pi (Lt2 as t) = Lt2 (perm_assign pi as) (perm_trm2 pi t)" -| "perm_assign pi (As a t) = As (pi \ a) (perm_trm2 pi t)" - -end - -inductive - alpha2 :: "trm2 \ trm2 \ bool" ("_ \2 _" [100, 100] 100) -where - a1: "a = b \ (Vr2 a) \2 (Vr2 b)" -| a2: "\t1 \2 t2; s1 \2 s2\ \ Ap2 t1 s1 \2 Ap2 t2 s2" -| a3: "\pi::name prm. (fv_trm2 t - {a} = fv_trm2 s - {b} \ - (fv_trm2 t - {a})\* pi \ - (pi \ t) \2 s \ - (pi \ a) = b) - \ Lm2 a t \2 Lm2 b s" -| a4: "\pi::name prm. ( - fv_trm2 t1 - fv_assign b1 = fv_trm2 t2 - fv_assign b2 \ - (fv_trm2 t1 - fv_assign b1) \* pi \ - pi \ t1 = t2 (* \ (pi \ b1 = b2) *) - ) \ Lt2 b1 t1 \2 Lt2 b2 t2" - -lemma alpha2_equivp: "equivp alpha2" sorry - -quotient_type qtrm2 = trm2 / alpha2 - by (rule alpha2_equivp) - -section {*** lets with many assignments ***} - -datatype trm3 = - Vr3 "name" -| Ap3 "trm3" "trm3" -| Lm3 "name" "trm3" -| Lt3 "assigns" "trm3" -and assigns = - ANil -| ACons "name" "trm3" "assigns" - -(* to be given by the user *) -primrec - bv3 -where - "bv3 ANil = {}" -| "bv3 (ACons x t as) = {x} \ (bv3 as)" - -primrec - fv_trm3 and fv_assigns -where - "fv_trm3 (Vr3 x) = {x}" -| "fv_trm3 (Ap3 t1 t2) = (fv_trm3 t1) \ (fv_trm3 t2)" -| "fv_trm3 (Lm3 x t) = (fv_trm3 t) - {x}" -| "fv_trm3 (Lt3 as t) = (fv_trm3 t - bv3 as) \ (fv_assigns as)" -| "fv_assigns (ANil) = {}" -| "fv_assigns (ACons x t as) = (fv_trm3 t) \ (fv_assigns as)" - -(* needs to be stated by the package *) -overloading - perm_trm3 \ "perm :: 'x prm \ trm3 \ trm3" (unchecked) - perm_assigns \ "perm :: 'x prm \ assigns \ assigns" (unchecked) -begin - -primrec - perm_trm3 and perm_assigns -where - "perm_trm3 pi (Vr3 a) = Vr3 (pi \ a)" -| "perm_trm3 pi (Ap3 t1 t2) = Ap3 (perm_trm3 pi t1) (perm_trm3 pi t2)" -| "perm_trm3 pi (Lm3 a t) = Lm3 (pi \ a) (perm_trm3 pi t)" -| "perm_trm3 pi (Lt3 as t) = Lt3 (perm_assigns pi as) (perm_trm3 pi t)" -| "perm_assigns pi (ANil) = ANil" -| "perm_assigns pi (ACons a t as) = ACons (pi \ a) (perm_trm3 pi t) (perm_assigns pi as)" - -end - -inductive - alpha3 :: "trm3 \ trm3 \ bool" ("_ \3 _" [100, 100] 100) -where - a1: "a = b \ (Vr3 a) \3 (Vr3 b)" -| a2: "\t1 \3 t2; s1 \3 s2\ \ Ap3 t1 s1 \3 Ap3 t2 s2" -| a3: "\pi::name prm. (fv_trm3 t - {a} = fv_trm3 s - {b} \ - (fv_trm3 t - {a})\* pi \ - (pi \ t) \3 s \ - (pi \ a) = b) - \ Lm3 a t \3 Lm3 b s" -| a4: "\pi::name prm. ( - fv_trm3 t1 - fv_assigns b1 = fv_trm3 t2 - fv_assigns b2 \ - (fv_trm3 t1 - fv_assigns b1) \* pi \ - pi \ t1 = t2 (* \ (pi \ b1 = b2) *) - ) \ Lt3 b1 t1 \3 Lt3 b2 t2" - -lemma alpha3_equivp: "equivp alpha3" sorry - -quotient_type qtrm3 = trm3 / alpha3 - by (rule alpha3_equivp) - - -section {*** lam with indirect list recursion ***} - -datatype trm4 = - Vr4 "name" -| Ap4 "trm4" "trm4 list" -| Lm4 "name" "trm4" - -thm trm4.recs - -primrec - fv_trm4 and fv_trm4_list -where - "fv_trm4 (Vr4 x) = {x}" -| "fv_trm4 (Ap4 t ts) = (fv_trm4 t) \ (fv_trm4_list ts)" -| "fv_trm4 (Lm4 x t) = (fv_trm4 t) - {x}" -| "fv_trm4_list ([]) = {}" -| "fv_trm4_list (t#ts) = (fv_trm4 t) \ (fv_trm4_list ts)" - - -(* needs to be stated by the package *) -(* there cannot be a clause for lists, as *) -(* permutations are already defined in Nominal (also functions, options, and so on) *) -overloading - perm_trm4 \ "perm :: 'x prm \ trm4 \ trm4" (unchecked) -begin - -primrec - perm_trm4 -where - "perm_trm4 pi (Vr4 a) = Vr4 (pi \ a)" -| "perm_trm4 pi (Ap4 t ts) = Ap4 (perm_trm4 pi t) (pi \ ts)" -| "perm_trm4 pi (Lm4 a t) = Lm4 (pi \ a) (perm_trm4 pi t)" - -end - -inductive - alpha4 :: "trm4 \ trm4 \ bool" ("_ \4 _" [100, 100] 100) -and alpha4list :: "trm4 list \ trm4 list \ bool" ("_ \4list _" [100, 100] 100) -where - a1: "a = b \ (Vr4 a) \4 (Vr4 b)" -| a2: "\t1 \4 t2; s1 \4list s2\ \ Ap4 t1 s1 \4 Ap4 t2 s2" -| a4: "\pi::name prm. (fv_trm4 t - {a} = fv_trm4 s - {b} \ - (fv_trm4 t - {a})\* pi \ - (pi \ t) \4 s \ - (pi \ a) = b) - \ Lm4 a t \4 Lm4 b s" -| a5: "[] \4list []" -| a6: "\t \4 s; ts \4list ss\ \ (t#ts) \4list (s#ss)" - -lemma alpha4_equivp: "equivp alpha4" sorry -lemma alpha4list_equivp: "equivp alpha4list" sorry - -quotient_type - qtrm4 = trm4 / alpha4 and - qtrm4list = "trm4 list" / alpha4list - by (simp_all add: alpha4_equivp alpha4list_equivp) - -end