# HG changeset patch # User urbanc # Date 1173194272 -3600 # Node ID 4ccc8c1b08a3c01564559720784234dfae03b7a3 # Parent 17441293ebc618295de46bd763245fda15dd1644 updated this file to the new infrastructure diff -r 17441293ebc6 -r 4ccc8c1b08a3 src/HOL/Nominal/Examples/SN.thy --- a/src/HOL/Nominal/Examples/SN.thy Tue Mar 06 15:49:25 2007 +0100 +++ b/src/HOL/Nominal/Examples/SN.thy Tue Mar 06 16:17:52 2007 +0100 @@ -796,92 +796,44 @@ apply(force simp add: RED_props) done -(* HERE *) - -(* -lemma fresh_domain: - assumes a: "a\\" - shows "a\set(domain \)" -using a -apply(induct \) -apply(auto simp add: fresh_prod fresh_list_cons fresh_atm) -done - -lemma fresh_at: - assumes a: "a\set(domain \)" - and b: "c\\" - shows "c\(\)" -using a b -apply(induct \) -apply(auto simp add: fresh_prod fresh_list_cons) -done - -lemma fresh_psubst: - fixes z::"name" - and t::"lam" - assumes "z\t" "z\\" - shows "z\(t[<\>])" -using assms -by (nominal_induct t avoiding: z \ t rule: lam.induct) - (auto simp add: abs_fresh lookup_fresh) - lemma psubst_subst: assumes h:"c\\" - shows "(t[<\>])[c::=s] = t[<((c,s)#\)>]" + shows "(\)[c::=s] = ((c,s)#\)" using h by (nominal_induct t avoiding: \ c s rule: lam.induct) - (auto simp add: fresh_list_cons fresh_atm forget lookup_fresh lookup_fresh' fresh_psubst) + (auto simp add: fresh_list_cons fresh_atm forget lookup_fresh lookup_fresh') + +abbreviation + mapsto :: "(name\lam) list \ name \ lam \ bool" ("_ maps _ to _" [55,55,55] 55) +where + "\ maps x to e\ (lookup \ x) = e" + +abbreviation + closes :: "(name\lam) list \ (name\ty) list \ bool" ("_ closes _" [55,55] 55) +where + "\ closes \ \ \x T. ((x,T) \ set \ \ (\t. \ maps x to t \ t \ RED T))" lemma all_RED: - assumes a: "\\t:\" - and b: "\a \. (a,\)\set(\) \ (a\set(domain \)\\\RED \)" - shows "t[<\>]\RED \" + assumes a: "\ \ t : \" + and b: "\ closes \" + shows "\ \ RED \" using a b -sorry - proof(nominal_induct t avoiding: \ \ \ rule: lam.induct) case (Lam a t) --"lambda case" - have ih: "\\ \ \. \ \ t:\ \ - (\c \. (c,\)\set \ \ c\set (domain \) \ \\RED \) - \ t[<\>]\RED \" - and \_cond: "\c \. (c,\)\set \ \ c\set (domain \) \ \\RED \" + have ih: "\\ \ \. \ \ t : \ \ \ closes \ \ \ \ RED \" + and \_cond: "\ closes \" and fresh: "a\\" "a\\" and "\ \ Lam [a].t:\" by fact hence "\\1 \2. \=\1\\2 \ ((a,\1)#\)\t:\2" using t3_elim fresh by simp then obtain \1 \2 where \_inst: "\=\1\\2" and typing: "((a,\1)#\)\t:\2" by blast - from ih have "\s\RED \1. t[<\>][a::=s] \ RED \2" using fresh typing \_cond + from ih have "\s\RED \1. \[a::=s] \ RED \2" using fresh typing \_cond by (force dest: fresh_context simp add: psubst_subst) - hence "(Lam [a].(t[<\>])) \ RED (\1 \ \2)" by (simp only: abs_RED) - thus "(Lam [a].t)[<\>] \ RED \" using fresh \_inst by simp + hence "(Lam [a].(\)) \ RED (\1 \ \2)" by (simp only: abs_RED) + thus "\<(Lam [a].t)> \ RED \" using fresh \_inst by simp qed (force dest!: t1_elim t2_elim)+ - -lemma all_RED: - assumes a: "\\t:\" - and b: "\a \. (a,\)\set(\) \ (a\set(domain \)\\\RED \)" - shows "t[<\>]\RED \" -using a b -sorry - -proof(nominal_induct t avoiding: \ \ \ rule: lam.induct) - case (Lam a t) --"lambda case" - have ih: "\\ \ \. \\ \ t:\; \c \. (c,\)\set \ \ c\set (domain \) \ \\RED \\ - \ t[<\>]\RED \" - and \_cond: "\c \. (c,\)\set \ \ c\set (domain \) \ \\RED \" - and fresh: "a\\" "a\\" - and "\ \ Lam [a].t:\" by fact - hence "\\1 \2. \=\1\\2 \ ((a,\1)#\)\t:\2" using t3_elim fresh by simp - then obtain \1 \2 where \_inst: "\=\1\\2" and typing: "((a,\1)#\)\t:\2" by blast - from ih have "\s\RED \1. t[<\>][a::=s] \ RED \2" using fresh typing \_cond - by (force dest: fresh_context simp add: psubst_subst) - hence "(Lam [a].(t[<\>])) \ RED (\1 \ \2)" by (simp only: abs_RED) - thus "(Lam [a].t)[<\>] \ RED \" using fresh \_inst by simp -qed (force dest!: t1_elim t2_elim)+ -*) - (* identity substitution generated from a context \ *) -(* consts "id" :: "(name\ty) list \ (name\lam) list" primrec @@ -889,9 +841,7 @@ "id (x#\) = ((fst x),Var (fst x))#(id \)" lemma id_var: - assumes a: "a \ set (domain (id \))" - shows "(id \) = Var a" -using a + shows "(id \) maps a to Var a" apply(induct \, auto) done @@ -904,35 +854,31 @@ apply(auto simp add: fresh_list_nil fresh_list_cons fresh_prod) done + lemma id_apply: - shows "t[<(id \)>] = t" + shows "(id \) = t" apply(nominal_induct t avoiding: \ rule: lam.induct) apply(auto) -sorry - -apply(simp add: id_var) +apply(rule id_var) apply(drule id_fresh)+ apply(simp) done - lemma id_mem: assumes a: "(a,\)\set \" - shows "a \ set (domain (id \))" + shows "lookup (id \) a = Var a" using a apply(induct \, auto) done lemma id_prop: - shows "\a \. (a,\)\set(\) \ (a\set(domain (id \))\(id \)\RED \)" + shows "(id \) closes \" apply(auto) apply(simp add: id_mem) -apply(frule id_mem) -apply(simp add: id_var) -apply(subgoal_tac "CR3 \") --"A" +apply(subgoal_tac "CR3 T") --"A" apply(drule CR3_CR4) apply(simp add: CR4_def) -apply(drule_tac x="Var a" in spec) +apply(drule_tac x="Var x" in spec) apply(force simp add: NEUT_def NORMAL_Var) --"A" apply(rule RED_props) @@ -942,9 +888,9 @@ assumes a: "\\t:\" shows "t \ RED \" proof - - have "t[>]\RED \" + have "(id \)\RED \" proof - - have "\a \. (a,\)\set(\) \ (a\set(domain (id \))\(id \)\RED \)" by (rule id_prop) + have "(id \) closes \" by (rule id_prop) with a show ?thesis by (rule all_RED) qed thus"t \ RED \" by (simp add: id_apply) @@ -960,5 +906,4 @@ ultimately show "SN(t)" by (simp add: CR1_def) qed -*) end \ No newline at end of file