1/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    2   Safe type tests
    3   ===============
    4   "si" stands for "sufficiently instantiated".
    5   These predicates:
    6    - throw instantiation errors if the argument is
    7      not sufficiently instantiated to make a sound decision
    8    - succeed if the argument is of the specified type
    9    - fail otherwise.
   10   For instance, atom_si(A) yields an *instantiation error* if A is a
   11   variable. This is logically sound, since in that case the argument
   12   is not sufficiently instantiated to make any decision.
   13   The definitions are taken from:
   14       https://stackoverflow.com/questions/27306453/safer-type-tests-in-prolog
   15   "si" can also be read as "safe inference", so possibly also other
   16   predicates are candidates for this library.
   17- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
   18
   19:- module(si, [atom_si/1,
   20               integer_si/1,
   21               atomic_si/1,
   22               list_si/1]).   23
   24:- use_module(library(lists)).   25
   26atom_si(A) :-
   27   functor(A, _, 0),    % for the instantiation error
   28   atom(A).
   29
   30integer_si(I) :-
   31   functor(I, _, 0),
   32   integer(I).
   33
   34atomic_si(AC) :-
   35   functor(AC,_,0).
   36
   37list_si(L) :-
   38   \+ \+ length(L, _),
   39   sort(L, _)