# HG changeset patch # User Cezary Kaliszyk # Date 1259082798 -3600 # Node ID 09e28d4c19aa13f541f18dba84297001c226f799 # Parent 577539640a47133ed315f2a61593729ee43e61d5 Lambda & SOLVED' for new quotient_tac diff -r 577539640a47 -r 09e28d4c19aa LamEx.thy --- a/LamEx.thy Tue Nov 24 17:35:31 2009 +0100 +++ b/LamEx.thy Tue Nov 24 18:13:18 2009 +0100 @@ -189,27 +189,69 @@ @{thms ho_all_prs ho_ex_prs} *} ML {* fun lift_thm_lam lthy t = lift_thm lthy qty "lam" rsp_thms defs t *} +ML {* val (rty, rel, rel_refl, rel_eqv) = lookup_quot_data @{context} qty *} +ML {* val consts = lookup_quot_consts defs *} +ML {* val (trans2, reps_same, absrep, quot) = lookup_quot_thms @{context} "lam" *} +ML {* fun lift_tac_lam lthy t = lift_tac lthy t rel_eqv rel_refl rty quot trans2 rsp_thms reps_same defs *} -ML {* val pi_var = lift_thm_lam @{context} @{thm pi_var_com} *} +lemma "(pi\('x \ 'x) list) \ Var a = Var (pi \ a)" +apply (tactic {* lift_tac_lam @{context} @{thm pi_var_com} 1 *}) +done + ML {* val pi_app = lift_thm_lam @{context} @{thm pi_app_com} *} +lemma "(pi\('x \ 'x) list) \ App (x\lam) (xa\lam) = App (pi \ x) (pi \ xa)" +apply (tactic {* lift_tac_lam @{context} @{thm pi_app_com} 1 *}) +done ML {* val pi_lam = lift_thm_lam @{context} @{thm pi_lam_com} *} +lemma "(pi\('x \ 'x) list) \ Lam (a\name) (x\lam) = Lam (pi \ a) (pi \ x)" +apply (tactic {* lift_tac_lam @{context} @{thm pi_lam_com} 1 *}) +done ML {* val fv_var = lift_thm_lam @{context} @{thm rfv_var} *} +lemma "\a. fv (Var (a\name)) = {a}" +apply (tactic {* lift_tac_lam @{context} @{thm rfv_var} 1 *}) +done ML {* val fv_app = lift_thm_lam @{context} @{thm rfv_app} *} +lemma "fv (App (x\lam) (xa\lam)) = fv x \ fv xa" +(*apply (tactic {* lift_tac_lam @{context} @{thm rfv_app} 1 *})*) +sorry ML {* val fv_lam = lift_thm_lam @{context} @{thm rfv_lam} *} +lemma "fv (Lam (a\name) (x\lam)) = fv x - {a}" +(*apply (tactic {* lift_tac_lam @{context} @{thm rfv_lam} 1 *})*) +sorry ML {* val a1 = lift_thm_lam @{context} @{thm a1} *} +lemma "(a\name) = (b\name) \ Var a = Var b" +apply (tactic {* lift_tac_lam @{context} @{thm a1} 1 *}) +done ML {* val a2 = lift_thm_lam @{context} @{thm a2} *} +lemma "\(x\lam) = (xa\lam); (xb\lam) = (xc\lam)\ \ App x xb = App xa xc" +apply (tactic {* lift_tac_lam @{context} @{thm a2} 1 *}) +done ML {* val a3 = lift_thm_lam @{context} @{thm a3} *} - -thm a2 -ML {* val t_a = atomize_thm @{thm a2} *} -ML {* val t_r = regularize t_a @{typ rlam} @{term alpha} @{thm alpha_EQUIV} @{thm alpha_refl} @{context} *} +lemma "\(x\lam) = [(a\name, b\name)] \ (xa\lam); a \ fv (Lam b x)\ \ Lam a x = Lam b xa" +(*apply (tactic {* lift_tac_lam @{context} @{thm a3} 1 *})*) +sorry ML {* val alpha_cases = lift_thm_lam @{context} @{thm alpha.cases} *} +lemma "\(x\lam) = (xa\lam); \(a\name) b\name. \x = Var a; xa = Var b; a = b\ \ P\bool; + \(x\lam) (xa\lam) (xb\lam) xc\lam. \x = App x xb; xa = App xa xc; x = xa; xb = xc\ \ P; + \(x\lam) (a\name) (b\name) xa\lam. \x = Lam a x; xa = Lam b xa; x = [(a, b)] \ xa; a \ fv (Lam b x)\ \ P\ + \ P" +(* apply (tactic {* lift_tac_lam @{context} @{thm alpha.cases} 1 *}) *) +sorry ML {* val alpha_induct = lift_thm_lam @{context} @{thm alpha.induct} *} +lemma "\(qx\lam) = (qxa\lam); \(a\name) b\name. a = b \ (qxb\lam \ lam \ bool) (Var a) (Var b); + \(x\lam) (xa\lam) (xb\lam) xc\lam. \x = xa; qxb x xa; xb = xc; qxb xb xc\ \ qxb (App x xb) (App xa xc); + \(x\lam) (a\name) (b\name) xa\lam. + \x = [(a, b)] \ xa; qxb x ([(a, b)] \ xa); a \ fv (Lam b x)\ \ qxb (Lam a x) (Lam b xa)\ + \ qxb qx qxa" +(* apply (tactic {* lift_tac_lam @{context} @{thm alpha.induct} 1 *}) *) +sorry -ML {* val var_inject = lift_thm_lam @{context} @{thm rvar_inject} *} +lemma "(Var a = Var b) = (a = b)" +apply (tactic {* lift_tac_lam @{context} @{thm rvar_inject} 1 *}) +done local_setup {* Quotient.note (@{binding "pi_var"}, pi_var) #> snd #> diff -r 577539640a47 -r 09e28d4c19aa QuotMain.thy --- a/QuotMain.thy Tue Nov 24 17:35:31 2009 +0100 +++ b/QuotMain.thy Tue Nov 24 18:13:18 2009 +0100 @@ -841,8 +841,8 @@ bex_rsp_tac ctxt, FIRST' (map rtac rsp_thms), rtac refl, - (instantiate_tac @{thm REP_ABS_RSP(1)} ctxt THEN' (RANGE [quotient_tac quot_thm])), - (APPLY_RSP_TAC rty ctxt THEN' (RANGE [quotient_tac quot_thm, quotient_tac quot_thm])), + (instantiate_tac @{thm REP_ABS_RSP(1)} ctxt THEN' (RANGE [SOLVES' (quotient_tac quot_thm)])), + (APPLY_RSP_TAC rty ctxt THEN' (RANGE [SOLVES' (quotient_tac quot_thm), SOLVES' (quotient_tac quot_thm)])), Cong_Tac.cong_tac @{thm cong}, rtac @{thm ext}, rtac reflex_thm,