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); |