src/HOL/Tools/Function/relation.ML
author wenzelm
Wed, 08 Apr 2015 15:06:43 +0200
changeset 59968 d69dc7a133e7
parent 59627 bb1e4a35d506
child 60642 48dd1cefb4ae
permissions -rw-r--r--
more standard access to specific subgoal;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
33100
acc2bd3934ba renamed auto_term.ML -> relation.ML
krauss
parents:
diff changeset
     1
(*  Title:      HOL/Tools/Function/relation.ML
acc2bd3934ba renamed auto_term.ML -> relation.ML
krauss
parents:
diff changeset
     2
    Author:     Alexander Krauss, TU Muenchen
acc2bd3934ba renamed auto_term.ML -> relation.ML
krauss
parents:
diff changeset
     3
47701
157e6108a342 more standard method setup;
wenzelm
parents: 42361
diff changeset
     4
Tactics to start a termination proof using a user-specified relation.
33100
acc2bd3934ba renamed auto_term.ML -> relation.ML
krauss
parents:
diff changeset
     5
*)
acc2bd3934ba renamed auto_term.ML -> relation.ML
krauss
parents:
diff changeset
     6
acc2bd3934ba renamed auto_term.ML -> relation.ML
krauss
parents:
diff changeset
     7
signature FUNCTION_RELATION =
acc2bd3934ba renamed auto_term.ML -> relation.ML
krauss
parents:
diff changeset
     8
sig
40445
65bd37d7d501 removed type-inference-like behaviour from relation_tac completely; tuned
krauss
parents: 40057
diff changeset
     9
  val relation_tac: Proof.context -> (typ -> term) -> int -> tactic
47701
157e6108a342 more standard method setup;
wenzelm
parents: 42361
diff changeset
    10
  val relation_infer_tac: Proof.context -> term -> int -> tactic
33100
acc2bd3934ba renamed auto_term.ML -> relation.ML
krauss
parents:
diff changeset
    11
end
acc2bd3934ba renamed auto_term.ML -> relation.ML
krauss
parents:
diff changeset
    12
59968
d69dc7a133e7 more standard access to specific subgoal;
wenzelm
parents: 59627
diff changeset
    13
structure Function_Relation: FUNCTION_RELATION =
33100
acc2bd3934ba renamed auto_term.ML -> relation.ML
krauss
parents:
diff changeset
    14
struct
acc2bd3934ba renamed auto_term.ML -> relation.ML
krauss
parents:
diff changeset
    15
40445
65bd37d7d501 removed type-inference-like behaviour from relation_tac completely; tuned
krauss
parents: 40057
diff changeset
    16
(* tactic version *)
65bd37d7d501 removed type-inference-like behaviour from relation_tac completely; tuned
krauss
parents: 40057
diff changeset
    17
59968
d69dc7a133e7 more standard access to specific subgoal;
wenzelm
parents: 59627
diff changeset
    18
fun inst_state_tac ctxt inst =
d69dc7a133e7 more standard access to specific subgoal;
wenzelm
parents: 59627
diff changeset
    19
  SUBGOAL (fn (goal, _) =>
d69dc7a133e7 more standard access to specific subgoal;
wenzelm
parents: 59627
diff changeset
    20
    (case Term.add_vars goal [] of
d69dc7a133e7 more standard access to specific subgoal;
wenzelm
parents: 59627
diff changeset
    21
      [v as (_, T)] =>
d69dc7a133e7 more standard access to specific subgoal;
wenzelm
parents: 59627
diff changeset
    22
        PRIMITIVE (Thm.instantiate ([], [(Thm.cterm_of ctxt (Var v), Thm.cterm_of ctxt (inst T))]))
d69dc7a133e7 more standard access to specific subgoal;
wenzelm
parents: 59627
diff changeset
    23
    | _ => no_tac));
40445
65bd37d7d501 removed type-inference-like behaviour from relation_tac completely; tuned
krauss
parents: 40057
diff changeset
    24
65bd37d7d501 removed type-inference-like behaviour from relation_tac completely; tuned
krauss
parents: 40057
diff changeset
    25
fun relation_tac ctxt rel i =
59159
9312710451f5 just one data slot per program unit;
wenzelm
parents: 47701
diff changeset
    26
  TRY (Function_Common.termination_rule_tac ctxt i)
59968
d69dc7a133e7 more standard access to specific subgoal;
wenzelm
parents: 59627
diff changeset
    27
  THEN inst_state_tac ctxt rel i;
40445
65bd37d7d501 removed type-inference-like behaviour from relation_tac completely; tuned
krauss
parents: 40057
diff changeset
    28
65bd37d7d501 removed type-inference-like behaviour from relation_tac completely; tuned
krauss
parents: 40057
diff changeset
    29
47701
157e6108a342 more standard method setup;
wenzelm
parents: 42361
diff changeset
    30
(* version with type inference *)
40445
65bd37d7d501 removed type-inference-like behaviour from relation_tac completely; tuned
krauss
parents: 40057
diff changeset
    31
59968
d69dc7a133e7 more standard access to specific subgoal;
wenzelm
parents: 59627
diff changeset
    32
fun inst_state_infer_tac ctxt rel =
d69dc7a133e7 more standard access to specific subgoal;
wenzelm
parents: 59627
diff changeset
    33
  SUBGOAL (fn (goal, _) =>
d69dc7a133e7 more standard access to specific subgoal;
wenzelm
parents: 59627
diff changeset
    34
    (case Term.add_vars goal [] of
d69dc7a133e7 more standard access to specific subgoal;
wenzelm
parents: 59627
diff changeset
    35
      [v as (_, T)] =>
d69dc7a133e7 more standard access to specific subgoal;
wenzelm
parents: 59627
diff changeset
    36
        let
d69dc7a133e7 more standard access to specific subgoal;
wenzelm
parents: 59627
diff changeset
    37
          val rel' =
d69dc7a133e7 more standard access to specific subgoal;
wenzelm
parents: 59627
diff changeset
    38
            singleton (Variable.polymorphic ctxt) rel
d69dc7a133e7 more standard access to specific subgoal;
wenzelm
parents: 59627
diff changeset
    39
            |> map_types Type_Infer.paramify_vars
d69dc7a133e7 more standard access to specific subgoal;
wenzelm
parents: 59627
diff changeset
    40
            |> Type.constraint T
d69dc7a133e7 more standard access to specific subgoal;
wenzelm
parents: 59627
diff changeset
    41
            |> Syntax.check_term ctxt;
d69dc7a133e7 more standard access to specific subgoal;
wenzelm
parents: 59627
diff changeset
    42
        in
d69dc7a133e7 more standard access to specific subgoal;
wenzelm
parents: 59627
diff changeset
    43
          PRIMITIVE (Thm.instantiate ([], [(Thm.cterm_of ctxt (Var v), Thm.cterm_of ctxt rel')]))
d69dc7a133e7 more standard access to specific subgoal;
wenzelm
parents: 59627
diff changeset
    44
        end
d69dc7a133e7 more standard access to specific subgoal;
wenzelm
parents: 59627
diff changeset
    45
    | _ => no_tac));
33100
acc2bd3934ba renamed auto_term.ML -> relation.ML
krauss
parents:
diff changeset
    46
47701
157e6108a342 more standard method setup;
wenzelm
parents: 42361
diff changeset
    47
fun relation_infer_tac ctxt rel i =
59159
9312710451f5 just one data slot per program unit;
wenzelm
parents: 47701
diff changeset
    48
  TRY (Function_Common.termination_rule_tac ctxt i)
59968
d69dc7a133e7 more standard access to specific subgoal;
wenzelm
parents: 59627
diff changeset
    49
  THEN inst_state_infer_tac ctxt rel i;
33100
acc2bd3934ba renamed auto_term.ML -> relation.ML
krauss
parents:
diff changeset
    50
acc2bd3934ba renamed auto_term.ML -> relation.ML
krauss
parents:
diff changeset
    51
end