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	]).

arithmetic type support for booleans

This module implements a set of functions on booleans which can be used in standard arithmetic expressions. A boolean value can either be a 0 (representing false) or 1 (representing true). The only exported predicate is the type check bool/1, in addition to the operator definitions for and, or, and not. For the most part the other boolean functions support reification of numeric and atomic term comparisons.

The set of boolean arithmetic functions defined by this module include:

:- arithmetic_function(and/2).        % boolean and
:- arithmetic_function(or/2).         % boolean or
:- arithmetic_function(not/1).        % boolean not
:- arithmetic_function(== /2).        % atomic equivalence
:- arithmetic_function(\== /2).       % atomic non-equivalence
:- arithmetic_function(< /2).         % atomic less than
:- arithmetic_function(=< /2).        % atomic less than or equal
:- arithmetic_function(>= /2).        % atomic greater than or equal
:- arithmetic_function(> /2).         % atomic greater than
:- arithmetic_function(between/3).    % atomic between

See the ReadMe for this pack for more documentation and examples. */

   30:- use_module(library(arithmetic_types)).   31%%:- current_module(arithmetic_types) -> true ; use_module(library(arithmetic_types)).
   32
   33:- arithmetic_function(and/2).        % boolean and
   34:- arithmetic_function(or/2).         % boolean or
   35:- arithmetic_function(not/1).        % boolean not
   36:- arithmetic_function(== /2).        % atomic equivalence
   37:- arithmetic_function(\== /2).       % atomic non-equivalence
   38:- arithmetic_function(< /2).         % atomic less than
   39:- arithmetic_function(=< /2).        % atomic less than or equal
   40:- arithmetic_function(>= /2).        % atomic greater than or equal
   41:- arithmetic_function(> /2).         % atomic greater than
   42:- arithmetic_function(between/3).    % atomic between
 bool(?X:boolean) is semidet
Succeeds if X is a boolean value (0 or 1 for false or true respectively) ; otherwise fails. */
   49%
   50% type bool, 0 or 1 (representing false or true)
   51%
   52bool(B) :- (B==0 ; B==1), !.
   53
   54%
   55% Function: logical operators
   56%
   57and(B1,B2,R) :- bool(B1), bool(B2), R is B1*B2.
   58
   59or(B1,B2,R)  :- bool(B1), bool(B2), R is max(B1,B2).
   60
   61not(B,R)     :- bool(B), R is (B+1) mod 2.
   62
   63%
   64% Function: atomic term comparisons
   65%
   66==(N1,N2,R)  :- number(N1), number(N2), !, (0 is cmpr(N1,N2) -> R=1 ; R=0).
   67==(A1,A2,R)  :- atomic(A1), atomic(A2),    (A1  =  A2 -> R=1 ; R=0).
   68
   69\==(N1,N2,R) :- number(N1), number(N2), !, R is abs(cmpr(N1,N2)).
   70\==(A1,A2,R) :- atomic(A1), atomic(A2),    (A1  =  A2 -> R=0 ; R=1).
   71
   72<(N1,N2,R)   :- number(N1), number(N2), !,  (-1 is cmpr(N1,N2) -> R=1 ; R=0).
   73<(A1,A2,R)   :- atomic(A1), atomic(A2),     (A1  @< A2 -> R=1 ; R=0).
   74  
   75=<(N1,N2,R)  :- number(N1), number(N2), !, (1 is cmpr(N1,N2) -> R=0 ; R=1).
   76=<(A1,A2,R)  :- atomic(A1), atomic(A2),    (A1 @=< A2 -> R=1 ; R=0).
   77 
   78>=(N1,N2,R)  :- number(N1), number(N2), !, (-1 is cmpr(N1,N2) -> R=0 ; R=1).
   79>=(A1,A2,R)  :- atomic(A1), atomic(A2),    (A1 @>= A2 -> R=1 ; R=0).
   80 
   81>(N1,N2,R)   :- number(N1), number(N2), !, (1 is cmpr(N1,N2) -> R=1 ; R=0).
   82>(A1,A2,R)   :- atomic(A1), atomic(A2),    (A1  @> A2 -> R=1 ; R=0).
   83
   84%
   85% Function: between
   86%
   87between(N1,N2,N,R) :-   % R is (N1=<N) and (N=<N2).
   88	=<(N1,N,B1),
   89	=<(N,N2,B2),
   90	and(B1,B2,R)