theory Terms

imports "Nominal2_Atoms" "Nominal2_Eqvt" "Nominal2_Supp" "../QuotMain" "Abs"

begin

atom_decl name

text {* primrec seems to be genarally faster than fun *}

section {*** lets with binding patterns ***}

datatype rtrm1 =

  rVr1 "name"

| rAp1 "rtrm1" "rtrm1"

| rLm1 "name" "rtrm1"        --"name is bound in trm1"

| rLt1 "bp" "rtrm1" "rtrm1"   --"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) = {atom x}"

| "bv1 (BPr bp1 bp2) = (bv1 bp1) \<union> (bv1 bp1)"

(* needs to be calculated by the package *)

primrec 

  rfv_trm1 and rfv_bp

where

  "rfv_trm1 (rVr1 x) = {atom x}"

| "rfv_trm1 (rAp1 t1 t2) = (rfv_trm1 t1) \<union> (rfv_trm1 t2)"

| "rfv_trm1 (rLm1 x t) = (rfv_trm1 t) - {atom x}"

| "rfv_trm1 (rLt1 bp t1 t2) = (rfv_trm1 t1) \<union> (rfv_trm1 t2 - bv1 bp)"

| "rfv_bp (BUnit) = {}"

| "rfv_bp (BVr x) = {atom x}"

| "rfv_bp (BPr b1 b2) = (rfv_bp b1) \<union> (rfv_bp b2)"

(* needs to be stated by the package *)

instantiation 

  rtrm1 and bp :: pt

begin

primrec

  permute_rtrm1 and permute_bp

where

  "permute_rtrm1 pi (rVr1 a) = rVr1 (pi \<bullet> a)"

| "permute_rtrm1 pi (rAp1 t1 t2) = rAp1 (permute_rtrm1 pi t1) (permute_rtrm1 pi t2)"

| "permute_rtrm1 pi (rLm1 a t) = rLm1 (pi \<bullet> a) (permute_rtrm1 pi t)"

| "permute_rtrm1 pi (rLt1 bp t1 t2) = rLt1 (permute_bp pi bp) (permute_rtrm1 pi t1) (permute_rtrm1 pi t2)"

| "permute_bp pi (BUnit) = BUnit"

| "permute_bp pi (BVr a) = BVr (pi \<bullet> a)"

| "permute_bp pi (BPr bp1 bp2) = BPr (permute_bp pi bp1) (permute_bp pi bp2)"

lemma pt_rtrm1_bp_zero:

  fixes t::rtrm1

  and   b::bp

  shows "0 \<bullet> t = t"

  and   "0 \<bullet> b = b"

apply(induct t and b rule: rtrm1_bp.inducts)

apply(simp_all)

done

lemma pt_rtrm1_bp_plus:

  fixes t::rtrm1

  and   b::bp

  shows "((p + q) \<bullet> t) = p \<bullet> (q \<bullet> t)"

  and   "((p + q) \<bullet> b) = p \<bullet> (q \<bullet> b)"

apply(induct t and b rule: rtrm1_bp.inducts)

apply(simp_all)

done

instance

apply default

apply(simp_all add: pt_rtrm1_bp_zero pt_rtrm1_bp_plus)

done

end

inductive

  alpha1 :: "rtrm1 \<Rightarrow> rtrm1 \<Rightarrow> bool" ("_ \<approx>1 _" [100, 100] 100)

where

  a1: "a = b \<Longrightarrow> (rVr1 a) \<approx>1 (rVr1 b)"

| a2: "\<lbrakk>t1 \<approx>1 t2; s1 \<approx>1 s2\<rbrakk> \<Longrightarrow> rAp1 t1 s1 \<approx>1 rAp1 t2 s2"

| a3: "(\<exists>pi. (({atom aa}, t) \<approx>gen alpha1 rfv_trm1 pi ({atom ab}, s))) \<Longrightarrow> rLm1 aa t \<approx>1 rLm1 ab s"

| a4: "t1 \<approx>1 t2 \<Longrightarrow> (\<exists>pi. (((bv1 b1), s1) \<approx>gen alpha1 rfv_trm1 pi ((bv1 b2), s2))) \<Longrightarrow> rLt1 b1 t1 s1 \<approx>1 rLt1 b2 t2 s2"

"(rVr1 a \<approx>1 rVr1 b) = (a = b)"

"(rAp1 t1 s1 \<approx>1 rAp1 t2 s2) = (t1 \<approx>1 t2 \<and> s1 \<approx>1 s2)"

"(rLm1 aa t \<approx>1 rLm1 ab s) = (\<exists>pi. (({atom aa}, t) \<approx>gen alpha1 rfv_trm1 pi ({atom ab}, s)))"

"(rLt1 b1 t1 s1 \<approx>1 rLt1 b2 t2 s2) = (t1 \<approx>1 t2 \<and> (\<exists>pi. (((bv1 b1), s1) \<approx>gen alpha1 rfv_trm1 pi ((bv1 b2), s2))))"

apply -

apply rule apply (erule alpha1.cases) apply (simp_all add: alpha1.intros)

apply rule apply (erule alpha1.cases) apply (simp_all add: alpha1.intros)

apply rule apply (erule alpha1.cases) apply (simp_all add: alpha1.intros)

apply rule apply (erule alpha1.cases) apply (simp_all add: alpha1.intros)

done

  shows "(pi\<bullet>rfv_trm1 t) = rfv_trm1 (pi\<bullet>t)"

  sorry

lemma alpha1_eqvt:

  shows "t \<approx>1 s \<Longrightarrow> (pi \<bullet> t) \<approx>1 (pi \<bullet> s)"

  sorry

lemma alpha1_equivp: "equivp alpha1" 

  sorry

quotient_type trm1 = rtrm1 / alpha1

  by (rule alpha1_equivp)

quotient_definition

  "Vr1 :: name \<Rightarrow> trm1"

as

  "rVr1"

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) = {atom x}"

(* needs to be calculated by the package *)

primrec

  fv_trm2 and fv_assign

where

  "fv_trm2 (Vr2 x) = {atom x}"

| "fv_trm2 (Ap2 t1 t2) = (fv_trm2 t1) \<union> (fv_trm2 t2)"

| "fv_trm2 (Lm2 x t) = (fv_trm2 t) - {atom x}"

| "fv_trm2 (Lt2 as t) = (fv_trm2 t - bv2 as) \<union> (fv_assign as)"

| "fv_assign (As x t) = (fv_trm2 t)"

(* needs to be stated by the package *)

instantiation 

  trm2 and assign :: pt

begin

primrec

  permute_trm2 and permute_assign

where

  "permute_trm2 pi (Vr2 a) = Vr2 (pi \<bullet> a)"

| "permute_trm2 pi (Ap2 t1 t2) = Ap2 (permute_trm2 pi t1) (permute_trm2 pi t2)"

| "permute_trm2 pi (Lm2 a t) = Lm2 (pi \<bullet> a) (permute_trm2 pi t)"

| "permute_trm2 pi (Lt2 as t) = Lt2 (permute_assign pi as) (permute_trm2 pi t)"

| "permute_assign pi (As a t) = As (pi \<bullet> a) (permute_trm2 pi t)"

lemma pt_trm2_assign_zero:

  fixes t::trm2

  and   b::assign

  shows "0 \<bullet> t = t"

  and   "0 \<bullet> b = b"

apply(induct t and b rule: trm2_assign.inducts)

apply(simp_all)

done

lemma pt_trm2_assign_plus:

  fixes t::trm2

  and   b::assign

  shows "((p + q) \<bullet> t) = p \<bullet> (q \<bullet> t)"

  and   "((p + q) \<bullet> b) = p \<bullet> (q \<bullet> b)"

apply(induct t and b rule: trm2_assign.inducts)

apply(simp_all)

done

instance

apply default

apply(simp_all add: pt_trm2_assign_zero pt_trm2_assign_plus)

done

end

inductive

  alpha2 :: "trm2 \<Rightarrow> trm2 \<Rightarrow> bool" ("_ \<approx>2 _" [100, 100] 100)

where

  a1: "a = b \<Longrightarrow> (Vr2 a) \<approx>2 (Vr2 b)"

| a2: "\<lbrakk>t1 \<approx>2 t2; s1 \<approx>2 s2\<rbrakk> \<Longrightarrow> Ap2 t1 s1 \<approx>2 Ap2 t2 s2"

| a3: "\<exists>pi. (fv_trm2 t - {atom a} = fv_trm2 s - {atom b} \<and> 

            (fv_trm2 t - {atom a})\<sharp>* pi \<and> 

            (pi \<bullet> t) \<approx>2 s \<and> 

            (pi \<bullet> a) = b)

       \<Longrightarrow> Lm2 a t \<approx>2 Lm2 b s"

| a4: "\<exists>pi. (

         fv_trm2 t1 - fv_assign b1 = fv_trm2 t2 - fv_assign b2 \<and>

         (fv_trm2 t1 - fv_assign b1) \<sharp>* pi \<and>

         pi \<bullet> t1 = t2       (* \<and> (pi \<bullet> b1 = b2) *)

       ) \<Longrightarrow> Lt2 b1 t1 \<approx>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) = {atom x} \<union> (bv3 as)"

primrec

  fv_trm3 and fv_assigns

where

  "fv_trm3 (Vr3 x) = {atom x}"

| "fv_trm3 (Ap3 t1 t2) = (fv_trm3 t1) \<union> (fv_trm3 t2)"

| "fv_trm3 (Lm3 x t) = (fv_trm3 t) - {atom x}"

| "fv_trm3 (Lt3 as t) = (fv_trm3 t - bv3 as) \<union> (fv_assigns as)"

| "fv_assigns (ANil) = {}"

| "fv_assigns (ACons x t as) = (fv_trm3 t) \<union> (fv_assigns as)"

(* needs to be stated by the package *)

instantiation

 trm3 and assigns :: pt

begin

primrec

  permute_trm3 and permute_assigns

where

  "permute_trm3 pi (Vr3 a) = Vr3 (pi \<bullet> a)"

| "permute_trm3 pi (Ap3 t1 t2) = Ap3 (permute_trm3 pi t1) (permute_trm3 pi t2)"

| "permute_trm3 pi (Lm3 a t) = Lm3 (pi \<bullet> a) (permute_trm3 pi t)"

| "permute_trm3 pi (Lt3 as t) = Lt3 (permute_assigns pi as) (permute_trm3 pi t)"

| "permute_assigns pi (ANil) = ANil"

| "permute_assigns pi (ACons a t as) = ACons (pi \<bullet> a) (permute_trm3 pi t) (permute_assigns pi as)"

lemma pt_trm3_assigns_zero:

  fixes t::trm3

  and   b::assigns

  shows "0 \<bullet> t = t"

  and   "0 \<bullet> b = b"

apply(induct t and b rule: trm3_assigns.inducts)

apply(simp_all)

done

lemma pt_trm3_assigns_plus:

  fixes t::trm3

  and   b::assigns

  shows "((p + q) \<bullet> t) = p \<bullet> (q \<bullet> t)"

  and   "((p + q) \<bullet> b) = p \<bullet> (q \<bullet> b)"

apply(induct t and b rule: trm3_assigns.inducts)

apply(simp_all)

done

instance

apply default

apply(simp_all add: pt_trm3_assigns_zero pt_trm3_assigns_plus)

done

end

inductive

  alpha3 :: "trm3 \<Rightarrow> trm3 \<Rightarrow> bool" ("_ \<approx>3 _" [100, 100] 100)

where

  a1: "a = b \<Longrightarrow> (Vr3 a) \<approx>3 (Vr3 b)"

| a2: "\<lbrakk>t1 \<approx>3 t2; s1 \<approx>3 s2\<rbrakk> \<Longrightarrow> Ap3 t1 s1 \<approx>3 Ap3 t2 s2"

| a3: "\<exists>pi. (fv_trm3 t - {atom a} = fv_trm3 s - {atom b} \<and> 

             (fv_trm3 t - {atom a})\<sharp>* pi \<and> 

             (pi \<bullet> t) \<approx>3 s \<and> 

             (pi \<bullet> a) = b)

       \<Longrightarrow> Lm3 a t \<approx>3 Lm3 b s"

| a4: "\<exists>pi. (

         fv_trm3 t1 - fv_assigns b1 = fv_trm3 t2 - fv_assigns b2 \<and>

         (fv_trm3 t1 - fv_assigns b1) \<sharp>* pi \<and>

         pi \<bullet> t1 = t2      (* \<and> (pi \<bullet> b1 = b2)  *)

       ) \<Longrightarrow> Lt3 b1 t1 \<approx>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) = {atom x}"

| "fv_trm4 (Ap4 t ts) = (fv_trm4 t) \<union> (fv_trm4_list ts)"

| "fv_trm4 (Lm4 x t) = (fv_trm4 t) - {atom x}"

| "fv_trm4_list ([]) = {}"

| "fv_trm4_list (t#ts) = (fv_trm4 t) \<union> (fv_trm4_list ts)"

(* needs to be stated by the package *)

(* there cannot be a clause for lists, as *) 

(* permuteutations are  already defined in Nominal (also functions, options, and so on) *)

instantiation

  trm4 :: pt

begin

(* does not work yet *)

primrec

  permute_trm4  and permute_trm4_list

where

  "permute_trm4 pi (Vr4 a) = Vr4 (pi \<bullet> a)"

| "permute_trm4 pi (Ap4 t ts) = Ap4 (permute_trm4 pi t) (permute_trm4_list pi ts)"

| "permute_trm4 pi (Lm4 a t) = Lm4 (pi \<bullet> a) (permute_trm4 pi t)"

| "permute_trm4_list pi ([]) = []"

| "permute_trm4_list pi (t#ts) = (permute_trm4 pi t) # (permute_trm4_list pi ts)"

lemma pt_trm4_list_zero:

  fixes t::trm4

  and   ts::"trm4 list"

  shows "0 \<bullet> t = t"

  and   "permute_trm4_list 0 ts = ts"

apply(induct t and ts rule: trm4.inducts)

apply(simp_all)

done

lemma pt_trm4_list_plus:

  fixes t::trm4

  and   ts::"trm4 list"

  shows "((p + q) \<bullet> t) = p \<bullet> (q \<bullet> t)"

  and   "(permute_trm4_list (p + q) ts) = permute_trm4_list p (permute_trm4_list q ts)"

apply(induct t and ts rule: trm4.inducts)

apply(simp_all)

done