LamEx.thy
changeset 259 22c199522bef
parent 258 93ea455b29f1
child 265 5f3b364d4765
--- a/LamEx.thy	Mon Nov 02 11:51:50 2009 +0100
+++ b/LamEx.thy	Mon Nov 02 14:57:56 2009 +0100
@@ -11,6 +11,7 @@
 | rApp "rlam" "rlam"
 | rLam "name" "rlam"
 
+print_theorems
 
 function
   rfv :: "rlam \<Rightarrow> name set"
@@ -29,6 +30,8 @@
 | a2: "\<lbrakk>t1 \<approx> t2; s1 \<approx> s2\<rbrakk> \<Longrightarrow> rApp t1 s1 \<approx> rApp t2 s2"
 | a3: "\<lbrakk>t \<approx> ([(a,b)]\<bullet>s); a \<notin> rfv (rLam b t)\<rbrakk> \<Longrightarrow> rLam a t \<approx> rLam b s"
 
+print_theorems
+
 quotient lam = rlam / alpha
 sorry
 
@@ -176,7 +179,7 @@
 ML {* val fv_lam = lift_thm_lam @{context} @{thm rfv_lam} *}
 
 ML {* val a1 = lift_thm_lam @{context} @{thm a1} *}
-ML {* val a2 = lift_thm_lam @{context} @{thm a1} *}
+ML {* val a2 = lift_thm_lam @{context} @{thm a2} *}
 ML {* val a3 = lift_thm_lam @{context} @{thm a3} *}
 
 ML {* val alpha_cases = lift_thm_lam @{context} @{thm alpha.cases} *}
@@ -240,6 +243,7 @@
  *}
   apply (tactic {* tac @{context} 1 *}) *)
 ML {* val t_r = regularize t_a rty rel rel_eqv rel_refl @{context} *}
+
 (*ML {*
   val rt = build_repabs_term @{context} t_r consts rty qty
   val rg = Logic.mk_equals ((Thm.prop_of t_r), rt);
@@ -279,39 +283,60 @@
 
 ML {* val abs = findabs rty (prop_of (atomize_thm @{thm alpha.induct})) *}
 ML {* val aps = findaps rty (prop_of (atomize_thm @{thm alpha.induct})) *}
-
-ML {*
-
-
-*}
-
 ML {* val aps = @{typ "LamEx.rlam \<Rightarrow> bool"} :: aps; *}
+ML {* val thm = 
+  @{thm FORALL_PRS[OF FUN_QUOTIENT[OF QUOTIENT_lam FUN_QUOTIENT[OF QUOTIENT_lam IDENTITY_QUOTIENT]]]} *}
+ML {* val t_a = simp_allex_prs quot [thm] t_t *}
 ML {* val simp_app_prs_thms = map (make_simp_prs_thm @{context} quot @{thm APP_PRS}) aps *}
 ML {* val simp_lam_prs_thms = map (make_simp_prs_thm @{context} quot @{thm LAMBDA_PRS}) abs *}
-ML {* val t_l = repeat_eqsubst_thm @{context} (simp_app_prs_thms @ simp_lam_prs_thms) t_t *}
-ML {* val t_a = simp_allex_prs @{context} quot t_l *}
-ML {* val thm = 
-  @{thm FORALL_PRS[OF FUN_QUOTIENT[OF QUOTIENT_lam FUN_QUOTIENT[OF QUOTIENT_lam IDENTITY_QUOTIENT]], symmetric]} *}
-ML {* val t_a1 = eqsubst_thm @{context} [thm] t_a *}
+
+ML {* val t_l = repeat_eqsubst_thm @{context} (simp_app_prs_thms @  simp_lam_prs_thms) t_a *}
 ML {* val defs_sym = add_lower_defs @{context} defs; *}
-ML {* val t_d = repeat_eqsubst_thm @{context} defs_sym t_a1 *}
+ML {* val defs_sym_eq = map (fn x => eq_reflection OF [x]) defs_sym *}
+ML t_l
+ML {* val t_d0 = MetaSimplifier.rewrite_rule defs_sym_eq t_l *}
+ML {* val t_d = repeat_eqsubst_thm @{context} defs_sym t_d0 *}
 ML {* val t_r = MetaSimplifier.rewrite_rule [reps_same] t_d *}
 ML {* val t_r1 = repeat_eqsubst_thm @{context} @{thms fun_map.simps} t_r *}
-ML {* val t_r2 = repeat_eqsubst_thm @{context} @{thms QUOT_TYPE_I_lam.thm10} t_r1 *}
-ML {* val t_r3 = repeat_eqsubst_thm @{context} @{thms id_apply} t_r2 *}
-
+ML {* val t_r2 = MetaSimplifier.rewrite_rule @{thms QUOT_TYPE_I_lam.thm10} t_r1 *}
+ML {* val t_r3 = MetaSimplifier.rewrite_rule @{thms eq_reflection[OF id_apply]} t_r2 *}
 ML {* val alpha_induct = ObjectLogic.rulify t_r3 *}
 
 local_setup {*
   Quotient.note (@{binding "alpha_induct"}, alpha_induct) #> snd
 *}
 
+thm alpha_induct
+thm alpha.induct
+
+lemma rvar_inject: "rVar a \<approx> rVar b \<Longrightarrow> (a = b)"
+apply (rule alpha.cases)
+apply (assumption)
+apply (assumption)
+apply (simp_all)
+apply (cases "a = b")
+apply (simp_all)
+apply (cases "ba = b")
+apply (simp_all)
+
+
+lemma var_inject_test:
+  fixes a b
+  assumes a: "Var a = Var b"
+  shows "(a = b)"
+  using a   apply (cases "a = b")
+  apply (simp_all)
+  apply (rule_tac x="Var a" and xa = "Var b" in alpha_cases)
+  apply (rule a)
+
+
 lemma
-  assumes a: "(a::lam) = b"
-  shows "False"
-  using a
-  apply (rule alpha_induct)
-
+  assumes a: "(x::lam) = y"
+  shows "P x y"
+  apply (induct rule: alpha_induct)
+  apply (rule a)
+thm alpha.induct
+thm alpha_induct
 fun
   option_map::"('a \<Rightarrow> 'b) \<Rightarrow> ('a noption) \<Rightarrow> ('b noption)"
 where