1:- module(purity, [
    2    pcompare/3,
    3    ptype/2,
    4    pif/3,
    5    pdif_t/3,
    6    pdif/2,
    7    ','/3,
    8    ';'/3,
    9    '='/3,
   10    '<'/3,
   11    '<='/3,
   12    '>'/3,
   13    '>='/3
   14]).   15
   16:- multifile(pcompare/4).   17:- multifile(ptype/2).   18
   19:- meta_predicate(pif(1, 0, 0)).   20
   21pcompare(A, B, C) :-
   22    ptype(A, T),
   23    ptype(B, T),
   24    pcompare(T, A, B, C).
   25
   26pif(Goal, TrueGoal, FalseGoal) :-
   27    call(Goal, R),
   28    pif_(R, TrueGoal, FalseGoal).
   29
   30pif_(true, Goal, _) :- call(Goal).
   31pif_(false, _, Goal) :- call(Goal).
   32
   33','(A, B, R) :-
   34    call(A, T),
   35    conj_(T, B, R).
   36
   37conj_(true, B, R) :-
   38    call(B, R).
   39conj_(false, _, false).
   40
   41';'(A, B, T) :-
   42    call(A, T)
   43    ; 
   44    call(B, T).
   45
   46pdif_t(A,B,R) :-
   47    pcompare(A,B,C),
   48    pdif_(C,R).
   49
   50pdif_(=,false).
   51pdif_(<,true).
   52pdif_(>,true).
   53
   54pdif(A,B) :- pdif_t(A, B, true).
   55
   56=(A, B, T) :- compare_with_states(eq_, A, B, T).
   57
   58eq_(=, true).
   59eq_(<, false).
   60eq_(>, false).
   61
   62<(A, B, T) :- compare_with_states(lt_, A, B, T).
   63
   64lt_(=, false).
   65lt_(<, true).
   66lt_(>, false).
   67
   68<=(A, B, T) :- compare_with_states(lte_, A, B, T).
   69
   70lte_(=, true).
   71lte_(<, true).
   72lte_(>, false).
   73
   74>(A, B, T) :- compare_with_states(gt_, A, B, T).
   75
   76gt_(=, false).
   77gt_(<, false).
   78gt_(>, true).
   79
   80>=(A, B, T) :- compare_with_states(gte_, A, B, T).
   81
   82gte_(=, true).
   83gte_(<, false).
   84gte_(>, true).
   85
   86compare_with_states(StateGoal, A, B, Truth) :-  
   87    pcompare(A, B, C),
   88    call(StateGoal, C, Truth)