src/HOL/Tools/Function/relation.ML
author nipkow
Tue, 17 Jun 2025 06:29:55 +0200
changeset 82732 71574900b6ba
parent 77879 dd222e2af01a
permissions -rw-r--r--
merged
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
74282
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 60642
diff changeset
    21
      [v as (_, T)] =>
77879
wenzelm
parents: 74282
diff changeset
    22
        PRIMITIVE (Thm.instantiate (TVars.empty, Vars.make1 (v, Thm.cterm_of ctxt (inst T))))
59968
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;
77879
wenzelm
parents: 74282
diff changeset
    42
        in PRIMITIVE (Thm.instantiate (TVars.empty, Vars.make1 (v, Thm.cterm_of ctxt rel'))) end
59968
d69dc7a133e7 more standard access to specific subgoal;
wenzelm
parents: 59627
diff changeset
    43
    | _ => no_tac));
33100
acc2bd3934ba renamed auto_term.ML -> relation.ML
krauss
parents:
diff changeset
    44
47701
157e6108a342 more standard method setup;
wenzelm
parents: 42361
diff changeset
    45
fun relation_infer_tac ctxt rel i =
59159
9312710451f5 just one data slot per program unit;
wenzelm
parents: 47701
diff changeset
    46
  TRY (Function_Common.termination_rule_tac ctxt i)
59968
d69dc7a133e7 more standard access to specific subgoal;
wenzelm
parents: 59627
diff changeset
    47
  THEN inst_state_infer_tac ctxt rel i;
33100
acc2bd3934ba renamed auto_term.ML -> relation.ML
krauss
parents:
diff changeset
    48
acc2bd3934ba renamed auto_term.ML -> relation.ML
krauss
parents:
diff changeset
    49
end