uniformly use variable names m and n in take-related lemmas; use export_without_context where appropriate
authorhuffman
Wed, 03 Mar 2010 07:36:31 -0800
changeset 35557 5da670d57118
parent 35556 730fdfbbd5f8
child 35558 bb088a6fafbc
uniformly use variable names m and n in take-related lemmas; use export_without_context where appropriate
src/HOLCF/Representable.thy
src/HOLCF/Tools/Domain/domain_isomorphism.ML
src/HOLCF/Tools/Domain/domain_take_proofs.ML
src/HOLCF/Tools/Domain/domain_theorems.ML
src/HOLCF/ex/Stream.thy
--- a/src/HOLCF/Representable.thy	Wed Mar 03 06:48:00 2010 -0800
+++ b/src/HOLCF/Representable.thy	Wed Mar 03 07:36:31 2010 -0800
@@ -189,21 +189,21 @@
 
 lemma deflation_chain_min:
   assumes chain: "chain d"
-  assumes defl: "\<And>i. deflation (d i)"
-  shows "d i\<cdot>(d j\<cdot>x) = d (min i j)\<cdot>x"
+  assumes defl: "\<And>n. deflation (d n)"
+  shows "d m\<cdot>(d n\<cdot>x) = d (min m n)\<cdot>x"
 proof (rule linorder_le_cases)
-  assume "i \<le> j"
-  with chain have "d i \<sqsubseteq> d j" by (rule chain_mono)
-  then have "d i\<cdot>(d j\<cdot>x) = d i\<cdot>x"
+  assume "m \<le> n"
+  with chain have "d m \<sqsubseteq> d n" by (rule chain_mono)
+  then have "d m\<cdot>(d n\<cdot>x) = d m\<cdot>x"
     by (rule deflation_below_comp1 [OF defl defl])
-  moreover from `i \<le> j` have "min i j = i" by simp
+  moreover from `m \<le> n` have "min m n = m" by simp
   ultimately show ?thesis by simp
 next
-  assume "j \<le> i"
-  with chain have "d j \<sqsubseteq> d i" by (rule chain_mono)
-  then have "d i\<cdot>(d j\<cdot>x) = d j\<cdot>x"
+  assume "n \<le> m"
+  with chain have "d n \<sqsubseteq> d m" by (rule chain_mono)
+  then have "d m\<cdot>(d n\<cdot>x) = d n\<cdot>x"
     by (rule deflation_below_comp2 [OF defl defl])
-  moreover from `j \<le> i` have "min i j = j" by simp
+  moreover from `n \<le> m` have "min m n = n" by simp
   ultimately show ?thesis by simp
 qed
 
--- a/src/HOLCF/Tools/Domain/domain_isomorphism.ML	Wed Mar 03 06:48:00 2010 -0800
+++ b/src/HOLCF/Tools/Domain/domain_isomorphism.ML	Wed Mar 03 07:36:31 2010 -0800
@@ -627,8 +627,8 @@
     (* prove lub of take equals ID *)
     fun prove_lub_take (((bind, take_const), map_ID_thm), (lhsT, rhsT)) thy =
       let
-        val i = Free ("i", natT);
-        val goal = mk_eqs (mk_lub (lambda i (take_const $ i)), mk_ID lhsT);
+        val n = Free ("n", natT);
+        val goal = mk_eqs (mk_lub (lambda n (take_const $ n)), mk_ID lhsT);
         val tac =
             EVERY
             [rtac @{thm trans} 1, rtac map_ID_thm 2,
--- a/src/HOLCF/Tools/Domain/domain_take_proofs.ML	Wed Mar 03 06:48:00 2010 -0800
+++ b/src/HOLCF/Tools/Domain/domain_take_proofs.ML	Wed Mar 03 07:36:31 2010 -0800
@@ -230,10 +230,10 @@
           (mk_tuple (map one_copy_rhs (rep_abs_consts ~~ dom_eqns)));
     val take_rhss =
       let
-        val i = Free ("i", HOLogic.natT);
-        val rhs = mk_iterate (i, take_functional)
+        val n = Free ("n", HOLogic.natT);
+        val rhs = mk_iterate (n, take_functional);
       in
-        map (Term.lambda i o snd) (mk_projs dom_binds rhs)
+        map (lambda n o snd) (mk_projs dom_binds rhs)
       end;
 
     (* define take constants *)
@@ -284,12 +284,12 @@
       fold_map prove_take_0 (take_consts ~~ dnames ~~ dom_eqns) thy;
 
     (* prove take_Suc lemmas *)
-    val i = Free ("i", natT);
-    val take_is = map (fn t => t $ i) take_consts;
+    val n = Free ("n", natT);
+    val take_is = map (fn t => t $ n) take_consts;
     fun prove_take_Suc
           (((take_const, rep_abs), dname), (lhsT, rhsT)) thy =
       let
-        val lhs = take_const $ (@{term Suc} $ i);
+        val lhs = take_const $ (@{term Suc} $ n);
         val body = map_of_typ thy (newTs ~~ take_is) rhsT;
         val rhs = mk_cfcomp2 (rep_abs, body);
         val goal = mk_eqs (lhs, rhs);
@@ -308,8 +308,8 @@
     val deflation_abs_rep_thms = map deflation_abs_rep iso_infos;
     val deflation_take_thm =
       let
-        val i = Free ("i", natT);
-        fun mk_goal take_const = mk_deflation (take_const $ i);
+        val n = Free ("n", natT);
+        fun mk_goal take_const = mk_deflation (take_const $ n);
         val goal = mk_trp (foldr1 mk_conj (map mk_goal take_consts));
         val adm_rules =
           @{thms adm_conj adm_subst [OF _ adm_deflation]
@@ -344,7 +344,7 @@
     (* prove strictness of take functions *)
     fun prove_take_strict (take_const, dname) thy =
       let
-        val goal = mk_trp (mk_strict (take_const $ Free ("i", natT)));
+        val goal = mk_trp (mk_strict (take_const $ Free ("n", natT)));
         val tac = rtac @{thm deflation_strict} 1
                   THEN resolve_tac deflation_take_thms 1;
         val take_strict_thm = Goal.prove_global thy [] [] goal (K tac);
@@ -358,7 +358,8 @@
     fun prove_take_take ((chain_take, deflation_take), dname) thy =
       let
         val take_take_thm =
-            @{thm deflation_chain_min} OF [chain_take, deflation_take];
+            Drule.export_without_context
+            (@{thm deflation_chain_min} OF [chain_take, deflation_take]);
       in
         add_qualified_thm "take_take" (dname, take_take_thm) thy
       end;
@@ -374,10 +375,10 @@
         val (finite_const, thy) =
           Sign.declare_const ((finite_bind, finite_type), NoSyn) thy;
         val x = Free ("x", lhsT);
-        val i = Free ("i", natT);
+        val n = Free ("n", natT);
         val finite_rhs =
           lambda x (HOLogic.exists_const natT $
-            (lambda i (mk_eq (mk_capply (take_const $ i, x), x))));
+            (lambda n (mk_eq (mk_capply (take_const $ n, x), x))));
         val finite_eqn = Logic.mk_equals (finite_const, finite_rhs);
         val (finite_def_thm, thy) =
           thy
--- a/src/HOLCF/Tools/Domain/domain_theorems.ML	Wed Mar 03 06:48:00 2010 -0800
+++ b/src/HOLCF/Tools/Domain/domain_theorems.ML	Wed Mar 03 07:36:31 2010 -0800
@@ -199,7 +199,7 @@
           [simp_tac (HOL_basic_ss addsimps rules) 1,
            asm_simp_tac (HOL_basic_ss addsimps rules2) 1];
     in pg con_appls goal (K tacs) end;
-  val take_apps = map (Drule.export_without_context o one_take_app) cons;
+  val take_apps = map one_take_app cons;
 in
   val take_rews = ax_take_0 :: ax_take_strict :: take_apps;
 end;
@@ -438,13 +438,15 @@
   val take_lemmas =
     let
       fun take_lemma (ax_chain_take, ax_lub_take) =
-        @{thm lub_ID_take_lemma} OF [ax_chain_take, ax_lub_take];
+        Drule.export_without_context
+        (@{thm lub_ID_take_lemma} OF [ax_chain_take, ax_lub_take]);
     in map take_lemma (axs_chain_take ~~ axs_lub_take) end;
 
   val axs_reach =
     let
       fun reach (ax_chain_take, ax_lub_take) =
-        @{thm lub_ID_reach} OF [ax_chain_take, ax_lub_take];
+        Drule.export_without_context
+        (@{thm lub_ID_reach} OF [ax_chain_take, ax_lub_take]);
     in map reach (axs_chain_take ~~ axs_lub_take) end;
 
 (* ----- theorems concerning finiteness and induction ----------------------- *)
--- a/src/HOLCF/ex/Stream.thy	Wed Mar 03 06:48:00 2010 -0800
+++ b/src/HOLCF/ex/Stream.thy	Wed Mar 03 07:36:31 2010 -0800
@@ -290,12 +290,12 @@
 
 lemma stream_finite_lemma1: "stream_finite xs ==> stream_finite (x && xs)"
 apply (simp add: stream.finite_def,auto)
-apply (rule_tac x="Suc i" in exI)
+apply (rule_tac x="Suc n" in exI)
 by (simp add: stream_take_lemma4)
 
 lemma stream_finite_lemma2: "[| x ~= UU; stream_finite (x && xs) |] ==> stream_finite xs"
 apply (simp add: stream.finite_def, auto)
-apply (rule_tac x="i" in exI)
+apply (rule_tac x="n" in exI)
 by (erule stream_take_lemma3,simp)
 
 lemma stream_finite_rt_eq: "stream_finite (rt$s) = stream_finite s"