Completely cleaned Int.
authorCezary Kaliszyk <kaliszyk@in.tum.de>
Tue, 27 Oct 2009 09:01:12 +0100
changeset 198 ff4425e000db
parent 197 c0f2db9a243b
child 199 d6bf4234c7f6
Completely cleaned Int.
IntEx.thy
QuotMain.thy
--- a/IntEx.thy	Tue Oct 27 07:46:52 2009 +0100
+++ b/IntEx.thy	Tue Oct 27 09:01:12 2009 +0100
@@ -110,10 +110,6 @@
 where
  "SIGN i = (if i = ZERO then ZERO else if (LESS ZERO i) then ONE else (NEG ONE))"
 
-lemma plus_sym_pre:
-  shows "intrel (my_plus a b) (my_plus b a)"
-  sorry
-
 lemma equiv_intrel: "EQUIV intrel"
   sorry
 
@@ -135,9 +131,40 @@
 ML {* val reps_same = @{thm QUOT_TYPE_I_my_int.REPS_same} *}
 ML {* val t_defs = @{thms PLUS_def} *}
 
+ML {*
+fun lift_thm_my_int lthy t =
+  lift_thm lthy consts rty qty rel rel_eqv rel_refl quot rsp_thms trans2 reps_same t_defs t
+*}
+
+lemma plus_sym_pre:
+  shows "intrel (my_plus a b) (my_plus b a)"
+  apply (cases a)
+  apply (cases b)
+  apply (simp)
+  done
+
+ML {* lift_thm_my_int @{context} @{thm plus_sym_pre} *}
+
+lemma plus_assoc_pre:
+  shows "intrel (my_plus (my_plus i j) k) (my_plus i (my_plus j k))"
+  apply (cases i)
+  apply (cases j)
+  apply (cases k)
+  apply (simp add: intrel_refl)
+  done
+
+ ML {* lift_thm_my_int @{context} @{thm plus_assoc_pre} *}
 
 
-ML {* val t_a = atomize_thm @{thm plus_sym_pre} *}
+
+
+
+
+
+
+text {* Below is the construction site code used if things do now work *}
+
+ML {* val t_a = atomize_thm @{thm plus_assoc_pre} *}
 ML {* val t_r = regularize t_a rty rel rel_eqv @{context} *}
 
 ML {* val (g, thm, othm) =
@@ -173,11 +200,5 @@
 ML {* val t_r = MetaSimplifier.rewrite_rule [reps_same] t_d *}
 ML {* ObjectLogic.rulify t_r *}
 
-lemma 
-  fixes i j k::"my_int"
-  shows "(PLUS (PLUS i j) k) = (PLUS i (PLUS j k))"
-  apply(unfold PLUS_def)
-  apply(simp add: expand_fun_eq)
-  sorry
 
 
--- a/QuotMain.thy	Tue Oct 27 07:46:52 2009 +0100
+++ b/QuotMain.thy	Tue Oct 27 09:01:12 2009 +0100
@@ -851,4 +851,25 @@
     handle _ => thm
 *}
 
+ML {*
+fun lift_thm lthy consts rty qty rel rel_eqv rel_refl quot rsp_thms trans2 reps_same t_defs t = let
+  val t_a = atomize_thm t;
+  val t_r = regularize t_a rty rel rel_eqv lthy;
+  val t_t1 = repabs_eq lthy t_r consts rty qty quot rel_refl trans2 rsp_thms;
+  val t_t2 = repabs_eq2 lthy t_t1;
+  val abs = findabs rty (prop_of t_a);
+  val simp_lam_prs_thms = map (make_simp_lam_prs_thm lthy quot) abs;
+  fun simp_lam_prs lthy thm =
+    simp_lam_prs lthy (eqsubst_thm lthy simp_lam_prs_thms thm)
+    handle _ => thm
+  val t_l = simp_lam_prs lthy t_t2;
+  val t_a = simp_allex_prs lthy quot t_l;
+  val t_defs_sym = add_lower_defs lthy t_defs;
+  val t_d = MetaSimplifier.rewrite_rule t_defs_sym t_a;
+  val t_r = MetaSimplifier.rewrite_rule [reps_same] t_d;
+in
+  ObjectLogic.rulify t_r
 end
+*}
+
+end