src/FOL/fologic.ML
changeset 9543 ce61d1c1a509
parent 9473 7d13a5ace928
child 9850 bee6eb4b6a42
equal deleted inserted replaced
9542:fa19ffdbe1de 9543:ce61d1c1a509
    12   val atomic_Trueprop	: string -> term
    12   val atomic_Trueprop	: string -> term
    13   val dest_Trueprop	: term -> term
    13   val dest_Trueprop	: term -> term
    14   val conj		: term
    14   val conj		: term
    15   val disj		: term
    15   val disj		: term
    16   val imp		: term
    16   val imp		: term
       
    17   val iff		: term
    17   val mk_conj		: term * term -> term
    18   val mk_conj		: term * term -> term
    18   val mk_disj		: term * term -> term
    19   val mk_disj		: term * term -> term
    19   val mk_imp		: term * term -> term
    20   val mk_imp		: term * term -> term
    20   val dest_imp	       	: term -> term*term
    21   val dest_imp	       	: term -> term*term
       
    22   val mk_iff		: term * term -> term
       
    23   val dest_iff	       	: term -> term*term
    21   val all_const		: typ -> term
    24   val all_const		: typ -> term
    22   val mk_all		: term * term -> term
    25   val mk_all		: term * term -> term
    23   val exists_const	: typ -> term
    26   val exists_const	: typ -> term
    24   val mk_exists		: term * term -> term
    27   val mk_exists		: term * term -> term
    25   val eq_const		: typ -> term
    28   val eq_const		: typ -> term
    26   val mk_eq		: term * term -> term
    29   val mk_eq		: term * term -> term
    27   val dest_eq 		: term -> term*term
    30   val dest_eq 		: term -> term*term
       
    31   val mk_binop: string -> term * term -> term
       
    32   val mk_binrel: string -> term * term -> term
       
    33   val dest_bin: string -> typ -> term -> term * term
    28 end;
    34 end;
    29 
    35 
    30 
    36 
    31 structure FOLogic: FOLOGIC =
    37 structure FOLogic: FOLOGIC =
    32 struct
    38 struct
    44 
    50 
    45 (** Logical constants **)
    51 (** Logical constants **)
    46 
    52 
    47 val conj = Const("op &", [oT,oT]--->oT)
    53 val conj = Const("op &", [oT,oT]--->oT)
    48 and disj = Const("op |", [oT,oT]--->oT)
    54 and disj = Const("op |", [oT,oT]--->oT)
    49 and imp = Const("op -->", [oT,oT]--->oT);
    55 and imp = Const("op -->", [oT,oT]--->oT)
       
    56 and iff = Const("op <->", [oT,oT]--->oT);
    50 
    57 
    51 fun mk_conj (t1, t2) = conj $ t1 $ t2
    58 fun mk_conj (t1, t2) = conj $ t1 $ t2
    52 and mk_disj (t1, t2) = disj $ t1 $ t2
    59 and mk_disj (t1, t2) = disj $ t1 $ t2
    53 and mk_imp (t1, t2) = imp $ t1 $ t2;
    60 and mk_imp (t1, t2) = imp $ t1 $ t2
       
    61 and mk_iff (t1, t2) = iff $ t1 $ t2;
    54 
    62 
    55 fun dest_imp (Const("op -->",_) $ A $ B) = (A, B)
    63 fun dest_imp (Const("op -->",_) $ A $ B) = (A, B)
    56   | dest_imp  t = raise TERM ("dest_imp", [t]);
    64   | dest_imp  t = raise TERM ("dest_imp", [t]);
       
    65 
       
    66 fun dest_iff (Const("op <->",_) $ A $ B) = (A, B)
       
    67   | dest_iff  t = raise TERM ("dest_iff", [t]);
    57 
    68 
    58 fun eq_const T = Const ("op =", [T, T] ---> oT);
    69 fun eq_const T = Const ("op =", [T, T] ---> oT);
    59 fun mk_eq (t, u) = eq_const (fastype_of t) $ t $ u;
    70 fun mk_eq (t, u) = eq_const (fastype_of t) $ t $ u;
    60 
    71 
    61 fun dest_eq (Const ("op =", _) $ lhs $ rhs) = (lhs, rhs)
    72 fun dest_eq (Const ("op =", _) $ lhs $ rhs) = (lhs, rhs)
    65 fun mk_all (Free(x,T),P) = all_const T $ (absfree (x,T,P));
    76 fun mk_all (Free(x,T),P) = all_const T $ (absfree (x,T,P));
    66 
    77 
    67 fun exists_const T = Const ("Ex", [T --> oT] ---> oT);
    78 fun exists_const T = Const ("Ex", [T --> oT] ---> oT);
    68 fun mk_exists (Free(x,T),P) = exists_const T $ (absfree (x,T,P));
    79 fun mk_exists (Free(x,T),P) = exists_const T $ (absfree (x,T,P));
    69 
    80 
       
    81 (* binary oprations and relations *)
       
    82 
       
    83 fun mk_binop c (t, u) =
       
    84   let val T = fastype_of t in
       
    85     Const (c, [T, T] ---> T) $ t $ u
       
    86   end;
       
    87 
       
    88 fun mk_binrel c (t, u) =
       
    89   let val T = fastype_of t in
       
    90     Const (c, [T, T] ---> oT) $ t $ u
       
    91   end;
       
    92 
       
    93 fun dest_bin c T (tm as Const (c', Type ("fun", [T', _])) $ t $ u) =
       
    94       if c = c' andalso T = T' then (t, u)
       
    95       else raise TERM ("dest_bin " ^ c, [tm])
       
    96   | dest_bin c _ tm = raise TERM ("dest_bin " ^ c, [tm]);
       
    97 
       
    98 
    70 end;
    99 end;