author | wenzelm |
Sun, 03 Jan 2010 15:08:17 +0100 | |
changeset 34236 | 010a3206cbbe |
parent 34232 | 36a2a3029fd3 |
child 36636 | 7dded80a953f |
permissions | -rw-r--r-- |
33100 | 1 |
(* Title: HOL/Tools/Function/relation.ML |
2 |
Author: Alexander Krauss, TU Muenchen |
|
3 |
||
4 |
A package for general recursive function definitions. |
|
5 |
Method "relation" to commence a termination proof using a user-specified relation. |
|
6 |
*) |
|
7 |
||
8 |
signature FUNCTION_RELATION = |
|
9 |
sig |
|
10 |
val relation_tac: Proof.context -> term -> int -> tactic |
|
11 |
val setup: theory -> theory |
|
12 |
end |
|
13 |
||
14 |
structure Function_Relation : FUNCTION_RELATION = |
|
15 |
struct |
|
16 |
||
17 |
fun inst_thm ctxt rel st = |
|
34232
36a2a3029fd3
new year's resolution: reindented code in function package
krauss
parents:
33100
diff
changeset
|
18 |
let |
36a2a3029fd3
new year's resolution: reindented code in function package
krauss
parents:
33100
diff
changeset
|
19 |
val cert = Thm.cterm_of (ProofContext.theory_of ctxt) |
36a2a3029fd3
new year's resolution: reindented code in function package
krauss
parents:
33100
diff
changeset
|
20 |
val rel' = cert (singleton (Variable.polymorphic ctxt) rel) |
36a2a3029fd3
new year's resolution: reindented code in function package
krauss
parents:
33100
diff
changeset
|
21 |
val st' = Thm.incr_indexes (#maxidx (Thm.rep_cterm rel') + 1) st |
36a2a3029fd3
new year's resolution: reindented code in function package
krauss
parents:
33100
diff
changeset
|
22 |
val Rvar = cert (Var (the_single (Term.add_vars (prop_of st') []))) |
36a2a3029fd3
new year's resolution: reindented code in function package
krauss
parents:
33100
diff
changeset
|
23 |
in |
36a2a3029fd3
new year's resolution: reindented code in function package
krauss
parents:
33100
diff
changeset
|
24 |
Drule.cterm_instantiate [(Rvar, rel')] st' |
36a2a3029fd3
new year's resolution: reindented code in function package
krauss
parents:
33100
diff
changeset
|
25 |
end |
33100 | 26 |
|
34232
36a2a3029fd3
new year's resolution: reindented code in function package
krauss
parents:
33100
diff
changeset
|
27 |
fun relation_tac ctxt rel i = |
36a2a3029fd3
new year's resolution: reindented code in function package
krauss
parents:
33100
diff
changeset
|
28 |
TRY (Function_Common.apply_termination_rule ctxt i) |
36a2a3029fd3
new year's resolution: reindented code in function package
krauss
parents:
33100
diff
changeset
|
29 |
THEN PRIMITIVE (inst_thm ctxt rel) |
33100 | 30 |
|
31 |
val setup = |
|
32 |
Method.setup @{binding relation} |
|
33 |
(Args.term >> (fn rel => fn ctxt => SIMPLE_METHOD' (relation_tac ctxt rel))) |
|
34 |
"proves termination using a user-specified wellfounded relation" |
|
35 |
||
36 |
end |