src/HOL/Tools/rewrite_hol_proof.ML
changeset 70412 64ead6de6212
parent 70388 e31271559de8
child 70417 eb6ff14767cd
equal deleted inserted replaced
70411:c533bec6e92d 70412:64ead6de6212
   303    \<open>(iffD2 \<cdot> A \<cdot> B \<bullet> (iffI \<cdot> A \<cdot> B \<bullet> prf1 \<bullet> prf2)) \<equiv> prf2\<close>];
   303    \<open>(iffD2 \<cdot> A \<cdot> B \<bullet> (iffI \<cdot> A \<cdot> B \<bullet> prf1 \<bullet> prf2)) \<equiv> prf2\<close>];
   304 
   304 
   305 
   305 
   306 (** Replace congruence rules by substitution rules **)
   306 (** Replace congruence rules by substitution rules **)
   307 
   307 
   308 fun strip_cong ps (PThm (_, (("HOL.cong", _, _), _)) % _ % _ % SOME x % SOME y %%
   308 fun strip_cong ps (PThm (_, (("HOL.cong", _, _, _), _)) % _ % _ % SOME x % SOME y %%
   309       prfa %% prfT %% prf1 %% prf2) = strip_cong (((x, y), (prf2, prfa)) :: ps) prf1
   309       prfa %% prfT %% prf1 %% prf2) = strip_cong (((x, y), (prf2, prfa)) :: ps) prf1
   310   | strip_cong ps (PThm (_, (("HOL.refl", _, _), _)) % SOME f %% _) = SOME (f, ps)
   310   | strip_cong ps (PThm (_, (("HOL.refl", _, _, _), _)) % SOME f %% _) = SOME (f, ps)
   311   | strip_cong _ _ = NONE;
   311   | strip_cong _ _ = NONE;
   312 
   312 
   313 val subst_prf = fst (Proofterm.strip_combt (fst (Proofterm.strip_combP (Thm.proof_of subst))));
   313 val subst_prf = fst (Proofterm.strip_combt (fst (Proofterm.strip_combP (Thm.proof_of subst))));
   314 val sym_prf = fst (Proofterm.strip_combt (fst (Proofterm.strip_combP (Thm.proof_of sym))));
   314 val sym_prf = fst (Proofterm.strip_combt (fst (Proofterm.strip_combP (Thm.proof_of sym))));
   315 
   315 
   328   ((y, x),
   328   ((y, x),
   329     (Proofterm.change_type (SOME [fastype_of1 (Ts, x)]) sym_prf %> x %> y %% clprf %% prf, clprf));
   329     (Proofterm.change_type (SOME [fastype_of1 (Ts, x)]) sym_prf %> x %> y %% clprf %% prf, clprf));
   330 
   330 
   331 fun mk_AbsP P t = AbsP ("H", Option.map HOLogic.mk_Trueprop P, t);
   331 fun mk_AbsP P t = AbsP ("H", Option.map HOLogic.mk_Trueprop P, t);
   332 
   332 
   333 fun elim_cong_aux Ts (PThm (_, (("HOL.iffD1", _, _), _)) % _ % _ %% prf1 %% prf2) =
   333 fun elim_cong_aux Ts (PThm (_, (("HOL.iffD1", _, _, _), _)) % _ % _ %% prf1 %% prf2) =
   334       Option.map (make_subst Ts prf2 []) (strip_cong [] prf1)
   334       Option.map (make_subst Ts prf2 []) (strip_cong [] prf1)
   335   | elim_cong_aux Ts (PThm (_, (("HOL.iffD1", _, _), _)) % P % _ %% prf) =
   335   | elim_cong_aux Ts (PThm (_, (("HOL.iffD1", _, _, _), _)) % P % _ %% prf) =
   336       Option.map (mk_AbsP P o make_subst Ts (PBound 0) [])
   336       Option.map (mk_AbsP P o make_subst Ts (PBound 0) [])
   337         (strip_cong [] (Proofterm.incr_pboundvars 1 0 prf))
   337         (strip_cong [] (Proofterm.incr_pboundvars 1 0 prf))
   338   | elim_cong_aux Ts (PThm (_, (("HOL.iffD2", _, _), _)) % _ % _ %% prf1 %% prf2) =
   338   | elim_cong_aux Ts (PThm (_, (("HOL.iffD2", _, _, _), _)) % _ % _ %% prf1 %% prf2) =
   339       Option.map (make_subst Ts prf2 [] o
   339       Option.map (make_subst Ts prf2 [] o
   340         apsnd (map (make_sym Ts))) (strip_cong [] prf1)
   340         apsnd (map (make_sym Ts))) (strip_cong [] prf1)
   341   | elim_cong_aux Ts (PThm (_, (("HOL.iffD2", _, _), _)) % _ % P %% prf) =
   341   | elim_cong_aux Ts (PThm (_, (("HOL.iffD2", _, _, _), _)) % _ % P %% prf) =
   342       Option.map (mk_AbsP P o make_subst Ts (PBound 0) [] o
   342       Option.map (mk_AbsP P o make_subst Ts (PBound 0) [] o
   343         apsnd (map (make_sym Ts))) (strip_cong [] (Proofterm.incr_pboundvars 1 0 prf))
   343         apsnd (map (make_sym Ts))) (strip_cong [] (Proofterm.incr_pboundvars 1 0 prf))
   344   | elim_cong_aux _ _ = NONE;
   344   | elim_cong_aux _ _ = NONE;
   345 
   345 
   346 fun elim_cong Ts hs prf = Option.map (rpair Proofterm.no_skel) (elim_cong_aux Ts prf);
   346 fun elim_cong Ts hs prf = Option.map (rpair Proofterm.no_skel) (elim_cong_aux Ts prf);