diff -r f76f187c91f9 -r 340cb955008e src/HOL/Nominal/Examples/Class.thy --- a/src/HOL/Nominal/Examples/Class.thy Fri Feb 02 17:16:16 2007 +0100 +++ b/src/HOL/Nominal/Examples/Class.thy Sat Feb 03 23:42:55 2007 +0100 @@ -1,7 +1,7 @@ (* $Id$ *) theory Class -imports "../Nominal" +imports "Nominal" begin section {* Term-Calculus from Urban's PhD *} @@ -22,7 +22,6 @@ | 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 *} thm trm.induct_weak --"weak" @@ -31,20 +30,75 @@ text {* named terms *} -nominal_datatype ntrm = N "\name\trm" ("N (_)._" [100,100] 100) +nominal_datatype ntrm = Na "\name\trm" ("([_]:_)" [100,100] 100) text {* conamed terms *} -nominal_datatype ctrm = C "\coname\trm" ("C <_>._" [100,100] 100) +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 + nrename :: "trm \ name \ name \ trm" ("_[_\n>_]" [100,100,100] 100) + crename :: "trm \ coname \ coname \ trm" ("_[_\c>_]" [100,100,100] 100) + +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) \ (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" + "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)+ +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" + "(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)" + "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)+ +done text {* We should now define the two forms of substitition :o( *} consts - substn :: "trm \ name \ ctrm \ trm" ("_[_::=_]" [100,100,100] 100) - substc :: "trm \ coname \ ntrm \ trm" ("_[_::=_]" [100,100,100] 100) - -text {* does not work yet *} - + substn :: "trm \ name \ ctrm \ trm" ("_[_::n=_]" [100,100,100] 100) + substc :: "trm \ coname \ ntrm \ trm" ("_[_::c=_]" [100,100,100] 100) end