diff -r 014e7696ac6b -r 49e2d9744ae1 src/HOL/Nominal/Examples/Class.thy --- a/src/HOL/Nominal/Examples/Class.thy Tue Mar 06 08:09:43 2007 +0100 +++ b/src/HOL/Nominal/Examples/Class.thy Tue Mar 06 15:28:22 2007 +0100 @@ -1,26 +1,37 @@ (* $Id$ *) theory Class -imports "Nominal" +imports "../Nominal" begin section {* Term-Calculus from Urban's PhD *} atom_decl name coname +text {* types *} + +nominal_datatype ty = + PROP "string" + | NOT "ty" + | AND "ty" "ty" ("_ AND _" [100,100] 100) + | OR "ty" "ty" ("_ OR _" [100,100] 100) + | IMP "ty" "ty" ("_ IMPL _" [100,100] 100) + +text {* terms *} + nominal_datatype trm = Ax "name" "coname" - | Cut "\coname\trm" "\name\trm" ("Cut <_>._ [_]._" [100,100,100,100] 100) - | NotR "\name\trm" "coname" ("NotR [_]._ _" [100,100,100] 100) + | Cut "\coname\trm" "\name\trm" ("Cut <_>._ (_)._" [100,100,100,100] 100) + | NotR "\name\trm" "coname" ("NotR (_)._ _" [100,100,100] 100) | NotL "\coname\trm" "name" ("NotL <_>._ _" [100,100,100] 100) | AndR "\coname\trm" "\coname\trm" "coname" ("AndR <_>._ <_>._ _" [100,100,100,100,100] 100) - | AndL1 "\name\trm" "name" ("AndL1 [_]._ _" [100,100,100] 100) - | AndL2 "\name\trm" "name" ("AndL2 [_]._ _" [100,100,100] 100) + | AndL1 "\name\trm" "name" ("AndL1 (_)._ _" [100,100,100] 100) + | AndL2 "\name\trm" "name" ("AndL2 (_)._ _" [100,100,100] 100) | OrR1 "\coname\trm" "coname" ("OrR1 <_>._ _" [100,100,100] 100) | OrR2 "\coname\trm" "coname" ("OrR2 <_>._ _" [100,100,100] 100) - | OrL "\name\trm" "\name\trm" "name" ("OrL [_]._ [_]._ _" [100,100,100,100,100] 100) - | ImpR "\name\(\coname\trm)" "coname" ("ImpR [_].<_>._ _" [100,100,100,100] 100) - | ImpL "\coname\trm" "\name\trm" "name" ("ImpL <_>._ [_]._ _" [100,100,100,100,100] 100) + | OrL "\name\trm" "\name\trm" "name" ("OrL (_)._ (_)._ _" [100,100,100,100,100] 100) + | ImpR "\name\(\coname\trm)" "coname" ("ImpR (_).<_>._ _" [100,100,100,100] 100) + | ImpL "\coname\trm" "\name\trm" "name" ("ImpL <_>._ (_)._ _" [100,100,100,100,100] 100) text {* Induction principles *} @@ -30,24 +41,12 @@ text {* named terms *} -nominal_datatype ntrm = Na "\name\trm" ("([_]:_)" [100,100] 100) +nominal_datatype ntrm = Na "\name\trm" ("((_):_)" [100,100] 100) text {* conamed terms *} nominal_datatype ctrm = Co "\coname\trm" ("(<_>:_)" [100,100] 100) -lemma eq_eqvt_name[eqvt]: - fixes pi::"name prm" - and x::"'a::pt_name" - shows "pi\(x=y) = ((pi\x)=(pi\y))" - by (simp add: perm_bool perm_bij) - -lemma eq_eqvt_coname[eqvt]: - fixes pi::"coname prm" - and x::"'a::pt_coname" - shows "pi\(x=y) = ((pi\x)=(pi\y))" - by (simp add: perm_bool perm_bij) - text {* renaming functions *} consts @@ -56,49 +55,232 @@ nominal_primrec (freshness_context: "(d::coname,e::coname)") "(Ax x a)[d\c>e] = (if a=d then Ax x e else Ax x a)" - "\a\(d,e,N);x\M\ \ (Cut .M [x].N)[d\c>e] = Cut .(M[d\c>e]) [x].(N[d\c>e])" - "(NotR [x].M a)[d\c>e] = (if a=d then NotR [x].(M[d\c>e]) e else NotR [x].(M[d\c>e]) a)" + "\a\(d,e,N);x\M\ \ (Cut .M (x).N)[d\c>e] = Cut .(M[d\c>e]) (x).(N[d\c>e])" + "(NotR (x).M a)[d\c>e] = (if a=d then NotR (x).(M[d\c>e]) e else NotR (x).(M[d\c>e]) a)" "a\(d,e) \ (NotL .M x)[d\c>e] = (NotL .(M[d\c>e]) x)" "\a\(d,e,N,c);b\(d,e,M,c);b\a\ \ (AndR .M .N c)[d\c>e] = (if c=d then AndR .(M[d\c>e]) .(N[d \c>e]) e else AndR .(M[d\c>e]) .(N[d\c>e]) c)" - "x\y \ (AndL1 [x].M y)[d\c>e] = AndL1 [x].(M[d\c>e]) y" - "x\y \ (AndL2 [x].M y)[d\c>e] = AndL2 [x].(M[d\c>e]) y" + "x\y \ (AndL1 (x).M y)[d\c>e] = AndL1 (x).(M[d\c>e]) y" + "x\y \ (AndL2 (x).M y)[d\c>e] = AndL2 (x).(M[d\c>e]) y" "a\(d,e,b) \ (OrR1 .M b)[d\c>e] = (if b=d then OrR1 .(M[d\c>e]) e else OrR1 .(M[d\c>e]) b)" "a\(d,e,b) \ (OrR2 .M b)[d\c>e] = (if b=d then OrR2 .(M[d\c>e]) e else OrR2 .(M[d\c>e]) b)" - "\x\(N,z);y\(M,z);y\x\ \ (OrL [x].M [y].N z)[d\c>e] = OrL [x].(M[d\c>e]) [y].(N[d\c>e]) z" - "a\(d,e,b) \ (ImpR [x]..M b)[d\c>e] = - (if b=d then ImpR [x]..(M[d\c>e]) e else ImpR [x]..(M[d\c>e]) b)" - "\a\(d,e,N);x\(M,y)\ \ (ImpL .M [x].N y)[d\c>e] = ImpL .(M[d\c>e]) [x].(N[d\c>e]) y" -apply(finite_guess add: eqvt perm_if fs_coname1 fs_name1 | - perm_simp add: abs_fresh abs_supp fs_name1 fs_coname1)+ -apply(fresh_guess add: eqvt perm_if fs_coname1 fs_name1 | perm_simp add: fresh_atm)+ + "\x\(N,z);y\(M,z);y\x\ \ (OrL (x).M (y).N z)[d\c>e] = OrL (x).(M[d\c>e]) (y).(N[d\c>e]) z" + "a\(d,e,b) \ (ImpR (x)..M b)[d\c>e] = + (if b=d then ImpR (x)..(M[d\c>e]) e else ImpR (x)..(M[d\c>e]) b)" + "\a\(d,e,N);x\(M,y)\ \ (ImpL .M (x).N y)[d\c>e] = ImpL .(M[d\c>e]) (x).(N[d\c>e]) y" +apply(finite_guess)+ +apply(rule TrueI)+ +apply(simp add: abs_fresh abs_supp fin_supp)+ +apply(fresh_guess)+ done nominal_primrec (freshness_context: "(u::name,v::name)") "(Ax x a)[u\n>v] = (if x=u then Ax v a else Ax x a)" - "\a\N;x\(u,v,M)\ \ (Cut .M [x].N)[u\n>v] = Cut .(M[u\n>v]) [x].(N[u\n>v])" - "x\(u,v) \ (NotR [x].M a)[u\n>v] = NotR [x].(M[u\n>v]) a" + "\a\N;x\(u,v,M)\ \ (Cut .M (x).N)[u\n>v] = Cut .(M[u\n>v]) (x).(N[u\n>v])" + "x\(u,v) \ (NotR (x).M a)[u\n>v] = NotR (x).(M[u\n>v]) a" "(NotL .M x)[u\n>v] = (if x=u then NotL .(M[u\n>v]) v else NotL .(M[u\n>v]) x)" "\a\(N,c);b\(M,c);b\a\ \ (AndR .M .N c)[u\n>v] = AndR .(M[u\n>v]) .(N[u\n>v]) c" - "x\(u,v,y) \ (AndL1 [x].M y)[u\n>v] = (if y=u then AndL1 [x].(M[u\n>v]) v else AndL1 [x].(M[u\n>v]) y)" - "x\(u,v,y) \ (AndL2 [x].M y)[u\n>v] = (if y=u then AndL2 [x].(M[u\n>v]) v else AndL2 [x].(M[u\n>v]) y)" + "x\(u,v,y) \ (AndL1 (x).M y)[u\n>v] = (if y=u then AndL1 (x).(M[u\n>v]) v else AndL1 (x).(M[u\n>v]) y)" + "x\(u,v,y) \ (AndL2 (x).M y)[u\n>v] = (if y=u then AndL2 (x).(M[u\n>v]) v else AndL2 (x).(M[u\n>v]) y)" "a\b \ (OrR1 .M b)[u\n>v] = OrR1 .(M[u\n>v]) b" "a\b \ (OrR2 .M b)[u\n>v] = OrR2 .(M[u\n>v]) b" - "\x\(u,v,N,z);y\(u,v,M,z);y\x\ \ (OrL [x].M [y].N z)[u\n>v] = - (if z=u then OrL [x].(M[u\n>v]) [y].(N[u\n>v]) v else OrL [x].(M[u\n>v]) [y].(N[u\n>v]) z)" - "\a\b; x\(u,v)\ \ (ImpR [x]..M b)[u\n>v] = ImpR [x]..(M[u\n>v]) b" - "\a\N;x\(u,v,M,y)\ \ (ImpL .M [x].N y)[u\n>v] = - (if y=u then ImpL .(M[u\n>v]) [x].(N[u\n>v]) v else ImpL .(M[u\n>v]) [x].(N[u\n>v]) y)" -apply(finite_guess add: eqvt perm_if fs_coname1 fs_name1 | - perm_simp add: abs_fresh abs_supp fresh_prod fs_name1 fs_coname1)+ -apply(fresh_guess add: eqvt perm_if fs_coname1 fs_name1 | perm_simp add: fresh_atm)+ + "\x\(u,v,N,z);y\(u,v,M,z);y\x\ \ (OrL (x).M (y).N z)[u\n>v] = + (if z=u then OrL (x).(M[u\n>v]) (y).(N[u\n>v]) v else OrL (x).(M[u\n>v]) (y).(N[u\n>v]) z)" + "\a\b; x\(u,v)\ \ (ImpR (x)..M b)[u\n>v] = ImpR (x)..(M[u\n>v]) b" + "\a\N;x\(u,v,M,y)\ \ (ImpL .M (x).N y)[u\n>v] = + (if y=u then ImpL .(M[u\n>v]) (x).(N[u\n>v]) v else ImpL .(M[u\n>v]) (x).(N[u\n>v]) y)" +apply(finite_guess)+ +apply(rule TrueI)+ +apply(simp add: abs_fresh abs_supp fs_name1 fs_coname1)+ +apply(fresh_guess)+ +done + +lemmas eq_bij = pt_bij[OF pt_name_inst, OF at_name_inst] pt_bij[OF pt_coname_inst, OF at_coname_inst] + + +lemma crename_name_eqvt[eqvt]: + fixes pi::"name prm" + shows "pi\(M[d\c>e]) = (pi\M)[(pi\d)\c>(pi\e)]" +apply(nominal_induct M avoiding: d e rule: trm.induct) +apply(auto simp add: fresh_bij eq_bij) +done + + +lemma crename_coname_eqvt[eqvt]: + fixes pi::"coname prm" + shows "pi\(M[d\c>e]) = (pi\M)[(pi\d)\c>(pi\e)]" +apply(nominal_induct M avoiding: d e rule: trm.induct) +apply(auto simp add: fresh_bij eq_bij) +done + +lemma nrename_name_eqvt[eqvt]: + fixes pi::"name prm" + shows "pi\(M[x\n>y]) = (pi\M)[(pi\x)\n>(pi\y)]" +apply(nominal_induct M avoiding: x y rule: trm.induct) +apply(auto simp add: fresh_bij eq_bij) +done + +lemma nrename_coname_eqvt[eqvt]: + fixes pi::"coname prm" + shows "pi\(M[x\n>y]) = (pi\M)[(pi\x)\n>(pi\y)]" +apply(nominal_induct M avoiding: x y rule: trm.induct) +apply(auto simp add: fresh_bij eq_bij) +done + +text {* substitution functions *} + +consts + substn :: "trm \ name \ coname \ trm \ trm" ("_[_:=<_>._]" [100,100,100,100] 100) + substc :: "trm \ coname \ name \ trm \ trm" ("_[_:=(_)._]" [100,100,100,100] 100) + +nominal_primrec (freshness_context: "(y::name,c::coname,P::trm)") + "(Ax x a)[y:=.P] = (if x=y then P[c\c>a] else Ax x a)" + "\a\(c,P,N);x\(y,c,P,M)\ \ + (Cut .M (x).N)[y:=.P] = Cut .(M[y:=.P]) (x).(N[y:=.P])" + "x\(y,c,P) \ + (NotR (x).M a)[y:=.P] = NotR (x).(M[y:=.P]) a" + "a\(c,P)\ + (NotL .M x)[y:=.P] = (if x=y then Cut .P (x).(NotL . (M[y:=.P]) x) + else NotL . (M[y:=.P]) x)" + "\a\(c,P,N,d);b\(c,P,M,d);b\a\ \ + (AndR .M .N d)[y:=.P] = AndR .(M[y:=.P]) .(N[y:=.P]) d" + "x\(y,c,P,z) \ + (AndL1 (x).M z)[y:=.P] = (if z=y then Cut .P (z).AndL1 (x).(M[y:=.P]) z + else AndL1 (x).(M[y:=.P]) z)" + "x\(y,c,P,z) \ + (AndL2 (x).M z)[y:=.P] = (if z=y then Cut .P (z).AndL2 (x).(M[y:=.P]) z + else AndL2 (x).(M[y:=.P]) z)" + "a\(c,P,b) \ + (OrR1 .M b)[y:=.P] = OrR1 .(M[y:=.P]) b" + "a\(c,P,b) \ + (OrR2 .M b)[y:=.P] = OrR2 .(M[y:=.P]) b" + "\x\(y,N,c,P,z);u\(y,M,c,P,z);x\u\ \ + (OrL (x).M (u).N z)[y:=.P] = (if z=y then Cut .P (z).(OrL (x).(M[y:=.P]) (u).(N[y:=.P]) z) + else OrL (x).(M[y:=.P]) (u).(N[y:=.P]) z)" + "\a\(b,c,P); x\(y,c,P)\ \ + (ImpR (x)..M b)[y:=.P] = ImpR (x)..(M[y:=.P]) b" + "\a\(N,c,P);x\(y,c,P,M,z)\ \ + (ImpL .M (x).N z)[y:=.P] = (if y=z then Cut .P (z).(ImpL .(M[y:=.P]) (x).(N[y:=.P]) z) + else ImpL .(M[y:=.P]) (x).(N[y:=.P]) z)" +apply(finite_guess)+ +apply(rule TrueI)+ +apply(simp add: abs_fresh abs_supp fs_name1 fs_coname1)+ +apply(fresh_guess)+ done -text {* We should now define the two forms of substitition :o( *} +text {* typing contexts *} + +types + ctxtn = "(name\ty) list" + ctxtc = "(coname\ty) list" + +inductive2 + validc :: "ctxtc \ bool" +where + vc1[intro]: "validc []" +| vc2[intro]: "\a\\; validc \\ \ validc ((a,T)#\)" + +inductive2 + validn :: "ctxtn \ bool" +where + vn1[intro]: "validn []" +| vn2[intro]: "\x\\; validn \\ \ validn ((x,T)#\)" + +text {* typing relation *} + +inductive2 + typing :: "ctxtn \ trm \ ctxtc \ bool" ("_ \ _ \ _" [100,100,100] 100) +where + "\validn \;validc \; (x,B)\set \; (a,B)\set \\ \ \ \ Ax x a \ \" +| "\x\\; ((x,B)#\) \ M \ \\ \ \ \ NotR (x).M a \ ((a,NOT B)#\)" +| "\a\\; \ \ M \ ((a,B)#\)\ \ ((x,NOT B)#\) \ NotL .M x \ \" +| "\x\\; ((x,B1)#\) \ M \ \\ \ ((y,B1 AND B2)#\) \ AndL1 (x).M y \ \" +| "\x\\; ((x,B2)#\) \ M \ \\ \ ((y,B1 AND B2)#\) \ AndL2 (x).M y \ \" +| "\a\\;b\\; \ \ M \ ((a,B)#\); \ \ N \ ((b,C)#\)\ \ \ \ AndR .M .N c \ ((c,B AND C)#\)" +| "\x\\;y\\; ((x,B)#\) \ M \ \; ((y,C)#\) \ N \ \\ \ ((z,B OR C)#\) \ OrL (x).M (y).N z \ \" +| "\a\\; \ \ M \ ((a,B1)#\)\ \ \ \ OrR1 .M b \ ((b,B1 OR B2)#\)" +| "\a\\; \ \ M \ ((a,B2)#\)\ \ \ \ OrR2 .M b \ ((b,B1 OR B2)#\)" +| "\a\\;x\\; \ \ M \ ((a,B)#\); ((x,C)#\) \ N \ \\ \ ((y,B IMPL C)#\) \ ImpL .M (x).N y \ \" +| "\a\\;x\\; ((x,B)#\) \ M \ ((a,C)#\)\ \ \ \ ImpR (x)..M b \ ((b,B IMPL C)#\)" +| "\a\\1;x\\2; validn(\1@\2); validc (\1@\2); \1 \ M \ ((a,B)#\1); ((x,B)#\2) \ N \ \2\ + \ (\1@\2) \ Cut .M (x).N \ (\1@\2)" + +text {* relations about freshly introducing a name or coname *} + +inductive2 + fin :: "trm \ name \ bool" +where + "fin (Ax x a,x)" +| "x\M \ fin (NotL .M x,x)" +| "y\[x].M \ fin (AndL1 (x).M y,y)" +| "y\[x].M \ fin (AndL2 (x).M y,y)" +| "\z\[x].M;z\[y].N\ \ fin (OrL (x).M (y).N z,z)" +| "\y\M;y\[x].N\ \ fin (ImpL .M (x).N y,y)" -consts - substn :: "trm \ name \ ctrm \ trm" ("_[_::n=_]" [100,100,100] 100) - substc :: "trm \ coname \ ntrm \ trm" ("_[_::c=_]" [100,100,100] 100) +inductive2 + fic :: "trm \ coname \ bool" +where + "fic (Ax x a,a)" +| "a\M \ fic (NotR (x).M a,a)" +| "\c\[a].M;c\[b].N\ \ fic (AndR .M .N c,c)" +| "b\[a].M \ fic (OrR1 .M b,b)" +| "b\[a].M \ fic (OrR2 .M b,b)" +| "\b\[a].M\ \ fic (ImpR (x)..M b,b)" + +text {* cut-reductions *} + +inductive2 + red :: "trm \ trm \ bool" ("_ \\<^isub>c _" [100,100] 100) +where + "fic (M,a) \ Cut .M (x).(Ax x b) \\<^isub>c M[a\c>b]" +| "fin (M,x) \ Cut .(Ax y a) (x).M \\<^isub>c M[x\n>y]" +| "\fic (NotR (x).M a,a); fin (NotL .N y,y)\ \ + Cut .(NotR (x).M a) (y).(NotL .N y) \\<^isub>c Cut .N (x).M" +| "\fic (AndR .M1 .M2 b,b); fin (AndL1 (x).N y,y)\ \ + Cut .(AndR .M1 .M2 b) (y).(AndL1 (x).N y) \\<^isub>c Cut .M1 (x).N" +| "\fic (AndR .M1 .M2 b,b); fin (AndL2 (x).N y,y)\ \ + Cut .(AndR .M1 .M2 b) (y).(AndL2 (x).N y) \\<^isub>c Cut .M2 (x).N" +| "\fic (AndR .M1 .M2 b,b); fin (AndL1 (x).N y,y)\ \ + Cut .(AndR .M1 .M2 b) (y).(AndL1 (x).N y) \\<^isub>c Cut .M1 (x).N" +| "\fic (OrR1 .M b,b); fin (OrL (x1).N1 (x2).N2 y,y)\ \ + Cut .(OrR1 .M b) (y).(OrL (x1).N1 (x2).N2 y) \\<^isub>c Cut .M (x1).N1" +| "\fic (OrR2 .M b,b); fin (OrL (x1).N1 (x2).N2 y,y)\ \ + Cut .(OrR2 .M b) (y).(OrL (x1).N1 (x2).N2 y) \\<^isub>c Cut .M (x2).N2" +| "\fin (ImpL .N (y).P z,z); fic (ImpR (x)..M b,b)\ \ + Cut .(ImpR (x)..M b) (z).(ImpL .N (y).P z) \\<^isub>c Cut .(Cut .N (x).M) (y).P" +| "\fin (ImpL .N (y).P z,z); fic (ImpR (x)..M b,b)\ \ + Cut .(ImpR (x)..M b) (z).(ImpL .N (y).P z) \\<^isub>c Cut .N (x).(Cut .M (y).P)" +| "\fic (M,a) \ Cut .M (x).N \\<^isub>c M[a:=(x).N]" +| "\fin (N,x) \ Cut .M (x).N \\<^isub>c N[x:=.M]" + +text {* PROOFS *} + +lemma validn_eqvt[eqvt]: + fixes pi1:: "name prm" + and pi2:: "coname prm" + assumes a: "validn \" + shows "validn (pi1\\)" and "validn (pi2\\)" +using a by (induct) (auto simp add: fresh_bij) + +lemma validc_eqvt[eqvt]: + fixes pi1:: "name prm" + and pi2:: "coname prm" + assumes a: "validc \" + shows "validc (pi1\\)" and "validc (pi2\\)" +using a by (induct) (auto simp add: fresh_bij) + +text {* Weakening Lemma *} + +abbreviation + "subn" :: "ctxtn \ ctxtn \ bool" (" _ \n _ " [80,80] 80) +where + "\1 \n \2 \ \x B. (x,B)\set \1 \ (x,B)\set \2" + +abbreviation + "subc" :: "ctxtc \ ctxtc \ bool" (" _ \c _ " [80,80] 80) +where + "\1 \c \2 \ \a B. (a,B)\set \1 \ (a,B)\set \2" + end