src/Pure/Isar/auto_bind.ML
author wenzelm
Mon, 06 Mar 2000 21:10:27 +0100
changeset 8351 1b8ac0f48233
parent 8227 d67db92897df
child 8612 e8ef58d6d6eb
permissions -rw-r--r--
added simple_args; added 'tactic' method;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
6783
9cf9c17d9e35 renamed object_logic.ML to Isar/auto_bind.ML and tuned this module;
wenzelm
parents:
diff changeset
     1
(*  Title:      Pure/Isar/auto_bind.ML
9cf9c17d9e35 renamed object_logic.ML to Isar/auto_bind.ML and tuned this module;
wenzelm
parents:
diff changeset
     2
    ID:         $Id$
9cf9c17d9e35 renamed object_logic.ML to Isar/auto_bind.ML and tuned this module;
wenzelm
parents:
diff changeset
     3
    Author:     Markus Wenzel, TU Muenchen
9cf9c17d9e35 renamed object_logic.ML to Isar/auto_bind.ML and tuned this module;
wenzelm
parents:
diff changeset
     4
9cf9c17d9e35 renamed object_logic.ML to Isar/auto_bind.ML and tuned this module;
wenzelm
parents:
diff changeset
     5
Automatic term bindings -- logic specific patterns.
7675
c859160e78b0 added atomic_thesis;
wenzelm
parents: 7599
diff changeset
     6
8227
d67db92897df add_judgment;
wenzelm
parents: 7675
diff changeset
     7
Note: the current implementation is not quite 'generic', but works
d67db92897df add_judgment;
wenzelm
parents: 7675
diff changeset
     8
fine with the more common object-logics (HOL, FOL, ZF etc.).
6783
9cf9c17d9e35 renamed object_logic.ML to Isar/auto_bind.ML and tuned this module;
wenzelm
parents:
diff changeset
     9
*)
9cf9c17d9e35 renamed object_logic.ML to Isar/auto_bind.ML and tuned this module;
wenzelm
parents:
diff changeset
    10
9cf9c17d9e35 renamed object_logic.ML to Isar/auto_bind.ML and tuned this module;
wenzelm
parents:
diff changeset
    11
signature AUTO_BIND =
9cf9c17d9e35 renamed object_logic.ML to Isar/auto_bind.ML and tuned this module;
wenzelm
parents:
diff changeset
    12
sig
7599
40b7f7f51208 admit unbinding;
wenzelm
parents: 7474
diff changeset
    13
  val goal: term -> (indexname * term option) list
40b7f7f51208 admit unbinding;
wenzelm
parents: 7474
diff changeset
    14
  val facts: string -> term list -> (indexname * term option) list
7675
c859160e78b0 added atomic_thesis;
wenzelm
parents: 7599
diff changeset
    15
  val atomic_thesis: term -> (string * term) * term
8227
d67db92897df add_judgment;
wenzelm
parents: 7675
diff changeset
    16
  val add_judgment: bstring * string * mixfix -> theory -> theory
d67db92897df add_judgment;
wenzelm
parents: 7675
diff changeset
    17
  val add_judgment_i: bstring * typ * mixfix -> theory -> theory
6783
9cf9c17d9e35 renamed object_logic.ML to Isar/auto_bind.ML and tuned this module;
wenzelm
parents:
diff changeset
    18
end;
9cf9c17d9e35 renamed object_logic.ML to Isar/auto_bind.ML and tuned this module;
wenzelm
parents:
diff changeset
    19
9cf9c17d9e35 renamed object_logic.ML to Isar/auto_bind.ML and tuned this module;
wenzelm
parents:
diff changeset
    20
structure AutoBind: AUTO_BIND =
9cf9c17d9e35 renamed object_logic.ML to Isar/auto_bind.ML and tuned this module;
wenzelm
parents:
diff changeset
    21
struct
9cf9c17d9e35 renamed object_logic.ML to Isar/auto_bind.ML and tuned this module;
wenzelm
parents:
diff changeset
    22
7675
c859160e78b0 added atomic_thesis;
wenzelm
parents: 7599
diff changeset
    23
val thesisN = "thesis";
c859160e78b0 added atomic_thesis;
wenzelm
parents: 7599
diff changeset
    24
val thisN = "this";
6796
c2e5cb8cd50d facts: bind named props (from proof.ML/let_thms);
wenzelm
parents: 6783
diff changeset
    25
7675
c859160e78b0 added atomic_thesis;
wenzelm
parents: 7599
diff changeset
    26
8227
d67db92897df add_judgment;
wenzelm
parents: 7675
diff changeset
    27
(** bindings **)
d67db92897df add_judgment;
wenzelm
parents: 7675
diff changeset
    28
7675
c859160e78b0 added atomic_thesis;
wenzelm
parents: 7599
diff changeset
    29
(* goal *)
6783
9cf9c17d9e35 renamed object_logic.ML to Isar/auto_bind.ML and tuned this module;
wenzelm
parents:
diff changeset
    30
6796
c2e5cb8cd50d facts: bind named props (from proof.ML/let_thms);
wenzelm
parents: 6783
diff changeset
    31
fun statement_binds (name, prop) =
c2e5cb8cd50d facts: bind named props (from proof.ML/let_thms);
wenzelm
parents: 6783
diff changeset
    32
  let
7331
aee8f76fe54c ??thesis: include params;
wenzelm
parents: 7048
diff changeset
    33
    val concl = Logic.strip_assums_concl prop;
aee8f76fe54c ??thesis: include params;
wenzelm
parents: 7048
diff changeset
    34
    val parms = Logic.strip_params prop;
aee8f76fe54c ??thesis: include params;
wenzelm
parents: 7048
diff changeset
    35
    fun list_abs tm = foldr (fn ((x, T), t) => Abs (x, T, t)) (parms, tm);
aee8f76fe54c ??thesis: include params;
wenzelm
parents: 7048
diff changeset
    36
7599
40b7f7f51208 admit unbinding;
wenzelm
parents: 7474
diff changeset
    37
    val env = [(name ^ "_prop", Some prop), (name ^ "_concl", Some (list_abs concl)),
40b7f7f51208 admit unbinding;
wenzelm
parents: 7474
diff changeset
    38
      (name, case concl of Const ("Trueprop", _) $ t => Some (list_abs t) | _ => None)];
7474
43cedde6d52a removed Syntax.binding;
wenzelm
parents: 7452
diff changeset
    39
  in map (fn (s, t) => ((s, 0), t)) env end;
6783
9cf9c17d9e35 renamed object_logic.ML to Isar/auto_bind.ML and tuned this module;
wenzelm
parents:
diff changeset
    40
7675
c859160e78b0 added atomic_thesis;
wenzelm
parents: 7599
diff changeset
    41
fun goal prop = statement_binds (thesisN, prop);
6783
9cf9c17d9e35 renamed object_logic.ML to Isar/auto_bind.ML and tuned this module;
wenzelm
parents:
diff changeset
    42
9cf9c17d9e35 renamed object_logic.ML to Isar/auto_bind.ML and tuned this module;
wenzelm
parents:
diff changeset
    43
6796
c2e5cb8cd50d facts: bind named props (from proof.ML/let_thms);
wenzelm
parents: 6783
diff changeset
    44
(* facts *)
c2e5cb8cd50d facts: bind named props (from proof.ML/let_thms);
wenzelm
parents: 6783
diff changeset
    45
c2e5cb8cd50d facts: bind named props (from proof.ML/let_thms);
wenzelm
parents: 6783
diff changeset
    46
fun dddot_bind prop =
7599
40b7f7f51208 admit unbinding;
wenzelm
parents: 7474
diff changeset
    47
  [(Syntax.dddot_indexname,
40b7f7f51208 admit unbinding;
wenzelm
parents: 7474
diff changeset
    48
      case Logic.strip_imp_concl prop of Const ("Trueprop", _) $ (_ $ t) => Some t | _ => None)];
6796
c2e5cb8cd50d facts: bind named props (from proof.ML/let_thms);
wenzelm
parents: 6783
diff changeset
    49
c2e5cb8cd50d facts: bind named props (from proof.ML/let_thms);
wenzelm
parents: 6783
diff changeset
    50
fun facts _ [] = []
7452
c2289eabf706 "this";
wenzelm
parents: 7331
diff changeset
    51
  | facts name props =
c2289eabf706 "this";
wenzelm
parents: 7331
diff changeset
    52
      let val prop = Library.last_elem props
7675
c859160e78b0 added atomic_thesis;
wenzelm
parents: 7599
diff changeset
    53
      in dddot_bind prop @ statement_binds (thisN, prop) end;
c859160e78b0 added atomic_thesis;
wenzelm
parents: 7599
diff changeset
    54
c859160e78b0 added atomic_thesis;
wenzelm
parents: 7599
diff changeset
    55
c859160e78b0 added atomic_thesis;
wenzelm
parents: 7599
diff changeset
    56
(* atomic_thesis *)
c859160e78b0 added atomic_thesis;
wenzelm
parents: 7599
diff changeset
    57
c859160e78b0 added atomic_thesis;
wenzelm
parents: 7599
diff changeset
    58
fun mk_free t = Free (thesisN, Term.fastype_of t);
c859160e78b0 added atomic_thesis;
wenzelm
parents: 7599
diff changeset
    59
c859160e78b0 added atomic_thesis;
wenzelm
parents: 7599
diff changeset
    60
fun atomic_thesis ((c as Const ("Trueprop", _)) $ t) = ((thesisN, t), c $ mk_free t)
c859160e78b0 added atomic_thesis;
wenzelm
parents: 7599
diff changeset
    61
  | atomic_thesis t = ((thesisN, t), mk_free t);
8227
d67db92897df add_judgment;
wenzelm
parents: 7675
diff changeset
    62
d67db92897df add_judgment;
wenzelm
parents: 7675
diff changeset
    63
d67db92897df add_judgment;
wenzelm
parents: 7675
diff changeset
    64
(** judgment **)
d67db92897df add_judgment;
wenzelm
parents: 7675
diff changeset
    65
d67db92897df add_judgment;
wenzelm
parents: 7675
diff changeset
    66
fun gen_add_judgment add args = PureThy.local_path o add [args] o PureThy.global_path;
d67db92897df add_judgment;
wenzelm
parents: 7675
diff changeset
    67
d67db92897df add_judgment;
wenzelm
parents: 7675
diff changeset
    68
val add_judgment = gen_add_judgment Theory.add_consts;
d67db92897df add_judgment;
wenzelm
parents: 7675
diff changeset
    69
val add_judgment_i = gen_add_judgment Theory.add_consts_i;
d67db92897df add_judgment;
wenzelm
parents: 7675
diff changeset
    70
6796
c2e5cb8cd50d facts: bind named props (from proof.ML/let_thms);
wenzelm
parents: 6783
diff changeset
    71
6783
9cf9c17d9e35 renamed object_logic.ML to Isar/auto_bind.ML and tuned this module;
wenzelm
parents:
diff changeset
    72
end;