1:- module(type_bool,
    2	[
    3	 bool/1,
    4	 op(200, fy,  not),     % boolean 'not'
    5	 op(500, yfx, and),     % boolean 'and'
    6	 op(500, yfx, or)       % boolean 'or'
    7	]).    8
    9:- current_module(arithmetic_types) -> true ; use_module(library(arithmetic_types)).   10
   11:- arithmetic_function(and/2).        % boolean and
   12:- arithmetic_function(or/2).         % boolean or
   13:- arithmetic_function(not/1).        % boolean not
   14:- arithmetic_function(== /2).        % atomic equivalence
   15:- arithmetic_function(\== /2).       % atomic non-equivalence
   16:- arithmetic_function(< /2).         % atomic less than
   17:- arithmetic_function(=< /2).        % atomic less than or equal
   18:- arithmetic_function(>= /2).        % atomic greater than or equal
   19:- arithmetic_function(> /2).         % atomic greater than
   20:- arithmetic_function(between/3).    % atomic between
   21
   22%
   23% type bool, 0 or 1 (representing false or true)
   24%
   25bool(B) :- integer(B),  (B=0 ; B=1), !.
   26
   27%
   28% Function: logical operators
   29%
   30and(B1,B2,R) :- bool(B1), bool(B2), R is B1*B2.
   31
   32or(B1,B2,R)  :- bool(B1), bool(B2), R is max(B1,B2).
   33
   34not(B,R)     :- bool(B), R is (B+1) mod 2.
   35
   36%
   37% Function: atomic term comparisons
   38%
   39 ==(N1,N2,R) :- number(N1), number(N2), !, (N1 =:= N2 -> R=1 ; R=0).
   40 ==(A1,A2,R) :- atomic(A1), atomic(A2),    (A1  =  A2 -> R=1 ; R=0).
   41
   42\==(N1,N2,R) :- number(N1), number(N2), !, (N1 =:= N2 -> R=0 ; R=1).
   43\==(A1,A2,R) :- atomic(A1), atomic(A2),    (A1  =  A2 -> R=0 ; R=1).
   44
   45  <(N1,N2,R) :- number(N1), number(N2), !, (N1  <  N2 -> R=1 ; R=0).
   46  <(A1,A2,R) :- atomic(A1), atomic(A2),    (A1  @< A2 -> R=1 ; R=0).
   47  
   48 =<(N1,N2,R) :- number(N1), number(N2), !, (N1  =< N2 -> R=1 ; R=0).
   49 =<(A1,A2,R) :- atomic(A1), atomic(A2),    (A1 @=< A2 -> R=1 ; R=0).
   50 
   51 >=(N1,N2,R) :- number(N1), number(N2), !, (N1  >= N2 -> R=1 ; R=0).
   52 >=(A1,A2,R) :- atomic(A1), atomic(A2),    (A1 @>= A2 -> R=1 ; R=0).
   53 
   54  >(N1,N2,R) :- number(N1), number(N2), !, (N1  >  N2 -> R=1 ; R=0).
   55  >(A1,A2,R) :- atomic(A1), atomic(A2),    (A1  @> A2 -> R=1 ; R=0).
   56
   57%
   58% Function: between
   59%
   60between(N1,N2,N,R) :-   % R is (N1=<N) and (N=<N2).
   61	=<(N1,N,B1),
   62	=<(N,N2,B2),
   63	and(B1,B2,R)