src/HOL/hologic.ML
author nipkow
Mon Oct 21 09:50:50 1996 +0200 (1996-10-21)
changeset 2115 9709f9188549
parent 923 ff1574a81019
child 2510 e3d0ac75c723
permissions -rw-r--r--
Added trans_tac (see Provers/nat_transitive.ML)
clasohm@923
     1
(*  Title:      HOL/hologic.ML
clasohm@923
     2
    ID:         $Id$
clasohm@923
     3
    Author:     Lawrence C Paulson and Markus Wenzel
clasohm@923
     4
clasohm@923
     5
Abstract syntax operations for HOL.
clasohm@923
     6
*)
clasohm@923
     7
clasohm@923
     8
signature HOLOGIC =
clasohm@923
     9
sig
clasohm@923
    10
  val termC: class
clasohm@923
    11
  val termS: sort
clasohm@923
    12
  val termTVar: typ
clasohm@923
    13
  val boolT: typ
clasohm@923
    14
  val mk_setT: typ -> typ
clasohm@923
    15
  val dest_setT: typ -> typ
clasohm@923
    16
  val mk_Trueprop: term -> term
clasohm@923
    17
  val dest_Trueprop: term -> term
clasohm@923
    18
  val conj: term
clasohm@923
    19
  val disj: term
clasohm@923
    20
  val imp: term
clasohm@923
    21
  val eq_const: typ -> term
clasohm@923
    22
  val all_const: typ -> term
clasohm@923
    23
  val exists_const: typ -> term
clasohm@923
    24
  val Collect_const: typ -> term
clasohm@923
    25
  val mk_eq: term * term -> term
clasohm@923
    26
  val mk_all: string * typ * term -> term
clasohm@923
    27
  val mk_exists: string * typ * term -> term
clasohm@923
    28
  val mk_Collect: string * typ * term -> term
clasohm@923
    29
  val mk_mem: term * term -> term
clasohm@923
    30
end;
clasohm@923
    31
clasohm@923
    32
structure HOLogic: HOLOGIC =
clasohm@923
    33
struct
clasohm@923
    34
clasohm@923
    35
(* classes *)
clasohm@923
    36
clasohm@923
    37
val termC: class = "term";
clasohm@923
    38
val termS: sort = [termC];
clasohm@923
    39
clasohm@923
    40
clasohm@923
    41
(* types *)
clasohm@923
    42
clasohm@923
    43
val termTVar = TVar (("'a", 0), termS);
clasohm@923
    44
clasohm@923
    45
val boolT = Type ("bool", []);
clasohm@923
    46
clasohm@923
    47
fun mk_setT T = Type ("set", [T]);
clasohm@923
    48
clasohm@923
    49
fun dest_setT (Type ("set", [T])) = T
clasohm@923
    50
  | dest_setT T = raise_type "dest_setT: set type expected" [T] [];
clasohm@923
    51
clasohm@923
    52
clasohm@923
    53
(* terms *)
clasohm@923
    54
clasohm@923
    55
val Trueprop = Const ("Trueprop", boolT --> propT);
clasohm@923
    56
clasohm@923
    57
fun mk_Trueprop P = Trueprop $ P;
clasohm@923
    58
clasohm@923
    59
fun dest_Trueprop (Const ("Trueprop", _) $ P) = P
clasohm@923
    60
  | dest_Trueprop t = raise_term "dest_Trueprop" [t];
clasohm@923
    61
clasohm@923
    62
clasohm@923
    63
val conj = Const ("op &", [boolT, boolT] ---> boolT)
clasohm@923
    64
and disj = Const ("op |", [boolT, boolT] ---> boolT)
clasohm@923
    65
and imp = Const ("op -->", [boolT, boolT] ---> boolT);
clasohm@923
    66
clasohm@923
    67
fun eq_const T = Const ("op =", [T, T] ---> boolT);
clasohm@923
    68
fun mk_eq (t, u) = eq_const (fastype_of t) $ t $ u;
clasohm@923
    69
clasohm@923
    70
fun all_const T = Const ("All", [T --> boolT] ---> boolT);
clasohm@923
    71
fun mk_all (x, T, P) = all_const T $ absfree (x, T, P);
clasohm@923
    72
clasohm@923
    73
fun exists_const T = Const ("Ex", [T --> boolT] ---> boolT);
clasohm@923
    74
fun mk_exists (x, T, P) = exists_const T $ absfree (x, T, P);
clasohm@923
    75
clasohm@923
    76
fun Collect_const T = Const ("Collect", [T --> boolT] ---> mk_setT T);
clasohm@923
    77
fun mk_Collect (a, T, t) = Collect_const T $ absfree (a, T, t);
clasohm@923
    78
clasohm@923
    79
fun mk_mem (x, A) =
clasohm@923
    80
  let val setT = fastype_of A in
clasohm@923
    81
    Const ("op :", [dest_setT setT, setT] ---> boolT) $ x $ A
clasohm@923
    82
  end;
clasohm@923
    83
clasohm@923
    84
clasohm@923
    85
end;
clasohm@923
    86