| author | wenzelm | 
| Sat, 03 Oct 2020 21:54:53 +0200 | |
| changeset 72371 | 3e84f4e9651a | 
| parent 60642 | 48dd1cefb4ae | 
| child 74282 | c2ee8d993d6a | 
| permissions | -rw-r--r-- | 
| 33100 | 1 | (* Title: HOL/Tools/Function/relation.ML | 
| 2 | Author: Alexander Krauss, TU Muenchen | |
| 3 | ||
| 47701 | 4 | Tactics to start a termination proof using a user-specified relation. | 
| 33100 | 5 | *) | 
| 6 | ||
| 7 | signature FUNCTION_RELATION = | |
| 8 | sig | |
| 40445 
65bd37d7d501
removed type-inference-like behaviour from relation_tac completely; tuned
 krauss parents: 
40057diff
changeset | 9 | val relation_tac: Proof.context -> (typ -> term) -> int -> tactic | 
| 47701 | 10 | val relation_infer_tac: Proof.context -> term -> int -> tactic | 
| 33100 | 11 | end | 
| 12 | ||
| 59968 | 13 | structure Function_Relation: FUNCTION_RELATION = | 
| 33100 | 14 | struct | 
| 15 | ||
| 40445 
65bd37d7d501
removed type-inference-like behaviour from relation_tac completely; tuned
 krauss parents: 
40057diff
changeset | 16 | (* tactic version *) | 
| 
65bd37d7d501
removed type-inference-like behaviour from relation_tac completely; tuned
 krauss parents: 
40057diff
changeset | 17 | |
| 59968 | 18 | fun inst_state_tac ctxt inst = | 
| 19 | SUBGOAL (fn (goal, _) => | |
| 20 | (case Term.add_vars goal [] of | |
| 60642 
48dd1cefb4ae
simplified Thm.instantiate and derivatives: the LHS refers to non-certified variables -- this merely serves as index into already certified structures (or is ignored);
 wenzelm parents: 
59968diff
changeset | 21 | [v as (_, T)] => PRIMITIVE (Thm.instantiate ([], [(v, Thm.cterm_of ctxt (inst T))])) | 
| 59968 | 22 | | _ => no_tac)); | 
| 40445 
65bd37d7d501
removed type-inference-like behaviour from relation_tac completely; tuned
 krauss parents: 
40057diff
changeset | 23 | |
| 
65bd37d7d501
removed type-inference-like behaviour from relation_tac completely; tuned
 krauss parents: 
40057diff
changeset | 24 | fun relation_tac ctxt rel i = | 
| 59159 | 25 | TRY (Function_Common.termination_rule_tac ctxt i) | 
| 59968 | 26 | THEN inst_state_tac ctxt rel i; | 
| 40445 
65bd37d7d501
removed type-inference-like behaviour from relation_tac completely; tuned
 krauss parents: 
40057diff
changeset | 27 | |
| 
65bd37d7d501
removed type-inference-like behaviour from relation_tac completely; tuned
 krauss parents: 
40057diff
changeset | 28 | |
| 47701 | 29 | (* version with type inference *) | 
| 40445 
65bd37d7d501
removed type-inference-like behaviour from relation_tac completely; tuned
 krauss parents: 
40057diff
changeset | 30 | |
| 59968 | 31 | fun inst_state_infer_tac ctxt rel = | 
| 32 | SUBGOAL (fn (goal, _) => | |
| 33 | (case Term.add_vars goal [] of | |
| 34 | [v as (_, T)] => | |
| 35 | let | |
| 36 | val rel' = | |
| 37 | singleton (Variable.polymorphic ctxt) rel | |
| 38 | |> map_types Type_Infer.paramify_vars | |
| 39 | |> Type.constraint T | |
| 40 | |> Syntax.check_term ctxt; | |
| 60642 
48dd1cefb4ae
simplified Thm.instantiate and derivatives: the LHS refers to non-certified variables -- this merely serves as index into already certified structures (or is ignored);
 wenzelm parents: 
59968diff
changeset | 41 | in PRIMITIVE (Thm.instantiate ([], [(v, Thm.cterm_of ctxt rel')])) end | 
| 59968 | 42 | | _ => no_tac)); | 
| 33100 | 43 | |
| 47701 | 44 | fun relation_infer_tac ctxt rel i = | 
| 59159 | 45 | TRY (Function_Common.termination_rule_tac ctxt i) | 
| 59968 | 46 | THEN inst_state_infer_tac ctxt rel i; | 
| 33100 | 47 | |
| 48 | end |