theory CK_Machine imports"HOL-Nominal.Nominal" begin
text\<open>
This theory establishes soundness and completeness for a CK-machine with respect to a cbv-big-step semantics. The language includes
functions, recursion, booleans and numbers. In the soundness proof
the small-step cbv-reduction relation is used in order to get the induction through. The type-preservation property is proved for the
machine andalsofor the small- and big-step semantics. Finally,
the progress property is proved for the small-step semantics.
The development is inspired bynotes about context machines written by Roshan James (Indiana University) andalsoby the lecture notes
written by Andy Pitts for his semantics course. See
lemma fresh_fact: fixes z::"name" shows"\z\s; (z=y \ z\t)\ \ z\t[y::=s]" by (nominal_induct t avoiding: z y s rule: lam.strong_induct)
(auto simp add: abs_fresh fresh_prod fresh_atm fresh_nat)
lemma subst_rename: assumes a: "y\t" shows"t[x::=s] = ([(y,x)]\t)[y::=s]" using a by (nominal_induct t avoiding: x y s rule: lam.strong_induct)
(auto simp add: calc_atm fresh_atm abs_fresh perm_nat_def)
text\<open>The operation of composing two contexts:\<close>
fun
ctx_compose :: "ctx \ ctx \ ctx" (\_ \ _\) where "\ \ E' = E'"
| "(CAPPL E t') \ E' = CAPPL (E \ E') t'"
| "(CAPPR t' E) \ E' = CAPPR t' (E \ E')"
| "(CDIFFL E t') \ E' = CDIFFL (E \ E') t'"
| "(CDIFFR t' E) \ E' = CDIFFR t' (E \ E')"
| "(CPLUSL E t') \ E' = CPLUSL (E \ E') t'"
| "(CPLUSR t' E) \ E' = CPLUSR t' (E \ E')"
| "(CIF E t1 t2) \ E' = CIF (E \ E') t1 t2"
| "(CZET E) \ E' = CZET (E \ E')"
| "(CEQIL E t') \ E' = CEQIL (E \ E') t'"
| "(CEQIR t' E) \ E' = CEQIR t' (E \ E')"
lemma cbvs3[intro,trans]: assumes a: "e1 \cbv* e2" "e2 \cbv* e3" shows"e1 \cbv* e3" using a by (induct) (auto)
lemma cbv_in_ctx: assumes a: "t \cbv t'" shows"E\t\ \cbv E\t'\" using a by (induct E) (auto)
lemma machine_implies_cbv_star_ctx: assumes a: " \" shows"(Es\)\e\ \cbv* (Es'\)\e'\" using a by (induct) (auto simp add: ctx_compose intro: cbv_in_ctx)
lemma machine_star_implies_cbv_star_ctx: assumes a: " \* " shows"(Es\)\e\ \cbv* (Es'\)\e'\" using a by (induct) (auto dest: machine_implies_cbv_star_ctx)
lemma machine_star_implies_cbv_star: assumes a: " \* " shows"e \cbv* e'" using a by (auto dest: machine_star_implies_cbv_star_ctx)
lemma cbv_eval: assumes a: "t1 \cbv t2" "t2 \ t3" shows"t1 \ t3" using a by (induct arbitrary: t3)
(auto elim!: eval_elim intro: eval_val)
lemma cbv_star_eval: assumes a: "t1 \cbv* t2" "t2 \ t3" shows"t1 \ t3" using a by (induct) (auto simp add: cbv_eval)
lemma cbv_star_implies_eval: assumes a: "t \cbv* v" "val v" shows"t \ v" using a by (induct)
(auto simp add: eval_val cbv_star_eval dest: cbvs2)
text\<open>The Soundness Property\<close>
theorem machine_star_implies_eval: assumes a: " \* " and b: "val t2" shows"t1 \ t2" proof - from a have"t1 \cbv* t2" by (simp add: machine_star_implies_cbv_star) thenshow"t1 \ t2" using b by (simp add: cbv_star_implies_eval) qed
section \<open>Typing\<close>
text\<open>Types\<close>
nominal_datatype ty =
tVAR "string"
| tBOOL
| tINT
| tARR "ty""ty" (\<open>_ \<rightarrow> _\<close>)
declare ty.inject[simp]
lemma ty_fresh: fixes x::"name" and T::"ty" shows"x\T" by (induct T rule: ty.induct)
(auto simp add: fresh_string)
text\<open>Typing Contexts\<close>
type_synonym tctx = "(name\ty) list"
text\<open>Sub-Typing Contexts\<close>
abbreviation "sub_tctx" :: "tctx \ tctx \ bool" (\_ \ _\) where "\\<^sub>1 \ \\<^sub>2 \ \x. x \ set \\<^sub>1 \ x \ set \\<^sub>2"
equivariance typing nominal_inductive typing by (simp_all add: abs_fresh ty_fresh)
lemma t_LAM_inversion[dest]: assumes ty: "\ \ LAM [x].t : T" and fc: "x\\" shows"\T\<^sub>1 T\<^sub>2. T = T\<^sub>1 \ T\<^sub>2 \ (x,T\<^sub>1)#\ \ t : T\<^sub>2" using ty fc by (cases rule: typing.strong_cases)
(auto simp add: alpha lam.inject abs_fresh ty_fresh)
lemma t_FIX_inversion[dest]: assumes ty: "\ \ FIX [x].t : T" and fc: "x\\" shows"(x,T)#\ \ t : T" using ty fc by (cases rule: typing.strong_cases)
(auto simp add: alpha lam.inject abs_fresh ty_fresh)
section \<open>The Type-Preservation Property for the CBV Reduction Relation\<close>
lemma weakening: fixes\<Gamma>1 \<Gamma>2::"tctx" assumes a: "\1 \ t : T" and b: "valid \2" and c: "\1 \ \2" shows"\2 \ t : T" using a b c by (nominal_induct \<Gamma>1 t T avoiding: \<Gamma>2 rule: typing.strong_induct)
(auto | atomize)+
lemma type_substitution_aux: assumes a: "(\@[(x,T')]@\) \ e : T" and b: "\ \ e' : T'" shows"(\@\) \ e[x::=e'] : T" using a b proof (nominal_induct "\@[(x,T')]@\" e T avoiding: x e' \ rule: typing.strong_induct) case (t_VAR y T x e' \) thenhave a1: "valid (\@[(x,T')]@\)" and a2: "(y,T) \ set (\@[(x,T')]@\)" and a3: "\ \ e' : T'" . from a1 have a4: "valid (\@\)" by (rule valid_insert)
{ assume eq: "x=y" from a1 a2 have"T=T'"using eq by (auto intro: context_unique) with a3 have"\@\ \ VAR y[x::=e'] : T" using eq a4 by (auto intro: weakening)
} moreover
{ assume ineq: "x\y" from a2 have"(y,T) \ set (\@\)" using ineq by simp thenhave"\@\ \ VAR y[x::=e'] : T" using ineq a4 by auto
} ultimatelyshow"\@\ \ VAR y[x::=e'] : T" by blast qed (auto | force simp add: fresh_list_append fresh_list_cons)+
corollary type_substitution: assumes a: "(x,T')#\ \ e : T" and b: "\ \ e' : T'" shows"\ \ e[x::=e'] : T" using a b by (auto intro: type_substitution_aux[where\<Delta>="[]",simplified])
theorem cbv_type_preservation: assumes a: "t \cbv t'" and b: "\ \ t : T" shows"\ \ t' : T" using a b apply(nominal_induct avoiding: \<Gamma> T rule: cbv.strong_induct) apply(auto elim!: typing_inversion dest: t_LAM_inversion simp add: type_substitution) apply(frule t_FIX_inversion) apply(auto simp add: type_substitution) done
corollary cbv_star_type_preservation: assumes a: "t \cbv* t'" and b: "\ \ t : T" shows"\ \ t' : T" using a b by (induct) (auto intro: cbv_type_preservation)
section \<open>The Type-Preservation Property for the Machine and Evaluation Relation\<close>
theorem machine_type_preservation: assumes a: " \* " and b: "\ \ t : T" shows"\ \ t' : T" proof - from a have"t \cbv* t'" by (simp add: machine_star_implies_cbv_star) thenshow"\ \ t' : T" using b by (simp add: cbv_star_type_preservation) qed
theorem eval_type_preservation: assumes a: "t \ t'" and b: "\ \ t : T" shows"\ \ t' : T" proof - from a have" \* " by (simp add: eval_implies_machine_star) thenshow"\ \ t' : T" using b by (simp add: machine_type_preservation) qed
text\<open>The Progress Property\<close>
lemma canonical_tARR[dest]: assumes a: "[] \ t : T1 \ T2" and b: "val t" shows"\x t'. t = LAM [x].t'" using b a by (induct) (auto)
lemma canonical_tINT[dest]: assumes a: "[] \ t : tINT" and b: "val t" shows"\n. t = NUM n" using b a by (induct) (auto simp add: fresh_list_nil)
lemma canonical_tBOOL[dest]: assumes a: "[] \ t : tBOOL" and b: "val t" shows"t = TRUE \ t = FALSE" using b a by (induct) (auto simp add: fresh_list_nil)
theorem progress: assumes a: "[] \ t : T" shows"(\t'. t \cbv t') \ (val t)" using a by (induct \<Gamma>\<equiv>"[]::tctx" t T)
(auto dest!: canonical_tINT intro!: cbv.intros gr0I)
end
¤ Dauer der Verarbeitung: 0.13 Sekunden
(vorverarbeitet)
¤
Die Informationen auf dieser Webseite wurden
nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit,
noch Qualität der bereit gestellten Informationen zugesichert.
Bemerkung:
Die farbliche Syntaxdarstellung ist noch experimentell.