killed deadcode
authorblanchet
Fri, 17 Jun 2016 21:00:32 +0200
changeset 63312 d75d1e399698
parent 63311 540cfb14a751
child 63313 0c956a9a0ac0
killed deadcode
src/HOL/Tools/BNF/bnf_lfp.ML
src/HOL/Tools/BNF/bnf_lfp_tactics.ML
--- a/src/HOL/Tools/BNF/bnf_lfp.ML	Fri Jun 17 12:40:18 2016 +0200
+++ b/src/HOL/Tools/BNF/bnf_lfp.ML	Fri Jun 17 21:00:32 2016 +0200
@@ -97,17 +97,12 @@
     val self_fTs = map2 (curry op -->) activeAs activeAs;
     val gTs = map2 (curry op -->) activeBs activeCs;
     val all_gTs = map2 (curry op -->) allBs allCs';
-    val prodBsAs = map2 (curry HOLogic.mk_prodT) activeBs activeAs;
-    val prodFTs = mk_FTs (passiveAs @ prodBsAs);
-    val prod_sTs = map2 (curry op -->) prodFTs activeAs;
 
     (* terms *)
     val mapsAsAs = @{map 4} mk_map_of_bnf Dss Ass Ass bnfs;
     val mapsAsBs = @{map 4} mk_map_of_bnf Dss Ass Bss bnfs;
     val mapsBsCs' = @{map 4} mk_map_of_bnf Dss Bss Css' bnfs;
     val mapsAsCs' = @{map 4} mk_map_of_bnf Dss Ass Css' bnfs;
-    val map_fsts = @{map 4} mk_map_of_bnf Dss (replicate n (passiveAs @ prodBsAs)) Bss bnfs;
-    val map_fsts_rev = @{map 4} mk_map_of_bnf Dss Bss (replicate n (passiveAs @ prodBsAs)) bnfs;
     fun mk_setss Ts = @{map 3} mk_sets_of_bnf (map (replicate live) Dss)
       (map (replicate live) (replicate n Ts)) bnfs;
     val setssAs = mk_setss allAs;
@@ -131,10 +126,8 @@
 
     val passive_UNIVs = map HOLogic.mk_UNIV passiveAs;
     val active_UNIVs = map HOLogic.mk_UNIV activeAs;
-    val prod_UNIVs = map HOLogic.mk_UNIV prodBsAs;
     val passive_ids = map HOLogic.id_const passiveAs;
     val active_ids = map HOLogic.id_const activeAs;
-    val fsts = map fst_const prodBsAs;
 
     (* thms *)
     val bd0_card_orders = map bd_card_order_of_bnf bnfs;
@@ -352,15 +345,13 @@
         Term.list_comb (Const (mor, morT), args)
       end;
 
-    val ((((((((((((Bs, Bs_copy), B's), B''s), ss), prod_ss), s's), s''s), fs), fs_copy), gs), xFs),
-        _) =
+    val (((((((((((Bs, Bs_copy), B's), B''s), ss), s's), s''s), fs), fs_copy), gs), xFs), _) =
       lthy
       |> mk_Frees "B" BTs
       ||>> mk_Frees "B" BTs
       ||>> mk_Frees "B'" B'Ts
       ||>> mk_Frees "B''" B''Ts
       ||>> mk_Frees "s" sTs
-      ||>> mk_Frees "prods" prod_sTs
       ||>> mk_Frees "s'" s'Ts
       ||>> mk_Frees "s''" s''Ts
       ||>> mk_Frees "f" fTs
@@ -436,20 +427,6 @@
         |> Thm.close_derivation
       end;
 
-    val mor_convol_thm =
-      let
-        val maps = @{map 3} (fn s => fn prod_s => fn mapx =>
-          mk_convol (HOLogic.mk_comp (s, Term.list_comb (mapx, passive_ids @ fsts)), prod_s))
-          s's prod_ss map_fsts;
-        val goal = HOLogic.mk_Trueprop
-          (mk_mor prod_UNIVs maps (map HOLogic.mk_UNIV activeBs) s's fsts)
-        val vars = Variable.add_free_names lthy goal [];
-      in
-        Goal.prove_sorry lthy vars [] goal
-          (fn {context = ctxt, prems = _} => mk_mor_convol_tac ctxt ks mor_def)
-        |> Thm.close_derivation
-      end;
-
     val mor_UNIV_thm =
       let
         fun mk_conjunct mapAsBs f s s' = HOLogic.mk_eq
@@ -960,11 +937,6 @@
       mk_map_of_bnf Ds (passiveAs @ Ts) (passiveAs @ active_initTs)) Dss bnfs;
     val fTs = map2 (curry op -->) Ts activeAs;
     val foldT = Library.foldr1 HOLogic.mk_prodT (map2 (curry op -->) Ts activeAs);
-    val rec_sTs = map (Term.typ_subst_atomic (activeBs ~~ Ts)) prod_sTs;
-    val rec_maps = map (Term.subst_atomic_types (activeBs ~~ Ts)) map_fsts;
-    val rec_maps_rev = map (Term.subst_atomic_types (activeBs ~~ Ts)) map_fsts_rev;
-    val rec_fsts = map (Term.subst_atomic_types (activeBs ~~ Ts)) fsts;
-    val rec_UNIVs = map2 (HOLogic.mk_UNIV oo curry HOLogic.mk_prodT) Ts activeAs;
 
     val ((ss, (fold_f, fold_f')), _) =
       lthy
@@ -1054,15 +1026,14 @@
 
     (* algebra copies *)
 
-    val (((((((Bs, B's), ss), s's), inv_fs), fs), rec_ss), _) =
+    val ((((((Bs, B's), ss), s's), inv_fs), fs), _) =
       lthy
       |> mk_Frees "B" BTs
       ||>> mk_Frees "B'" B'Ts
       ||>> mk_Frees "s" sTs
       ||>> mk_Frees "s'" s'Ts
       ||>> mk_Frees "f" inv_fTs
-      ||>> mk_Frees "f" fTs
-      ||>> mk_Frees "s" rec_sTs;
+      ||>> mk_Frees "f" fTs;
 
     val copy_thm =
       let
@@ -1202,15 +1173,13 @@
 
     val timer = time (timer "dtor definitions & thms");
 
-    val (((((((((Izs, (Izs1, Izs1'))), (Izs2, Izs2')), xFs), yFs), fs), rec_ss), init_phis), _) =
+    val (((((((Izs, (Izs1, Izs1'))), (Izs2, Izs2')), xFs), yFs), init_phis), _) =
       lthy
       |> mk_Frees "z" Ts
       ||>> mk_Frees' "z1" Ts
       ||>> mk_Frees' "z2" Ts'
       ||>> mk_Frees "x" FTs
       ||>> mk_Frees "y" FTs'
-      ||>> mk_Frees "f" fTs
-      ||>> mk_Frees "s" rec_sTs
       ||>> mk_Frees "P" (replicate n (mk_pred1T initT));
 
     val phis = map2 retype_const_or_free (map mk_pred1T Ts) init_phis;
--- a/src/HOL/Tools/BNF/bnf_lfp_tactics.ML	Fri Jun 17 12:40:18 2016 +0200
+++ b/src/HOL/Tools/BNF/bnf_lfp_tactics.ML	Fri Jun 17 21:00:32 2016 +0200
@@ -55,7 +55,6 @@
     thm list list -> tactic
   val mk_mor_UNIV_tac: Proof.context -> int -> thm list -> thm -> tactic
   val mk_mor_comp_tac: Proof.context -> thm -> thm list list -> thm list -> tactic
-  val mk_mor_convol_tac: Proof.context -> 'a list -> thm -> tactic
   val mk_mor_elim_tac: Proof.context -> thm -> tactic
   val mk_mor_incl_tac: Proof.context -> thm -> thm list -> tactic
   val mk_mor_fold_tac: Proof.context -> ctyp -> cterm -> thm list -> thm -> thm -> tactic
@@ -145,11 +144,6 @@
   CONJ_WRAP' (K (EVERY' [rtac ctxt ballI, rtac ctxt UNIV_I])) ks THEN'
   CONJ_WRAP' (K (EVERY' [rtac ctxt ballI, rtac ctxt refl])) ks) 1;
 
-fun mk_mor_convol_tac ctxt ks mor_def =
-  (rtac ctxt (mor_def RS iffD2) THEN' rtac ctxt conjI THEN'
-  CONJ_WRAP' (K (EVERY' [rtac ctxt ballI, rtac ctxt UNIV_I])) ks THEN'
-  CONJ_WRAP' (K (EVERY' [rtac ctxt ballI, rtac ctxt trans, rtac ctxt @{thm fst_convol'}, rtac ctxt o_apply])) ks) 1;
-
 fun mk_mor_UNIV_tac ctxt m morEs mor_def =
   let
     val n = length morEs;