1%-----------------------------------------------------------------------------%
    2% vim: ft=prolog ts=4 sw=4 et wm=0 tw=0
    3%-----------------------------------------------------------------------------%
    4:-module(hellgates, [ and/2,  op(1000, xfy, and),
    5					  or/2,   op(1100, xfy, or),
    6					  nand/2, op(1100, xfy, nand),
    7					  andn/2, op(1100, xfy, andn),
    8					  nor/2,  op(1100, xfy, nor),
    9					  orn/2,  op(1100, xfy, orn),
   10					  xor/2,  op(1100, xfy, xor),
   11					  orx/2,  op(1100, xfy, orx),
   12					  xnor/2, op(1100, xfy, xnor),
   13					  norx/2, op(1100, xfy, norx),
   14					  xorn/2, op(1100, xfy, xorn),
   15					  ornx/2, op(1100, xfy, ornx) ]).

Gates of Hell

An expansion of the Evil Prolog, this module allows you to follow the example of so many heroes such as Orpheus, Aeneas and Odysseus: denounce the garish light of day and use these Gates for a trip in the netherworld!

This module allows you to use more sophisticated binary operators than the trivial ',' and ';' hence enriching your prolog program. Combined with the closed-world hypothesis and unification issues, this module will definitely boost your reasoning powers unless you abandon all hope of understanding your program

author
- Thanos Tintinidis <thanosqr@gmail.com>
version
- 1.0
See also
- http://en.wikipedia.org/wiki/Gates_of_hell
deprecated
-
license
- This program is free software. It comes without any warranty, to the extent permitted by applicable law. You can redistribute it and/or modify it under the terms of the Do What The Fuck You Want To Public License, Version 2, as published by Sam Hocevar. See the file COPYING in the project root directory or consult http://www.wtfpl.net/txt/copying for more details.
To be done
-
Hell has no bottom; therefore, this module is damned eternally in a state of flux /
   44:- multifile license:license/3.   45licence:license(wtfpl, lgpl,
   46                [ comment('Do What The Fuck You Want To Public License'),
   47                  url('http://www.wtfpl.net/txt/copying')]).
   48:- license(wtfpl).   49
   50% Reminiscent of pascal? Why use the mundane ',' and ';' when this
   51% module provides the longer (and more descriptive) 'and' and 'or'?
 and(X:term, Y:term) is semidet
Pascal and other similar languages are so much easier to read with their actual words instead of punctuation.
   57X and Y :- X, Y.
 or(X:term, Y:term) is semidet
Pascal and other similar languages are so much easier to read with their actual words instead of punctuation.
   63X or Y :- X; Y.
 nand(X:term, Y:term) is semidet
Wanna give your co-workers a stroke? Then use a Sheffer stroke, also known as NAND; it is, after all, the only operator required for a functionally complete set, right?
1=1 nand 1=1.  %% false
1=1 nand 1=2.  %% true
1=2 nand 1=1.  %% true
1=2 nand 1=2.  %% true

But what happens when something is not fully instantiated?

T=1 nand T=2.  %% true
T=1 nand T=1.  %% false
   84X nand Y :- \+ (X, Y).
 andn(X:term, Y:term) is semidet
Some tasks may require a different behaviour from nand/2 so we included some alternate ways of handling non instantiated variables:
T=1 andn T=2. %% false
   94X andn Y :- once( (\+ X) ; (\+ Y)).
 nor(X:term, Y:term) is semidet
Left mostly undocumented to stem some of the tide of evil.
   99X nor Y :- \+ (X ; Y).
 orn(X:term, Y:term) is semidet
Left mostly undocumented to stem some of the tide of evil.
  104X orn Y :- \+ X, \+ Y.
 X:term xor Y:term is semidet
Left mostly undocumented to stem some of the tide of evil.
  109X xor Y :- once((X ; Y)), \+ (X,Y).
 orx(X:term, Y:term) is semidet
Left mostly undocumented to stem some of the tide of evil.
  114X orx Y :- once((X ; Y)), once((\+ X ; \+ Y)).
 xnor(X:term, Y:term) is semidet
Left mostly undocumented to stem some of the tide of evil.
  119X xnor Y :- \+ (X xor Y).
 norx(X:term, Y:term) is semidet
Left mostly undocumented to stem some of the tide of evil.
  124X norx Y :- once((X, Y) ; \+(X ; Y)).
 xorn(X:term, Y:term) is semidet
Left mostly undocumented to stem some of the tide of evil.
  129X xorn Y :- \+ ( \+ X, \+ Y).
 ornx(X:term, Y:term) is semidet
Left mostly undocumented to stem some of the tide of evil.
  134X ornx Y :- once(X ; Y)