diff -r fb201e383f1b -r da575186d492 Nominal/Ex/CPS/Lt.thy --- a/Nominal/Ex/CPS/Lt.thy Tue Feb 19 05:38:46 2013 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,121 +0,0 @@ -header {* The Call-by-Value Lambda Calculus *} -theory Lt -imports "../../Nominal2" -begin - -atom_decl name - -nominal_datatype lt = - Var name ("_~" [150] 149) - | App lt lt (infixl "$$" 100) - | Lam x::"name" t::"lt" binds x in t - -nominal_primrec - subst :: "lt \ name \ lt \ lt" ("_ [_ ::= _]" [90, 90, 90] 90) -where - "(Var x)[y ::= s] = (if x = y then s else (Var x))" -| "(App t1 t2)[y ::= s] = App (t1[y ::= s]) (t2[y ::= s])" -| "atom x \ (y, s) \ (Lam x t)[y ::= s] = Lam x (t[y ::= s])" - unfolding eqvt_def subst_graph_aux_def - apply (simp) - apply(rule TrueI) - using [[simproc del: alpha_lst]] - apply(auto simp add: lt.distinct lt.eq_iff) - apply(rule_tac y="a" and c="(aa, b)" in lt.strong_exhaust) - apply blast - apply(simp_all add: fresh_star_def fresh_Pair_elim) - apply blast - apply (erule_tac c="(ya,sa)" in Abs_lst1_fcb2) - apply(simp add: Abs_fresh_iff) - apply(simp add: fresh_star_def fresh_Pair) - apply(simp add: eqvt_at_def) - apply(simp add: perm_supp_eq fresh_star_Pair) - apply(simp add: eqvt_at_def) - apply(simp add: perm_supp_eq fresh_star_Pair) -done - -termination (eqvt) by lexicographic_order - -lemma forget[simp]: - shows "atom x \ M \ M[x ::= s] = M" - by (nominal_induct M avoiding: x s rule: lt.strong_induct) - (auto simp add: lt.fresh fresh_at_base) - -lemma [simp]: "supp (M[x ::= V]) <= (supp(M) - {atom x}) Un (supp V)" - by (nominal_induct M avoiding: x V rule: lt.strong_induct) - (auto simp add: lt.supp supp_at_base, blast, blast) - -nominal_primrec - isValue:: "lt => bool" -where - "isValue (Var x) = True" -| "isValue (Lam y N) = True" -| "isValue (A $$ B) = False" - unfolding eqvt_def isValue_graph_aux_def - by (auto) - (erule lt.exhaust, auto) - -termination (eqvt) - by (relation "measure size") (simp_all) - -inductive - eval :: "[lt, lt] \ bool" (" _ \\<^isub>\ _" [80,80] 80) - where - evbeta: "\atom x \ V; isValue V\ \ ((Lam x M) $$ V) \\<^isub>\ (M[x ::= V])" -| ev1: "\isValue V; M \\<^isub>\ M' \ \ (V $$ M) \\<^isub>\ (V $$ M')" -| ev2: "M \\<^isub>\ M' \ (M $$ N) \\<^isub>\ (M' $$ N)" - -equivariance eval - -nominal_inductive eval -done - -(*lemmas [simp] = lt.supp(2)*) - -lemma closedev1: assumes "s \\<^isub>\ t" - shows "supp t <= supp s" - using assms - by (induct, auto simp add: lt.supp) - - -lemma [simp]: "~ ((Lam x M) \\<^isub>\ N)" -by (rule, erule eval.cases, simp_all) - -lemma [simp]: assumes "M \\<^isub>\ N" shows "~ isValue M" -using assms -by (cases, auto) - - -inductive - eval_star :: "[lt, lt] \ bool" (" _ \\<^isub>\\<^sup>* _" [80,80] 80) - where - evs1: "M \\<^isub>\\<^sup>* M" -| evs2: "\M \\<^isub>\ M'; M' \\<^isub>\\<^sup>* M'' \ \ M \\<^isub>\\<^sup>* M''" - -lemma eval_evs: assumes *: "M \\<^isub>\ M'" shows "M \\<^isub>\\<^sup>* M'" -by (rule evs2, rule *, rule evs1) - -lemma eval_trans[trans]: - assumes "M1 \\<^isub>\\<^sup>* M2" - and "M2 \\<^isub>\\<^sup>* M3" - shows "M1 \\<^isub>\\<^sup>* M3" - using assms - by (induct, auto intro: evs2) - -lemma evs3[rule_format]: assumes "M1 \\<^isub>\\<^sup>* M2" - shows "M2 \\<^isub>\ M3 \ M1 \\<^isub>\\<^sup>* M3" - using assms - by (induct, auto intro: eval_evs evs2) - -equivariance eval_star - -lemma evbeta': - fixes x :: name - assumes "isValue V" and "atom x\V" and "N = (M[x ::= V])" - shows "((Lam x M) $$ V) \\<^isub>\\<^sup>* N" - using assms by simp (rule evs2, rule evbeta, simp_all add: evs1) - -end - - -