428 (* refine via sub-proof *) |
428 (* refine via sub-proof *) |
429 |
429 |
430 local |
430 local |
431 |
431 |
432 fun refine_tac rule = |
432 fun refine_tac rule = |
433 Tactic.norm_hhf_tac THEN' Tactic.rtac rule THEN_ALL_NEW (SUBGOAL (fn (goal, i) => |
433 Tactic.norm_hhf_tac THEN' Tactic.rtac rule THEN_ALL_NEW |
434 if can Logic.unprotect (Logic.strip_assums_concl goal) then |
434 (Tactic.norm_hhf_tac THEN' (SUBGOAL (fn (goal, i) => |
435 Tactic.etac Drule.protectI i |
435 if can Logic.unprotect (Logic.strip_assums_concl goal) then |
436 else all_tac)); |
436 Tactic.etac Drule.protectI i |
|
437 else all_tac))); |
437 |
438 |
438 fun refine_goal print_rule inner raw_rule state = |
439 fun refine_goal print_rule inner raw_rule state = |
439 let val (outer, (_, {statement, using, goal, before_qed, after_qed})) = find_goal state in |
440 let val (outer, (_, {statement, using, goal, before_qed, after_qed})) = find_goal state in |
440 raw_rule |
441 raw_rule |
441 |> ProofContext.goal_exports inner outer |
442 |> ProofContext.goal_exports inner outer |
557 val _ = assert_forward state; |
558 val _ = assert_forward state; |
558 val thy = theory_of state; |
559 val thy = theory_of state; |
559 val ctxt = context_of state; |
560 val ctxt = context_of state; |
560 |
561 |
561 val rhs = prep_term ctxt raw_rhs; |
562 val rhs = prep_term ctxt raw_rhs; |
562 val T = Term.fastype_of rhs; |
563 val pats = prep_pats (Term.fastype_of rhs) (ProofContext.declare_term rhs ctxt) raw_pats; |
563 val pats = prep_pats T (ProofContext.declare_term rhs ctxt) raw_pats; |
564 val eq = ProofContext.mk_def ctxt (x, rhs); |
564 val lhs = ProofContext.bind_skolem ctxt [x] (Free (x, T)); |
|
565 |
|
566 val name = if raw_name = "" then Thm.def_name x else raw_name; |
565 val name = if raw_name = "" then Thm.def_name x else raw_name; |
567 val atts = map (prep_att thy) raw_atts; |
566 val atts = map (prep_att thy) raw_atts; |
568 in |
567 in |
569 state |
568 state |
570 |> fix [([x], NONE)] |
569 |> fix [([x], NONE)] |
571 |> match_bind_i [(pats, rhs)] |
570 |> match_bind_i [(pats, rhs)] |
572 |> assm_i ProofContext.export_def [((name, atts), [(Logic.mk_equals (lhs, rhs), ([], []))])] |
571 |> assm_i ProofContext.export_def [((name, atts), [(eq, ([], []))])] |
573 end; |
572 end; |
574 |
573 |
575 in |
574 in |
576 |
575 |
577 val def = gen_def fix Attrib.local_attribute ProofContext.read_term ProofContext.read_term_pats; |
576 val def = gen_def fix Attrib.local_attribute ProofContext.read_term ProofContext.read_term_pats; |