Go to the first, previous, next, last section, table of contents.


Built-In Predicates

It is not possible to redefine built-in predicates. An attempt to do so will give an error message. See section Summary of Built-In Predicates.

SICStus Prolog provides a wide range of built-in predicates to perform the following tasks:

Input / Output
     Reading-in Programs
     Term and Goal Expansion
     Input and Output of Terms
     Character I/O
     Stream I/O
     Dec-10 Prolog File I/O
Arithmetic
Comparison of Terms
Control
Error and Exception Handling
Information about the State of the Program
Meta-Logic
Modification of Terms
Modification of the Program
Internal Database
Blackboard Primitives
All Solutions
Coroutining
Debugging
Execution Profiling
Muse Support
Miscellaneous

The following descriptions of the built-in predicates are grouped according to the above categorization of their tasks.

Input / Output

There are two sets of file manipulation predicates in SICStus Prolog. One set is inherited from DEC-10 Prolog. These predicates always refer to a file by name. The other set of predicates is modeled after Quintus Prolog and refer to files as streams. Streams correspond to the file pointers used at the operating system level.

A stream can be opened and connected to a filename or file descriptor for input or output by calling the predicate open/3. open/3 will return a reference to a stream. The stream may then be passed as an argument to various I/O predicates. The predicate close/1 is used for closing a stream. The predicate current_stream/3 is used for retrieving information about a stream, and for finding the currently existing streams.

Prolog streams can be accessed from C functions as well. See section SICStus Streams, for details.

The possible formats of a stream are:

'$stream'(X)
A stream connected to some file. X is an integer.
user_input
An alias initially referring to the UNIX stdin stream. The alias can be changed with prolog_flag/3 and accessed by the C variable SP_stdin.
user_output
An alias initially referring to the UNIX stdout stream. The alias can be changed with prolog_flag/3 and accessed by the C variable SP_stdout.
user_error
An alias initially referring to the UNIX stderr stream. The alias can be changed with prolog_flag/3 and accessed by the C variable SP_stderr. This stream is used by the Prolog top level and debugger, and for progress and error messages.

The DEC-10 Prolog I/O predicates manipulate streams implicitly, by maintaining the notion of a current input stream and a current output stream. The current input and output streams are set to the user_input and user_output initially and for every new break (see section Nested Executions--Break and Abort). The predicate see/1 (tell/1) can be used for setting the current input (output) stream to newly opened streams for particular files. The predicate seen/0 (told/0) close the current input (output) stream, and resets it to the standard input (output) stream. The predicate seeing/1 (telling/1) is used for retrieving the filename associated with the current input (output) streams.

The possible formats of a filename are:

user
This "filename" stands for the standard input or output stream, depending on context. Terminal output is only guaranteed to be displayed if the output stream is explicitly flushed.
File
where File is any atom other than user, denotes a file File (with an optional `.pl' suffix when consulting or compiling or an optional `.ql' suffix in load/1) located using services provided by the operating system. On UNIX systems, Filenames beginning with `/' are absolute; other filenames are looked up in the current working directory.
Alias(File)
where File is an atom, denotes an alias which must be rewritten using the user defined predicate user:file_search_path/2 until an atomic filename is obtained.

Filenames beginning with `~' or `$' are treated specially. For example,

`~/sample.pl'
is equivalent to `/home/sics/al/sample.pl', if `/home/sics/al' is the user's home directory. (This is also equivalent to `$HOME/sample.pl' as explained below.)
`~clyde/sample.pl'
is equivalent to `/home/sics/clyde/sample.pl', if `/home/sics/clyde' is Clyde's home directory.
`$UTIL/sample.pl'
is equivalent to `/usr/local/src/utilities/sample.pl', provided the value of the environment variable UTIL is `/usr/local/src/utilities'.

Failure to open a file normally causes an exception to be raised. This behavior can be turned off and on by of the built-in predicates nofileerrors/0 and fileerrors/0 described below.

Reading-in Programs

When the predicates discussed in this section are invoked, filenames are relative to the current working directory. During the load, the current working directory is temporarily changed to the directory containing the file being read in. This has the effect that if one of these predicates is invoked recursively, the filename of the recursive load is relative to the directory of the enclosing load. See section Loading Programs, for an introduction to these predicates.

Directives will be executed in order of occurrence. Be aware of the changed current working directory as it could have an effect on the semantics of directives. Only the first solution of directives is produced, and variable bindings are not displayed. Directives that fail or raise exceptions cause warnings, but do not terminate the load.

Most of the predicates listed below take an argument Files which is a single file name or a list of file names. Source files usually end with an `.pl' suffix and object file names with an `.ql' suffix. These suffixes are optional. Each file name may optionally be prefixed by a module name. The module name specifies where to import the exported predicates of a module file, or where to store the predicates of a non-module file. The module is created if it doesn't exist already.

absolute_file_name/2 (see section Stream I/O) is used to look up the files. The file name user is reserved and denotes the standard input stream.

These predicates are available in Runtime Systems with the following limitations:

load_files(:Files)
load_files(:Files, +Options)
A generic predicate for loading files with a list of options to provide extra control. This predicate in fact subsumes the other predicates except use_module/3 which also returns the name of the loaded module. Options is a list of zero or more of the following:
if(X)
true (the default) to always load, or changed to load only if the file has not yet been loaded or if it has been modified since it was last loaded. A non-module file is not considered to have been previously loaded if it was loaded into a different module. The file user is never considered to have been previously loaded.
when(When)
always (the default) to always load, or compile_time to load only if the goal is not in the scope of another load_files/(1,2) goal loading object code. The latter is intended for use when the file only defines predicates that are needed for proper term or goal expansion during compilation of other files.
load_type(LoadType)
source to load source code only, object to load object code only, or latest (the default) to load source or object code, whichever is newest. If the file is user, source is forced.
imports(Imports)
all (the default) to import all exported predicates if the file is a module file, or a list of predicates to import.
compilation_mode(Mode)
compile to translate into compiled code, consult to translate into static, interpreted code, or assert_all to translate into dynamic, interpreted code. The default is the compilation mode of any ancestor load_files/(1,2) goal, or compile otherwise. Note that Mode has no effect when an object file is loaded, and that it is recommended to use assert_all in conjunction with load_type(source), to ensure that the source file will be loaded even in the presence of an object file.
consult(:Files)
reconsult(:Files)
[]
[:File|+Files]
Consults the source file or list of files specified by File and Files. Same as load_files(Files, [load_type(source),compilation_mode(consult)]).
compile(:Files)
Compiles the source file or list of files specified by Files. The compiled code is placed in-core, i.e. is added incrementally to the Prolog database. Same as load_files(Files, [load_type(source),compilation_mode(compile)]).
load(:Files)
Loads the object file or list of files specified by Files. Same as load_files(Files, [load_type(object)]).
ensure_loaded(:Files)
Compiles or loads the file or files specified by Files that have been modified after the file was last loaded, or that have not yet been loaded. The recommended style is to use this predicate for non-module files only, but if any module files are encountered, their public predicates are imported. Same as load_files(Files, [if(changed)]).
use_module(:File)
Compiles or loads the module file specified by File if it has been modified after it was last loaded, or not yet been loaded. Its public predicates are imported. The recommended style is to use this predicate for module files only, but any non-module files encountered are simply compiled or loaded. Same as load_files(File, [if(changed)]).
use_module(:File, +Imports)
Loads the module file File like ensure_loaded/1 and imports the predicates in Imports. If any of these are not public, a warning is issued. Imports may also be set to the atom all in which case all public predicates are imported. Same as load_files(File, [if(changed),imports(Imports)]).
use_module(?Module, :File, +Imports)
This is equivalent to use_module/2 with the addition that Module is unified with the loaded module after the loading.
fcompile(:Files)
Compiles the source file or list of files specified by Files. If Files are prefixed by a module name, that module name will be used for module name expansion during the compilation (see section Considerations for File-To-File Compilation). The suffix `.pl' is added to the given filenames to yield the real source filenames. The compiled code is placed on the object file or list of files formed by adding the suffix `.ql' to the given filenames. (This predicate is not available in Runtime Systems.)
source_file(?File)
File is the absolute name of a source file currently in the system.
source_file(:Head,?File)
source_file(-Head,?File)
Head is the most general goal for a predicate loaded from File.
require(:PredSpecOrSpecs)
PredSpecOrSpecs is a predicate spec or a list or a conjunction of such. The predicate will check if the specified predicates are loaded and if not, will try to load or import them using use_module/2. The file containing the predicate definitions will be located in the following way:

Term and Goal Expansion

When a program is being read in, SICStus Prolog provides hooks that enable the terms being read in to be source-to-source transformed before the usual processing of clauses or directives. The hooks consist in user-defined predicates that define the transformations. One transformation is always available, however: definite clause grammars, a convenient notation for expressing grammar rules. See [Colmerauer 75] and [Pereira & Warren 80].

Definite clause grammars are an extension of the well-known context-free grammars. A grammar rule in Prolog takes the general form

head --> body.

meaning "a possible form for head is body". Both body and head are sequences of one or more items linked by the standard Prolog conjunction operator `,'.

Definite clause grammars extend context-free grammars in the following ways:

  1. A non-terminal symbol may be any Prolog term (other than a variable or number).
  2. A terminal symbol may be any Prolog term. To distinguish terminals from non-terminals, a sequence of one or more terminal symbols is written within a grammar rule as a Prolog list. An empty sequence is written as the empty list `[]'. If the terminal symbols are character codes, such lists can be written (as elsewhere) as strings. An empty sequence is written as the empty list, `[]' or `""'.
  3. Extra conditions, in the form of Prolog procedure calls, may be included in the right-hand side of a grammar rule. Such procedure calls are written enclosed in `{}' brackets.
  4. The left-hand side of a grammar rule consists of a non-terminal, optionally followed by a sequence of terminals (again written as a Prolog list).
  5. Disjunction, if-then, if-then-else, and not-provable may be stated explicitly in the right-hand side of a grammar rule, using the operators `;' (`|'), `->', and `\+' as in a Prolog clause.
  6. The cut symbol may be included in the right-hand side of a grammar rule, as in a Prolog clause. The cut symbol does not need to be enclosed in `{}' brackets.

As an example, here is a simple grammar which parses an arithmetic expression (made up of digits and operators) and computes its value.

expr(Z) --> term(X), "+", expr(Y), {Z is X + Y}.
expr(Z) --> term(X), "-", expr(Y), {Z is X - Y}.
expr(X) --> term(X).

term(Z) --> number(X), "*", term(Y), {Z is X * Y}.
term(Z) --> number(X), "/", term(Y), {Z is X / Y}.
term(Z) --> number(Z).

number(C) --> "+", number(C).
number(C) --> "-", number(X), {C is -X}.
number(X) --> [C], {"0"=<C, C=<"9", X is C - "0"}.

In the last rule, C is the character code of some digit.

The query

| ?- expr(Z, "-2+3*5+1", []).

will compute Z=14. The two extra arguments are explained below.

Now, in fact, grammar rules are merely a convenient "syntactic sugar" for ordinary Prolog clauses. Each grammar rule takes an input string, analyses some initial portion, and produces the remaining portion (possibly enlarged) as output for further analysis. The arguments required for the input and output strings are not written explicitly in a grammar rule, but the syntax implicitly defines them. We now show how to translate grammar rules into ordinary clauses by making explicit the extra arguments.

A rule such as

p(X) --> q(X).

translates into

p(X, S0, S) :- q(X, S0, S).

If there is more than one non-terminal on the right-hand side, as in

p(X, Y) --> 
        q(X), 
        r(X, Y),
        s(Y).

then corresponding input and output arguments are identified, as in

p(X, Y, S0, S) :- 
        q(X, S0, S1), 
        r(X, Y, S1, S2), 
        r(Y, S2, S).

Terminals are translated using the built-in predicate 'C'(S1, X, S2), read as "point S1 is connected by terminal X to point S2", and defined by the single clause

'C'([X|S], X, S).

(This predicate is not normally useful in itself; it has been given the name upper-case c simply to avoid using up a more useful name.) Then, for instance

p(X) --> [go,to], q(X), [stop].

is translated by

p(X, S0, S) :-
        'C'(S0, go, S1), 
        'C'(S1, to, S2), 
        q(X, S2, S3), 
        'C'(S3, stop, S).

Extra conditions expressed as explicit procedure calls naturally translate as themselves, e.g.

p(X) --> [X], {integer(X), X>0}, q(X).

translates to

p(X, S0, S) :- 
        'C'(S0, X, S1), 
        integer(X), 
        X>0, 
        q(X, S1, S).

Similarly, a cut is translated literally.

Terminals are translated using the built-in predicate 'C'(S1, X, S2), read as "point S1 is connected by terminal X to point S2", and defined by the single clause

Terminals on the left-hand side of a rule are also translated using 'C'/3, connecting them to the output argument of the head non-terminal, e.g.

is(N), [not] --> [aint].

becomes

is(N, S0, S) :-
        'C'(S0, aint, S1),
        'C'(S, not, S1).

Disjunction has a fairly obvious translation, e.g.

args(X, Y) --> 
        (   dir(X), [to], indir(Y)
        ;   indir(Y), dir(X)
        ).

translates to

args(X, Y, S0, S) :-
        (   dir(X, S0, S1), 
            'C'(S1, to, S2), 
            indir(Y, S2, S)
        ;   indir(Y, S0, S1), 
            dir(X, S1, S)
        ).

Similarly for if-then, if-then-else, and not-provable.

The built-in predicates which are concerned with grammar rules and other compile/consult time transformations are as follows:

expand_term(+Term1,?Term2)
If Term1 is a term that can be transformed, Term2 is the result. Otherwise Term2 is just Term1 unchanged. This transformation takes place automatically when grammar rules are read in, but sometimes it is useful to be able to perform it explicitly. Grammar rule expansion is not the only transformation available; the user may define clauses for the predicate user:term_expansion/(2,4) to perform other transformations. user:term_expansion(Term1[,Layout1],Term2[,Layout2]) is called first, and only if it fails is the standard expansion used.
term_expansion(+Term1,?TermOrTerms)
user:term_expansion(+Term1,?TermOrTerms)
term_expansion(+Term1,+Layout1,?TermOrTerms,?Layout2)
user:term_expansion(+Term1,+Layout1,?TermOrTerms,?Layout2)
A hook predicate, which defines transformations on terms read while a program is consulted or compiled. It is called for every Term1 read, including at end of file, represented as the term end_of_file. If it succeeds, TermOrTerms is used for further processing, otherwise the default grammar rule expansion is attempted. It is often useful to let a term expand to a list of commands and clauses, which will then be processed sequentially. The 4 arguments version also defines transformations on the layout of the term read, so that the source-linked debugger can display accurate source code lines if the transformed code needs debugging. Layout1 is the layout corresponding to Term1, and Layout2 should be a valid layout of TermOrTerms (see section Input and Output of Terms). For accessing aspects of the load context, e.g. the name of the file being compiled, the predicate prolog_load_context/2 (see section Information about the State of the Program) can be used. user:term_expansion/(2,4) may also be used to transform queries entered at the terminal in response to the `| ?- ' prompt. In this case, it will be called with Term1 = ?-(Query) and should succeed with TermOrTerms = ?-(ExpandedQuery).
goal_expansion(+Goal,+Module,?NewGoal)
user:goal_expansion(+Goal,+Module,?NewGoal)
A hook predicate. This predicate defines transformations on goals while clauses are being consulted, compiled or asserted, after any processing by user:term_expansion/(2,4) of the terms being read in. It is called for every simple Goal encountered in the calling context Module. If it succeeds, Goal is replaced by NewGoal, otherwise Goal is left unchanged. NewGoal may be an arbitrarily complex goal, and user:goal_expansion/3 is recursively applied to its subgoals. This predicate is also used to resolve meta-calls to Goal at runtime via the same mechanism. If the transformation succeeds, NewGoal is simply called instead of Goal. Otherwise, if Goal is a goal of an existing predicate, that predicate is invoked. Otherwise, error recovery is attempted by user:unknown_predicate_handler/3 as described below. user:goal_expansion/3 can be regarded as a macro expansion facility. It is used for this purpose to support the interface to attributed variables in library(atts), which defines the predicates M:get_atts/2 and M:put_atts/2 to access module-specific variable attributes. These "predicates" are actually implemented via the user:goal_expansion/3 mechanism. This has the effect that calls to the interface predicates are expanded at compile time to efficient code. For accessing aspects of the load context, e.g. the name of the file being compiled, the predicate prolog_load_context/2 (see section Information about the State of the Program) can be used.
phrase(:Phrase,?List)
phrase(:Phrase,?List,+Remainder)
The list List is a phrase of type Phrase (according to the current grammar rules), where Phrase is either a non-terminal or more generally a grammar rule body. Remainder is what remains of the list after a phrase has been found. If called with 2 arguments, the remainder has to be the empty list.
'C'(?S1,?Terminal,?S2)
Not normally of direct use to the user, this built-in predicate is used in the expansion of grammar rules (see above). It is defined as if by the clause 'C'([X|S], X, S).

Input and Output of Terms

Most of the following predicates come in two versions, with or without a stream argument. Predicates without a stream argument operate on the current input or output stream, depending on context.

Some of these predicates support a notation for terms containing multiple occurrences of the same subterm (cycles and DAGs). The notation is @(Template,Substitution) where Substitution is a list of Var=Term pairs where the Var occurs in Template or in one of the Terms. This notation stands for the instance of Template obtained by binding each Var to its corresponding Term. The purpose of this notation is to provide a finite printed representation of cyclic terms. This notation is not used by default, and @/2 has no special meaning except in this context.

read(?Term) [ISO]
read(+Stream,?Term) [ISO]
The next term, delimited by a full-stop (i.e. a ., possibly followed by layout text), is read from Stream and is unified with Term. The syntax of the term must agree with current operator declarations. If a call read(Stream, Term) causes the end of Stream to be reached, Term is unified with the term end_of_file. Further calls to read/2 for the same stream will then raise an exception, unless the stream is connected to the terminal.
read_term(?Term,+Options) [ISO]
read_term(+Stream,?Term,+Options) [ISO]
Same as read/(1-2) with a list of options to provide extra control or information about the term. Options is a list of zero or more of:
syntax_errors(+Val)
Controls what action to take on syntax errors. Val must be one of the values allowed for the syntax_errors Prolog flag. The default is set by that flag.
variable_names(?Names)
Names is bound to a list of Name=Var pairs, where each Name is an atom indicating the name of a non-anonymous variable in the term, and Var is the corresponding variable.
singletons(?Names)
Names is bound to a list of Name=Var pairs, one for each variable appearing only once in the term and whose name does not begin with _.
cycles(+Boolean)
Boolean must be true or false. If selected, any occurrences of @/2 in the term read in are replaced by the potentially cyclic terms they denote as described above. Otherwise (the default), Term is just unified with the term read in.
layout(?Layout)
Layout is bound to a layout term corresponding to Term. The layout Y of a term X is one of:
  • If X is a variable or atomic term, Y is the number of the line where X occurs.
  • If X is a compound term, Y is a list whose head is the number of the line where the first token of X occurs, and whose remaining elements are the layouts of the arguments of X.
  • [], if no line number information is available for X.
| ?- read_term(T, [layout(L), variable_names(Va), singletons(S)]).
|: [
     foo(X),
     X = Y
     ].

L = [35,[36,36],[36,[37,37,37],38]],
S = ['Y'=_A],
T = [foo(_B),_B=_A],
Va = ['X'=_B,'Y'=_A]
write(?Term) [ISO]
write(+Stream,?Term) [ISO]
The term Term is written onto Stream according to current operator declarations. Same as write_term([Stream,] Term, [numbervars(true)]).
display(?Term)
The term Term is displayed onto the standard output stream (which is not necessarily the current output stream) in standard parenthesized prefix notation. Same as write_term(user, Term, [ignore_ops(true)]).
write_canonical(?Term) [ISO]
write_canonical(+Stream,?Term) [ISO]
Similar to write(Stream,Term). The term will be written according to the standard syntax. The output from write_canonical/2 can be parsed by read/2 even if the term contains special characters or if operator declarations have changed. Same as write_term([Stream,] Term, [quoted(true),ignore_ops(true)]).
writeq(?Term) [ISO]
writeq(+Stream,?Term) [ISO]
Similar to write(Stream,Term), but the names of atoms and functors are quoted where necessary to make the result acceptable as input to read/2, provided the same operator declarations are in effect. Same as write_term([Stream,] Term, [quoted(true),numbervars(true)]).
print(?Term)
print(+Stream,?Term)
Hookable. Prints Term onto Stream. This predicate provides a handle for user defined pretty printing: In particular, the debugging package prints the goals in the tracing messages, and the top-level prints the final values of variables. Thus you can vary the forms of these messages if you wish. Note that on lists ([_|_]), print/2 will first give the whole list to user:portray/1, but if this fails it will only give each of the (top level) elements to user:portray/1. That is, user:portray/1 will not be called on all the tails of the list. Same as write_term([Stream,] Term, [portrayed(true),numbervars(true)]).
portray(+Term)
user:portray(+Term)
A hook predicate. This should either print the Term and succeed, or do nothing and fail. In the latter case, the default printer (write/1) will print the Term.
portray_clause(+Clause)
portray_clause(+Stream,+Clause)
Writes the clause Clause onto Stream exactly as listing/(0-1) would have written it. Same as write_term([Stream,] Term, [quoted(true),numbervars(true),indented(true)]) followed by a period and a newline, removing redundant module prefixes and binding variables to terms of the form '$VAR'(N) yielding friendlier variable names.
write_term(+Term,+Options) [ISO]
write_term(+Stream,+Term,+Options) [ISO]
Same as write/(1-2) etc. with a list of options to provide extra control. This predicate in fact subsumes the above output predicates except portray_clause/(1,2) which additionally prints a period and a newline, and removes module prefixes that are redundant wrt. the current type-in module. Options is a list of zero or more of the following, where Boolean must be true or false (false is the default).
quoted(+Boolean)
If selected, functors are quoted where necessary to make the result acceptable as input to read/1. write_canonical/1, writeq/1, and portray_clause/1 select this.
ignore_ops(+Boolean)
If selected, Term is written in standard parenthesized notation instead of using operators. write_canonical/1 and display/1 select this.
portrayed(+Boolean)
If selected, user:portray/1 is called for each subterm. print/1 selects this.
numbervars(+Boolean)
If selected, occurrences of '$VAR'(N) where N is an integer >= 0 are treated specially (see numbervars/3). print/1, write/1, writeq/1, and portray_clause/1 select this.
cycles(+Boolean)
If selected, the potentially cyclic term is printed in finite @/2 notation, as discussed above.
indented(+Boolean)
If selected, the term is printed with the same indentation as is used by portray_clause/1 and listing/(0-1).
max_depth(N)
Depth limit on printing. N is an integer. 0 (the default) means no limit.
format(+Format,+Arguments)
format(+Stream,+Format,+Arguments)
Prints Arguments onto Stream according to format Format. Format is a list of formatting characters. If Format is an atom then name/2 (see section Meta-Logic) will be used to translate it into a list of characters. Thus
| ?- format("Hello world!", []).
has the same effect as
| ?- format('Hello world!', []).
format/2 and format/3 is a Prolog interface to the C stdio function printf(). It is modeled after and compatible with Quintus Prolog. Arguments is a list of items to be printed. If there are no items then an empty list should be supplied. The default action on a format character is to print it. The character ~ introduces a control sequence. To print a ~ repeat it:
| ?- format("Hello ~~world!", []).
will result in
Hello ~world!
The escape sequence (see section Escape Sequences) \c (c for continue) is useful when formatting a string for readability. It causes all characters up to, but not including, the next non-layout character to be ignored.
| ?- format("Hello \c
             world!", []).
will result in
Hello world!
The general format of a control sequence is `~NC'. The character C determines the type of the control sequence. N is an optional numeric argument. An alternative form of N is `*'. `*' implies that the next argument in Arguments should be used as a numeric argument in the control sequence. Example:
| ?- format("Hello~4cworld!", [0'x]).
and
| ?- format("Hello~*cworld!", [4,0'x]).
both produce
Helloxxxxworld!
The following control sequences are available.
`~a'
The argument is an atom. The atom is printed without quoting.
`~Nc'
(Print character.) The argument is a number that will be interpreted as a character code. N defaults to one and is interpreted as the number of times to print the character.
`~Ne'
`~NE'
`~Nf'
`~Ng'
`~NG'
(Print float). The argument is a float. The float and N will be passed to the C printf() function as
printf("%.Ne", Arg)
printf("%.NE", Arg)
printf("%.Nf", Arg)
printf("%.Ng", Arg)
printf("%.NG", Arg)
respectively. If N is not supplied the action defaults to
printf("%e", Arg)
printf("%E", Arg)
printf("%f", Arg)
printf("%g", Arg)
printf("%G", Arg)
respectively.
`~Nd'
(Print decimal.) The argument is an integer. N is interpreted as the number of digits after the decimal point. If N is 0 or missing, no decimal point will be printed. Example:
| ?- format("Hello ~1d world!", [42]).
Hello 4.2 world!

| ?- format("Hello ~d world!", [42]).
Hello 42 world!
`~ND'
(Print decimal.) The argument is an integer. Identical to `~Nd' except that `,' will separate groups of three digits to the left of the decimal point. Example:
| ?- format("Hello ~1D world!", [12345]).
Hello 1,234.5 world!
`~Nr'
(Print radix.) The argument is an integer. N is interpreted as a radix, 2 =< N =< 36. If N is missing the radix defaults to 8. The letters `a-z' will denote digits larger than 9. Example:
| ?- format("Hello ~2r world!", [15]).
Hello 1111 world!

| ?- format("Hello ~16r world!", [15]).
Hello f world!
`~NR'
(Print radix.) The argument is an integer. Identical to `~Nr' except that the letters `A-Z' will denote digits larger than 9. Example:
| ?- format("Hello ~16R world!", [15]).
Hello F world!
`~Ns'
(Print string.) The argument is a list of character codes. Exactly N characters will be printed. N defaults to the length of the string. Example:
| ?- format("Hello ~4s ~4s!", ["new","world"]).
Hello new  worl!

| ?- format("Hello ~s world!", ["new"]).
Hello new world!
`~i'
(Ignore.) The argument, which may be of any type, is ignored. Example:
| ?- format("Hello ~i~s world!", ["old","new"]).
Hello new world!
`~k'
(Print canonical.) The argument may be of any type. The argument will be passed to write_canonical/1 (see section Input and Output of Terms). Example:
| ?- format("Hello ~k world!", [[a,b,c]]).
Hello .(a,.(b,.(c,[]))) world!
`~p'
(Print.) The argument may be of any type. The argument will be passed to print/1 (see section Input and Output of Terms). Example:
| ?- assert((portray([X|Y]) :- print(cons(X,Y)))).
| ?- format("Hello ~p world!", [[a,b,c]]).
Hello cons(a,cons(b,cons(c,[]))) world!
`~q'
(Print quoted.) The argument may be of any type. The argument will be passed to writeq/1 (see section Input and Output of Terms). Example:
| ?- format("Hello ~q world!", [['A','B']]).
Hello ['A','B'] world!
`~w'
(Write.) The argument may be of any type. The argument will be passed to write/1 (see section Input and Output of Terms). Example:
| ?- format("Hello ~w world!", [['A','B']]).
Hello [A,B] world!
`~@'
(Call.) The argument is a goal, which will be called and expected to print on the current output stream. If the goal is not a built-in predicate, it should be module prefixed, as format/(2-3) are not meta-predicates. If the goal performs other side-effects or does not succeed deterministically, the behavior is undefined. Example:
| ?- format("Hello ~@ world!", [write(new)]).
Hello new world!
`~~'
(Print tilde.) Takes no argument. Prints `~'. Example:
| ?- format("Hello ~~ world!", []).
Hello ~ world!
`~Nn'
(Print newline.) Takes no argument. Prints N newlines. N defaults to 1. Example:
| ?- format("Hello ~n world!", []).
Hello
 world!
`~N'
(Print Newline.) Prints a newline if not at the beginning of a line.
The following control sequences set column boundaries and specify padding. A column is defined as the available space between two consecutive column boundaries on the same line. A boundary is initially assumed at line position 0. The specifications only apply to the line currently being written. When a column boundary is set (`~|' or `~+') and there are fewer characters written in the column than its specified width, the remaining space is divided equally amongst the pad sequences (`~t') in the column. If there are no pad sequences, the column is space padded at the end. If `~|' or `~+' specifies a position preceding the current position, the boundary is set at the current position.
`~N|'
Set a column boundary at line position N. N defaults to the current position.
`~N+'
Set a column boundary at N positions past the previous column boundary. N defaults to 8.
`~Nt'
Specify padding in a column. N is the fill character code. N may also be specified as `C where C is the fill character. The default fill character is SPC. Any (`~t') after the last column boundary on a line is ignored.
Example:
| ?-
        format("~`*t NICE TABLE ~`*t~61|~n", []),
        format("*~t*~61|~n", []),
        format("*~t~a~20|~t~a~t~20+~a~t~20+~t*~61|~n",
               ['Right aligned','Centered','Left aligned']),
        format("*~t~d~20|~t~d~t~20+~d~t~20+~t*~61|~n",
               [123,45,678]),
        format("*~t~d~20|~t~d~t~20+~d~t~20+~t*~61|~n",
               [1,2345,6789]),
        format("~`*t~61|~n", []).

************************ NICE TABLE *************************
*                                                           *
*      Right aligned      Centered      Left aligned        *
*                123         45         678                 *
*                  1        2345        6789                *
*************************************************************

Character Input/Output

There are two sets of character I/O predicates. The first set uses the current input and output streams, while the second set always uses the standard input and output streams. The first set is available in an alternative version where the stream is specified explicitly. The rule is that the stream is the first argument, which defaults to the current input or output stream, depending on context.

nl [ISO]
nl(+Stream) [ISO]
A new line is started on Stream by printing an LFD. If Stream is connected to the terminal, its buffer is flushed.
get0(?N) [ISO]
get0(+Stream,?N) [ISO]
N is the character code of the next character read from Stream. If all characters of Stream have been read, N is -1, and further calls to get0/2 for the same stream will then raise an exception, unless the stream is connected to the terminal. These predicates are called get_code/(1-2) in the ISO Prolog standard.
peek_char(?N) [ISO]
peek_char(+Stream,?N) [ISO]
N is the character code of the next character from Stream, or -1, if all characters of Stream have been read, N. The character is not actually read, it is only looked at and is still available for subsequent input. These predicates are called peek_code/(1-2) in the ISO Prolog standard.
get(?N)
get(+Stream,?N)
Same as get0/2, except N is the character code of the next character that is not a layout-char (see section Syntax of Tokens as Character Strings) read from Stream.
skip(+N)
skip(+Stream,+N)
Skips just past the next character code N from Stream. N may be an arithmetic expression.
skip_line
skip_line(+Stream)
Skips just past the next LFD from Stream.
put(+N) [ISO]
put(+Stream,+N) [ISO]
Character code N is output onto Stream. N may be an arithmetic expression. These predicates are called put_code/(1-2) in the ISO Prolog standard.
tab(+N)
tab(+Stream,+N)
N spaces are output onto Stream. N may be an arithmetic expression.

The above predicates are the ones which are the most commonly used, as they can refer to any streams. The predicates which follow always refer to the standard input and output streams. They are provided for compatibility DEC-10 character I/O, and are actually redundant and easily recoded in terms of the above predicates.

ttynl
Same as nl(user).
ttyflush
Same as flush_output(user).
ttyget0(?N)
Same as get0(user, N).
ttyget(?N)
Same as get(user, N).
ttyput(+N)
Same as put(user, N).
ttyskip(+N)
Same as skip(user, N).
ttytab(+N)
Same as tab(user, N).

Stream I/O

The following predicates manipulate streams. Character and line counts are maintained per stream. All streams connected to the terminal, however, share the same set of counts. For example, writing to user_output will advance the counts for user_input, if both are connected to the terminal. Bidirectional streams use the same counters for input and output.

open(+FileName,+Mode,-Stream) [ISO]
open(+FileName,+Mode,-Stream,+Options) [ISO]
If FileName is a valid file name, the file is opened in mode Mode (invoking the UNIX function fopen) and the resulting stream is unified with Stream. Mode is one of:
read
Open the file for input.
write
Open the file for output. The file is created if it does not already exist, the file will otherwise be truncated.
append
Open the file for output. The file is created if it does not already exist, the file will otherwise be appended to.
If FileName is an integer, it is assumed to be a file descriptor passed to Prolog from C. The file descriptor is connected to a Prolog stream (invoking the POSIX function fdopen) which is unified with Stream. Options is a list of zero or more of:
type(+T)
Specifies whether the stream is a text or binary stream. Default is text.
close(+X) [ISO]
If X is a stream, the stream is closed. If X is the name of a file opened by see/1 or tell/1, the corresponding stream is closed.
absolute_file_name(+RelativeName,-AbsoluteName)
True if RelativeName can be expanded to an absolute file name (an atom) AbsoluteName, according to the filename syntax rules (see section Input / Output). This predicate will first search for a file with the suffix `.pl' added to the name given as an argument. If this fails, it will look for a file with no extra suffix added. If a file is found AbsoluteName is its absolute file name is returned. Otherwise, AbsoluteName is a valid expansion of RelativeName, absolute_file_name/2 does not produce alternative expansions via backtracking. If RelativeName is user, then AbsoluteName is also unified with user; this "filename" stands for the standard input or output stream, depending on context. Variants of this predicate are used by all predicates that refer to filenames for resolving these. Predicates that load code require that the specified file exist, possibly with a `.pl' or `.ql' extension.
file_search_path(Alias,?Expansion)
user:file_search_path(Alias,?Expansion)
A hook predicate. This predicate specifies a set of possible file name expansions to be tried when a file specification of the form Alias(Name) is used in a predicate that accepts a filename argument. Alias and Name must be atoms. There are two possible cases for Expansion. Since it is possible to have multiple definitions for the same alias, predicates such as compile/1 may have to explore several alternative expansions before they locate the file to compile. Predicates such as compile/1 look for a file with a `.pl' suffix as well as for a file without the suffix. load/1 looks for a file with a `.ql' suffix. Aliases are useful in writing portable code, as they minimize the number of places where a program has to be changed if the program or its environment is moved to a different location. file_search_path/2 is always called in the user module. The predicate exists as a dynamic, multifile predicate at startup with a single clause defining an expansion for the library/1 alias:
file_search_path(library,Path) :- library_directory(Path).
library_directory(?Directory)
user:library_directory(?Directory)
A hook predicate. This predicate specifies a set of directories to be searched when a file specification of the form library(Name) is used. The predicate exists as a dynamic, multifile predicate at startup. Directories to be searched may be added by using asserta/1 or assertz/1 (see section Modification of the Program):
| ?- assertz(user:file_search_path(home, '$HOME')).
| ?- assertz(user:file_search_path(demo, home('prolog/demo'))).
| ?- assertz(user:library_directory(home('prolog/lib'))).
With these declarations, the file name demo(mydemo) would expand to '$HOME/prolog/demo/mydemo', where '$HOME' is interpreted as an environment variable (the user's home directory). File names of the form library(mymodule) would be looked up in '$HOME/prolog/lib' if they cannot be found in the default library directory.
current_input(?Stream) [ISO]
Stream is the current input stream. The current input stream is also accessed by the C variable SP_curin.
current_output(?Stream) [ISO]
Stream is the current output stream. The current output stream is also accessed by the C variable SP_curout.
current_stream(?FileName,?Mode,?Stream)
Stream is a stream which was opened in mode Mode and which is connected to the absolute file name Filename (an atom) or to the file descriptor Filename (an integer). This predicate can be used for enumerating all currently open streams through backtracking.
set_input(+Stream) [ISO]
Sets the current input stream to Stream.
set_output(+Stream) [ISO]
Sets the current output stream to Stream.
flush_output [ISO]
flush_output(+Stream) [ISO]
Flushes all internally buffered characters for Stream to the operating system.
open_null_stream(-Stream)
Opens an output stream. Everything written to this stream will be thrown away.
character_count(+Stream,?N)
N is the number of characters read/written on stream Stream.
line_count(+Stream,?N)
N is the number of lines read/written on stream Stream.
line_position(+Stream,?N)
N is the number of characters read/written on the current line of Stream.
stream_position(+Stream,?Position)
Position is a term representing the current position of Stream. The relative order of stream position terms can be tested with standard term comparison predicates such as compare/3, but you should not otherwise rely on their internal representation. This operation is available for any Prolog stream.
set_stream_position(+Stream,+Position) [ISO]
Position is a term representing a new position of Stream, which is then set to the new position. This operation is only available for Prolog streams connected to "seekable devices" (disk files, usually).
seek(+Stream,+Offset,+Method,-NewLocation)
True if the stream Stream can be set to the byte offset Offset relative to Method, and NewLocation is the new byte offset from the beginning of the file after the operation. Method must be one of:
bof
Seek from the beginning of the file stream.
current
Seek from the current position of the file stream.
eof
Seek from the end of the file stream.
This operation is only available for Prolog streams connected to "seekable devices" (disk files, usually) and is an interface to the stdio functions fseek and ftell.
at_end_of_stream [ISO]
at_end_of_stream(+Stream) [ISO]
The end of stream has been reached for Stream. An input stream reaches end of stream when all characters (except EOF) of the stream have been read. These predicates peek ahead for next input character if there is no character available on the buffer of Stream. Unless the stream is to be treated as connected to the terminal (see SP_force_interactive, section Initializing the Prolog Engine), a stream remains at end of stream after EOF has been read, and any further attempt to read from the stream will raise an existence error (see section Error and Exception Handling).
at_end_of_line
at_end_of_line(+Stream)
The end of stream or end of line has been reached for Stream. An input stream reaches end of line when all the characters except LFD of the current line have been read. These predicates peek ahead for next input character if there is no character available on the buffer of Stream.
fileerrors
Undoes the effect of nofileerrors/0.
nofileerrors
After a call to this predicate, failure to locate or open a file will cause the operation to fail instead of the default action, which is to raise an exception with an error message.
stream_select(+Streams,+TimeOut,-ReadStreams)
The list of streams in Streams is checked for readable characters. A stream can be any stream associated with an I/O descriptor. The list ReadStreams returns the streams with readable data. If TimeOut is instantiated to off, the predicate waits until something is available. If TimeOut is S:U the predicate waits at most S seconds and U microseconds. Both S and U must be integers >=0. If there is a timeout, ReadStreams is []. Not available in Muse. Not available in operating systems that do not support the system() system call.
stream_interrupt(?Stream,?OldHandler,?NewHandler)
Installs NewHandler as an interrupt-handler which is invoked when something is readable on Stream. OldHandler is the current interrupt handler Stream must be associated with an I/O descriptor. Interrupt handlers are specified as atoms. The atom off indicates that the interrupt mechanism is turned off for Stream. Any other atom is the name of a predicate invoked when something is readable on Stream. The handler predicate has one argument, the stream that is readable. For example,
stream_interrupt(Stream, _, int_handler).
will enable the interrupt mechanism. Given the predicate
int_handler(Stream) :-
        read(Stream, Data),
        write(Data), nl.
the term read from Stream will be written to the current output. Note: there is no guarantee that a complete Prolog term is available yet. If not, read/2 will suspend as usual. Not available in Muse. Not available in operating systems that do not provide the ability to generate signals when new data becomes available on a file descriptor.

DEC-10 Prolog File I/O

The following predicates manipulate files.

see(+File)
The file File becomes the current input stream. File may be a stream previously opened by see/1 or a filename. If it is a filename, the following action is taken: If there is a stream opened by see/1 associated with the same file already, then it becomes the current input stream. Otherwise, the file File is opened for input and made the current input stream.
seeing(?FileName)
FileName is unified with the name of the current input file, if it was opened by see/1, with the current input stream, if it is not user_input, otherwise with user.
seen
Closes the current input stream, and resets it to user_input.
tell(+File)
The file File becomes the current output stream. File may be a stream previously opened by tell/1 or a filename. If it is a filename, the following action is taken: If there is a stream opened by tell/1 associated with the same file already, then it becomes the current output stream. Otherwise, the file File is opened for output and made the current output stream.
telling(?FileName)
FileName is unified with the name of the current output file, if it was opened by tell/1, with the current output stream, if it is not user_output, otherwise with user.
told
Closes the current output stream, and resets it to user_output.

An Example

Here is an example of a common form of file processing:

process_file(F) :-
        seeing(OldInput),
        see(F),                 % Open file F
        repeat,
          read(T),              % Read a term
          process_term(T),      % Process it
          T == end_of_file,     % Loop back if not at end of file
        !,
        seen,                   % Close the file
        see(OldInput).

The above is an example of a repeat loop. Nearly all sensible uses of repeat/0 follow the above pattern. Note the use of a cut to terminate the loop.

Arithmetic

Arithmetic is performed by built-in predicates which take as arguments arithmetic expressions and evaluate them. An arithmetic expression is a term built from numbers, variables, and functors that represent arithmetic functions. At the time of evaluation, each variable in an arithmetic expression must be bound to a non-variable expression. An expression evaluates to a number, which may be an integer or a float.

The range of integers is [-2^2147483616, 2^2147483616). Thus for all practical purposes, the range of integers can be considered infinite.

The range of floats is the one provided by the C double type, typically [4.9e-324, 1.8e+308] (plus or minus).

Only certain functors are permitted in an arithmetic expression. These are listed below, together with an indication of the functions they represent. X and Y are assumed to be arithmetic expressions. Unless stated otherwise, the arguments of an expression may be any numbers and its value is a float if any of its arguments is a float, otherwise the value is an integer. Any implicit coercions are performed with the integer/1 and float/1 functions.

+(X)
The value is X.
-X
The value is the negative of X.
X+Y
The value is the sum of X and Y.
X-Y
The value is the difference of X and Y.
X*Y
The value is the product of X and Y.
X/Y
The value is the float quotient of X and Y.
X//Y
The value is the integer quotient of X and Y.
X mod Y
The value is the integer remainder after dividing X by Y, i.e. integer(X)-integer(Y)*(X//Y).
integer(X)
The value is the closest integer between X and 0, if X is a float, otherwise to X itself.
float(X)
The value is the float equivalent of X, if X is an integer, otherwise to X itself.
X/\Y
The value is the bitwise conjunction of the integers X and Y.
X\/Y
The value is the bitwise disjunction of the integers X and Y.
X#Y
The value is the bitwise exclusive or of the integers X and Y.
\(X)
The value is the bitwise negation of the integer X.
X<<Y
The value is the integer X shifted left by Y places.
X>>Y
The value is the integer X shifted right by Y places.
[X]
A list of just one number X evaluates to X. Since a quoted string is just a list of integers, this allows a quoted character to be used in place of its character code; e.g. "A" behaves within arithmetic expressions as the integer 65.

SICStus Prolog also includes an extra set of functions listed below. These may not be supported by other Prologs. All trigonometric and transcendental functions take float arguments and deliver float values. The trigonometric functions take arguments or deliver values in radians.

abs(X)
The value is the absolute value of X.
gcd(X,Y)
The value is the greatest common divisor of the two integers X and Y.
min(X,Y)
The value is the lesser value of X and Y.
max(X,Y)
The value is the greater value of X and Y.
msb(X)
The value is the most significant bit position of the integer X. It is equivalent to, but more efficient than, integer(log(2,X)).
round(X)
The value is the float that is the closest integral value to X. If X is exactly half-way between two integers, it must be rounded to the closest even integral value.
truncate(X)
The value is the float that is the closest integer between X and 0.
floor(X)
The value is the float that is the greatest integral value less or equal to X.
ceiling(X)
The value is the float that is the least integral value greater or equal to X.
sin(X)
The value is the sine of X.
cos(X)
The value is the cosine of X.
tan(X)
The value is the tangent of X.
cot(X)
The value is the cotangent of X.
sinh(X)
The value is the hyperbolic sine of X.
cosh(X)
The value is the hyperbolic cosine of X.
tanh(X)
The value is the hyperbolic tangent of X.
coth(X)
The value is the hyperbolic cotangent of X.
asin(X)
The value is the arc sine of X.
acos(X)
The value is the arc cosine of X.
atan(X)
The value is the arc tangent of X.
atan2(X,Y)
The value is the four-quadrant arc tangent of X and Y.
acot(X)
The value is the arc cotangent of X.
acot2(X,Y)
The value is the four-quadrant arc cotangent of X and Y.
asinh(X)
The value is the hyperbolic arc sine of X.
acosh(X)
The value is the hyperbolic arc cosine of X.
atanh(X)
The value is the hyperbolic arc tangent of X.
acoth(X)
The value is the hyperbolic arc cotangent of X.
sqrt(X)
The value is the square root of X.
log(X)
The value is the natural logarithm of X.
log(Base,X)
The value is the logarithm of X in the base Base.
exp(X)
The value is the natural exponent of X.
exp(X,Y)
The value is X raised to the power of Y.
inf
The value is infinity as defined in the IEEE standard.
nan
The value is not-a-number as defined in the IEEE standard.

Variables in an arithmetic expression which is to be evaluated may be bound to other arithmetic expressions rather than just numbers, e.g.

evaluate(Expression, Answer) :- Answer is Expression.

| ?- evaluate(24*9, Ans).
Ans = 216 ?

yes

Arithmetic expressions, as described above, are just data structures. If you want one evaluated you must pass it as an argument to one of the built-in predicates listed below. Note that it only evaluates one of its arguments, whereas all the comparison predicates evaluate both of theirs. In the following, X and Y stand for arithmetic expressions, and Z for some term.

Z is X [ISO]
X, which must be an arithmetic expression, is evaluated and the result is unified with Z.
X =:= Y [ISO]
The numeric values of X and Y are equal.
X =\= Y [ISO]
The numeric values of X and Y are not equal.
X < Y [ISO]
The numeric value of X is less than the numeric value of Y.
X > Y [ISO]
The numeric value of X is greater than the numeric value of Y.
X =< Y [ISO]
The numeric value of X is less than or equal to the numeric value of Y.
X >= Y [ISO]
The numeric value of X is greater than or equal to the numeric value of Y.

Comparison of Terms

These built-in predicates are meta-logical. They treat uninstantiated variables as objects with values which may be compared, and they never instantiate those variables. They should not be used when what you really want is arithmetic comparison (see section Arithmetic) or unification.

The predicates make reference to a standard total ordering of terms, which is as follows:

For example, here is a list of terms in standard order:

[ X, -1.0, -9, 1, fie, foe, X = Y, foe(0,2), fie(1,1,1) ]

Note: the standard order is only well-defined for finite (acyclic) terms. There are infinite (cyclic) terms for which no order relation holds. Furthermore, blocking goals (see section Procedural Semantics) on variables or modifying their attributes (see section Attributed Variables) does not preserve their order.

These are the basic predicates for comparison of arbitrary terms:

Term1 == Term2 [ISO]
The terms currently instantiating Term1 and Term2 are literally identical (in particular, variables in equivalent positions in the two terms must be identical). For example, the query
| ?- X == Y.
fails (answers `no') because X and Y are distinct uninstantiated variables. However, the query
| ?- X = Y, X == Y.
succeeds because the first goal unifies the two variables (see section Miscellaneous).
Term1 \== Term2 [ISO]
The terms currently instantiating Term1 and Term2 are not literally identical.
Term1 @< Term2 [ISO]
The term Term1 is before the term Term2 in the standard order.
Term1 @> Term2 [ISO]
The term Term1 is after the term Term2 in the standard order.
Term1 @=< Term2 [ISO]
The term Term1 is not after the term Term2 in the standard order.
Term1 @>= Term2 [ISO]
The term Term1 is not before the term Term2 in the standard order.

Some further predicates involving comparison of terms are:

?=(?X,?Y)
X and Y are either syntactically identical or syntactically non-unifiable.
compare(?Op,?Term1,?Term2)
The result of comparing terms Term1 and Term2 is Op, where the possible values for Op are:
=
if Term1 is identical to Term2,
<
if Term1 is before Term2 in the standard order,
>
if Term1 is after Term2 in the standard order.
Thus compare(=,Term1,Term2) is equivalent to Term1 == Term2.
sort(+List1,?List2)
The elements of the list List1 are sorted into the standard order (see section Comparison of Terms) and any identical elements are merged, yielding the list List2. (The time and space complexity of this operation is at worst O(N lg N) where N is the length of List1.)
keysort(+List1,?List2)
The list List1 must consist of items of the form Key-Value. These items are sorted into order according to the value of Key, yielding the list List2. No merging takes place. This predicate is stable, i.e. if K-A occurs before K-B in the input, then K-A will occur before K-B in the output. (The time and space complexity of this operation is at worst O(N lg N) where N is the length of List1.)

Control

+P , +Q [ISO]
P and Q.
+P ; +Q [ISO]
P or Q.
! [ISO]
See section The Cut Symbol.
\+ +P [ISO]
Fails if the goal P has a solution, and succeeds otherwise. This is not real negation ("P is false"), but a kind of pseudo-negation meaning "P is not provable". It is defined as if by
\+(P) :- P, !, fail.
\+(_).
No cuts are allowed in P. Remember that with prefix operators such as this one it is necessary to be careful about spaces if the argument starts with a (. For example:
| ?- \+ (P,Q).
is this operator applied to the conjunction of P and Q, but
| ?- \+(P,Q).
would require a predicate \+ /2 for its solution. The prefix operator can however be written as a functor of one argument; thus
| ?- \+((P,Q)).
is also correct.
+P -> +Q ; +R [ISO]
Analogous to
if P then Q else R
and defined as if by
(P -> Q; R) :- P, !, Q.
(P -> Q; R) :- R.
except the scope of any cut in Q or R extends beyond the if-then-else construct. No cuts are allowed in P. Note that this form of if-then-else only explores the first solution to the goal P. Note also that the ; is not read as a disjunction operator in this case; instead, it is part of the if-then-else construction. The precedence of -> is less than that of ; (see section Operators), so the expression is read as
;(->(P,Q),R)
+P -> +Q [ISO]
When occurring as a goal, this construction is read as equivalent to
(P -> Q; fail)
if(+P,+Q,+R)
Analogous to
if P then Q else R
but differs from P -> Q ; R in that if(P, Q, R) explores all solutions to the goal P. There is a small time penalty for this--if P is known to have only one solution of interest, the form P -> Q ; R should be preferred. No cuts are allowed in P.
otherwise
true [ISO]
These always succeed. Use of otherwise/0 is discouraged, because it is not as portable as true/0, and because the former may suggest a completely different semantics than the latter.
false
fail [ISO]
These always fail. Use of false/0 is discouraged, because it is not as portable as fail/0, and because the latter has a more procedural flavor to it.
repeat [ISO]
Generates an infinite sequence of backtracking choices. In sensible code, repeat/0 is hardly ever used except in repeat loops. A repeat loop has the structure
Head :-
        ...
        save(OldState),
        repeat,
          generate(Datum),
          action(Datum),
          test(Datum),
        !,
        restore(OldState),
        ...
The purpose is to repeatedly perform some action on elements which are somehow generated, e.g. by reading them from a stream, until some test becomes true. Usually, generate, action, and test are all determinate. Repeat loops cannot contribute to the logic of the program. They are only meaningful if the action involves side-effects. The only reason for using repeat loops instead of a more natural tail-recursive formulation is efficiency: when the test fails back, the Prolog engine immediately reclaims any working storage consumed since the call to repeat/0.
call(:Term) [ISO]
incore(:Term)
:Term
If Term is instantiated to a term which would be acceptable as the body of a clause, then the goal call(Term) is executed exactly as if that term appeared textually in its place, except that any cut (!) occurring in Term only cuts alternatives in the execution of Term. Use of incore/1 is not recommended. If Term is not instantiated as described above, an error message is printed and the call fails.
call_cleanup(:Goal,:Cleanup)
This construction can be used to ensure that Cleanup is executed as soon as Goal has completed execution, no matter how it finishes. In more detail: When call_cleanup/2 with a continuation C is called or backtracked into, first Goal is called or backtracked into. Then there are four possibilities:
  1. Goal succeeds deterministically, possibly leaving some blocked subgoals. Cleanup is executed with continuation C.
  2. Goal succeeds with some alternatives outstanding. Execution proceeds to C. If a cut that removes the outstanding alternatives is encountered, Cleanup is executed with continuation to proceed after the cut. Also, if an exception E that will be caught by an ancestor of the call_cleanup/2 Goal is raised, Cleanup is executed with continuation raise_exception(E).
  3. Goal fails. Cleanup is executed with continuation fail.
  4. Goal raises an exception E. Cleanup is executed with continuation raise_exception(E).
In a typical use of call_cleanup/2, Cleanup succeeds deterministically after performing some side-effect; otherwise, unexpected behavior may result. Note that the Prolog top level operates as a read-execute-fail loop, which backtracks into or cuts the query when the user types ; or RET respectively. Also, the predicates halt/0, abort/0, and reinitialise/0 are implemented in terms of exceptions. All of these circumstances can trigger the execution of Cleanup.

Error and Exception Handling

The two built-in predicates on_exception/3 and raise_exception/1 are used to alter the control flow to meet exception and error conditions. The equivalent of a raise_exception/1 is also executed by the built-in predicates when errors occur.

on_exception(?Pattern,:ProtectedGoal,:Handler) [ISO]
raise_exception(+Exception) [ISO]
on_exception/3 calls ProtectedGoal. If this succeeds or fails, so does the call to on_exception/3. If however, during the execution of ProtectedGoal, there is a call to raise_exception(Exception), then Exception is copied and the stack is unwound back to the call to on_exception/3, whereupon the copy of Exception is unified with Pattern. If this unification succeeds, then on_exception/3 calls the goal Handler in order to determine the success or failure of on_exception/3. Otherwise, the stack keeps unwinding, looking for an earlier invocation of on_exception/3. Exception may be any term. Certain built-in and library predicates rely on the exception mechanism, so it is usually a bad idea to let Pattern be a variable, matching any exception. If it must be a variable, the Handler should examime the exception and pass it on if it is not relevant to the current invocation. Instead of the above two predicates, the ISO Prolog standard prescribes the following two. They are functionality equivalent to the above two predicates, but beware of the different argument order:
catch(Goal, Catcher, Recovery) :-
        on_exception(Catcher, Goal, Recovery).

throw(Ball) :-
        raise_exception(Ball).

In a Development System, any previously uncaught exception is caught and an appropriate error message is printed before returning to the top level. In recursive calls to Prolog from C, uncaught exceptions are returned back to C instead. The printing of these and most other messages in a Development System is handled by the predicate print_message/2. The behavior of this predicate can be overridden by defining user:portray_message/2, so as to suppress or alter the format of certain messages. These predicates work as follows:

print_message(+Severity, +Message)
Hookable. Most messages from the system are printed by calling this predicate. Before anything is printed, however, print_message/2 calls user:portray_message/2 with the same arguments, so as to give the user a means of intercepting the message before it is actually printed. If user:portray_message/2 succeeds, nothing is printed, otherwise Message is formatted and printed using the default method. Message is a term that encodes the message to be printed. The format of message terms is subject to change, but can be inspected in the file `Bips/msgs.pl' of the SICStus Prolog distribution. Severity is a term denoting the severity of the message, and is one of:
force(Severity)
Message should be printed without calling the user:portray_message/2 hook. This is useful if user:portray_message/2 has intercepted the message, and now wants to print a reformatted version of it using print_message/2.
error
Message is an uncaught exception. The execution will normally be aborted and return to the top level. Syntax errors and exceptions that occur while loading files do not necessarily abort the execution, however.
warning
Message is a warning (e.g. singleton variables).
informational
Message provides information e.g. about files being loaded.
help
Message is normally a response to a query.
portray_message(+Severity, +Message)
user:portray_message(+Severity, +Message)
A hook predicate. Called by print_message/2 before printing the message. If this succeeds, the default message for printing Message is overridden, and nothing more is printed.

The built-in predicates may raise exceptions as follows on errors. Usually the goal and the argument number causing the error are contained in the exception.

instantiation_error(Goal,ArgNo)
Goal was called with insufficiently instantiated variables.
type_error(Goal,ArgNo,TypeName,Culprit)
Goal was called with the wrong type of argument(s). TypeName is the expected type and Culprit what was actually found.
domain_error(Goal,ArgNo,Domain,Culprit)
Goal was called with argument(s) of the right type but with illegal value(s). Domain is the expected domain and Culprit what was actually found.
existence_error(Goal,ArgNo,ObjectType,Culprit,Reserved)
Something does not exist as indicated by the arguments. If the unknown-flag (see prolog_flag/3) is set to error, this error is raised with ArgNo set to 0 when an undefined predicate is called.
permission_error(Goal,Operation,ObjectType,Culprit,Reserved)
The Operation is not permitted on Culprit of the ObjectType.
context_error(Goal,ContextType,CommandType)
The CommandType is not permitted in ContextType.
syntax_error(Goal,Position,Message,Tokens,AfterError)
A syntax error was found when reading a term with read/(1-2). This error is raised only if the syntax_errors flag (see prolog_flag/3) is set to error.
representation_error(Goal,ArgNo,ErrorType)
A representation error occurs when the program tries to compute some well-defined value which cannot be represented, such as a compound term with arity > 255.
consistency_error(Goal,Culprit1,Culprit2,Message)
A consistency error occurs when two otherwise valid values or operations have been specified which are inconsistent with each other.
system_error(Message)
An error occurred while dealing with the operating system.

It is possible to handle a particular kind of existence errors locally: calls to undefined predicates. This can be done by defining clauses for:

unknown_predicate_handler(+Goal,+Module,-NewGoal)
user:unknown_predicate_handler(+Goal,+Module,-NewGoal)
A hook predicate. This predicate is called as a result of a call to an undefined predicate. Goal is bound to the goal of the undefined predicate and Module to the module where the call was made. If this predicate succeeds, Module:NewGoal is called; otherwise, the action taken is governed by the unknown Prolog flag.

The following example shows an auto-loader for library packages:

user:unknown_predicate_handler(Goal, Module, Goal) :-
        functor(Goal, Name, Arity),
        require(Module:(Name/Arity)).

Information about the State of the Program

listing
Lists onto the current output stream all the clauses in the current interpreted program (in the type-in module; see section Module Prefixing). Clauses listed onto a file can be consulted back.
listing(:Spec)
Lists all interpreted predicates covered by Spec, which has the same for as for spy/1 (see section Spy-points). For example:
| ?- listing([concatenate/3, reverse, m:go/(2-3), bar:_]).
current_atom(?Atom)
Atom is an atom known to SICStus Prolog. Can be used to enumerate (through backtracking) all currently known atoms, and return each one as Atom.
current_predicate(?Name,:Head) [ISO]
current_predicate(?Name,-Head) [ISO]
Name is the name of a user defined or library predicate, and Head is the most general goal for that predicate, possibly prefixed by a module name. This predicate can be used to enumerate all user defined or library predicates through backtracking.
predicate_property(:Head,?Property)
predicate_property(-Head,?Property)
Head is the most general goal for an existing predicate, possibly prefixed by a module name, and Property is a property of that predicate, where the possible properties are This predicate can be used to enumerate all existing predicates and their properties through backtracking.
current_module(?Module)
Module is a module in the system. It can be used to backtrack through all modules present in the system.
current_module(?Module, ?File)
Module is the module defined in File.
module(+Module)
The type-in module is set to Module.
prolog_flag(+FlagName,?OldValue,?NewValue)
OldValue is the value of the Prolog flag FlagName, and the new value of FlagName is set to NewValue. The possible Prolog flag names and values are:
agc_margin
An integer Margin. The atoms will be garbage collected when Margin new atoms have been created since the last atom garbage collection. Initially 10000.
argv
A read-only flag. The value is a list of atoms of the program arguments supplied when the current SICStus Prolog process was started. For example, if SICStus Prolog were invoked with:
% sicstus -a hello world 2001
then the value will be [hello,world,'2001'].
compiling
Governs the mode in which compile/1 and fcompile/1 operate (see section Loading Programs).
compactcode
Compilation produces byte-coded abstract instructions (the default).
fastcode
Compilation produces native machine instructions. Currently only available for 680x0, Sparc, and MIPS platforms.
profiledcode
Compilation produces byte-coded abstract instructions instrumented to produce execution profiling data.
debugcode
Compiling is replaced by consulting.
debugging
Corresponds to the predicates debug/0, nodebug/0, trace/0, notrace/0, zip/0, nozip/0 (see section Debugging).
trace
Turns on trace mode.
debug
Turns on the debugger.
off
Turns off trace mode and the debugger (the default).
(This flag is not available in Runtime Systems.)
character_escapes
on or off. If this flag is on, a backslash occurring inside integers in `0'' notation or inside quoted atoms or strings has special meaning, and indicates the start of an escape sequence (see section Escape Sequences). This flag is relevant when reading as well as when writing terms, and is initially on.
fileerrors
on or off. Turns raising of exception on file errors on or off. Equivalent to fileerrors/0 and nofileerrors/0, respectively (see section Stream I/O). Initially on.
gc
on or off. Turns garbage collection of the global stack on or off. Initially on.
gc_margin
Margin: Number of kilobytes. If less than Margin kilobytes are reclaimed in a garbage collection of the global stack then the size of the global stack should be increased. Also, no garbage collection is attempted unless the global stack is at least Margin kilobytes. Initially 500.
gc_trace
Governs global stack garbage collection trace messages.
verbose
Turn on verbose tracing of garbage collection.
terse
Turn on terse tracing of garbage collection.
off
Turn off tracing of garbage collection (the default).
redefine_warnings
on or off. Enable or disable warning messages when a predicate is being
  • redefined from a different file than its previous definition.
  • imported to the user module and it was previously locally defined.
  • redefined locally and it was previously imported.
  • imported to the user module from another module than it was previously imported from.
Initially on. (This warning is always disabled in Runtime Systems.)
single_var_warnings
on or off. Enable or disable warning messages when a clause containing variables not beginning with _ occurring once only is compiled or consulted. Initially on.
unknown
Corresponds to the predicate unknown/2 (see section Debugging).
trace
Causes calls to undefined predicates to be reported and the debugger to be entered at the earliest opportunity. (This setting is not possible in Runtime Systems.)
fail
Causes calls to such predicates to fail.
error
Causes calls to such predicates to raise an exception (the default). See section Error and Exception Handling.
syntax_errors
Controls what action is taken upon syntax errors in read/(1-2).
dec10
The syntax error is reported and the read is repeated.
error
An exception is raised. See section Error and Exception Handling. (the default).
fail
The syntax error is reported and the read fails.
quiet
The read quietly fails.
system_type
A read-only flag. The value is development in Development Systems and runtime in Runtime Systems.
typein_module
Permitted values are atoms. Controls the current type-in module (see section Module Prefixing). Corresponds to the predicate module/1.
user_input
Permitted values are any stream opened for reading. Controls which stream is referenced by user_input and SP_stdin. It is initially set to a stream connected to UNIX stdin.
user_output
Permitted values are any stream opened for writing. Controls which stream is referenced by user_output and SP_stdout. It is initially set to a stream connected to UNIX stdout.
user_error
Permitted values are any stream opened for writing. Controls which stream is referenced by user_error and SP_stderr. It is initially set to a stream connected to UNIX stderr.
version
A read-only flag. The value is an atom containing the banner text displayed on startup and reinitialization, such as 'SICStus 3 #0: Wed Mar 15 12:29:29 MET 1995'.
toplevel_print_options
The value is a list of options for write_term/3 (see section Input and Output of Terms), to be used when the top level displays variable bindings, answer constraints, and uncaught exceptions. Not available in Runtime Systems. The initial value is [quoted(true),numbervars(true),portrayed(true),max_depth(10)].
debugger_print_options
The value is a list of options for write_term/3 (see section Input and Output of Terms), to be used in the debugger's messages. Not available in Runtime Systems. The initial value is [quoted(true),numbervars(true),portrayed(true),max_depth(10)].
source_info
on or off. If on while code is being loaded, information about line numbers and filenames are stored with the loaded code. If on while debugging, this information is used to display the source code location while prompting for a debugger command. Initially off. Currently, this facility is only useful with the GNU Emacs interface.
prolog_flag(?FlagName,?Value)
Value is the current value of the Prolog flag FlagName. Can be used to enumerate all Prolog flags and their values by backtracking.
prolog_load_context(?Key,?Value)
This predicate gives access to context variables during compilation and loading of Prolog files. It unifies Value with the value of the variable identified by Key. Possible keys are:
file
The absolute path name of the file being compiled. During loading of a ql-file, the corresponding source file name is returned.
directory
The absolute path name of the directory of the file being compiled/loaded.
module
The source module (see section Module Name Expansion). This is useful for example if you are defining clauses for user:term_expansion/(2,4) and need to access the source module at compile time.
stream
The stream being compiled or loaded from.
term_position
A term representing the position of the last clause read (see section Stream I/O).
statistics
Displays on the standard error stream statistics relating to memory usage, run time, garbage collection of the global stack and stack shifts.
statistics(?Key,?Value)
This allows a program to gather various execution statistics. For each of the possible keys Key, Value is unified with a list of values, as follows:
global_stack
[size used,free]
This refers to the global stack, where compound terms are stored. The values are gathered before the list holding the answers is allocated.
local_stack
[size used,free]
This refers to the local stack, where recursive predicate environments are stored.
trail
[size used,free]
This refers to the trail stack, where conditional variable bindings are recorded.
choice
[size used,free]
This refers to the choicepoint stack, where partial states are stored for backtracking purposes.
core
memory
[size used,0]
These refer to the amount of memory actually allocated by the process.
heap
program
[size used,0]
These refer to the amount of memory allocated for compiled and interpreted clauses, symbol tables, and the like.
runtime
[since start of Prolog,since previous statistics] These refer to CPU time used while executing, excluding time spent garbage collecting, stack shifting, or in system calls. In Muse, these numbers refer to the worker that happens to be executing the call to statistics/2, and so normally are not meaningful.
walltime
[since start of Prolog,since previous statistics] These refer to absolute time elapsed.
garbage_collection
[no. of GCs,bytes freed,time spent]
stack_shifts
[no. of local shifts,no. of trail shifts,time spent]
atoms
[no. of atoms,bytes used,bytes free]
atom_garbage_collection
[no. of AGCs,bytes freed,time spent]
Times are in milliseconds, sizes of areas in bytes.

Meta-Logic

The predicates in this section are meta-logical and perform operations that require reasoning about the current instantiation of terms or decomposing terms into their constituents. Such operations cannot be expressed using predicate definitions with a finite number of clauses.

var(?X) [ISO]
Tests whether X is currently uninstantiated (var is short for variable). An uninstantiated variable is one which has not been bound to anything, except possibly another uninstantiated variable. Note that a structure with some components which are uninstantiated is not itself considered to be uninstantiated. Thus the directive
| ?- var(foo(X, Y)).
always fails, despite the fact that X and Y are uninstantiated.
nonvar(?X) [ISO]
Tests whether X is currently instantiated. This is the opposite of var/1.
ground(?X)
Tests whether X is completely instantiated, i.e. free of unbound variables. In this context, mutable terms are treated as nonground, so as to make ground/1 a monotone predicate.
atom(?X) [ISO]
Checks that X is currently instantiated to an atom (i.e. a non-variable term of arity 0, other than a number).
float(?X) [ISO]
Checks that X is currently instantiated to a float.
integer(?X) [ISO]
Checks that X is currently instantiated to an integer.
number(?X) [ISO]
Checks that X is currently instantiated to a number.
atomic(?X) [ISO]
Checks that X is currently instantiated to an atom or number.
simple(?X)
Checks that X is currently uninstantiated or instantiated to an atom or number.
compound(?X) [ISO]
Checks that X is currently instantiated to a term of arity > 0 i.e. a list or a structure.
callable(?X)
Checks that X is currently instantiated to a term valid as a goal i.e. a compound term or an atom.
is_mutable(?X)
Checks that X is currently instantiated to a mutable term (see section Modification of Terms).
functor(+Term,?Name,?Arity) [ISO]
functor(?Term,+Name,+Arity) [ISO]
The principal functor of term Term has name Name and arity Arity, where Name is either an atom or, provided Arity is 0, a number. Initially, either Term must be instantiated, or Name and Arity must be instantiated to, respectively, either an atom and an integer in [0,255] or an atomic term and 0. In the case where Term is initially uninstantiated, the result of the call is to instantiate Term to the most general term having the principal functor indicated.
arg(+ArgNo,+Term,?Arg) [ISO]
Arg is the argument ArgNo of the compound term Term. The arguments are numbered from 1 upwards, ArgNo must be instantiated to a positive integer and Term to a compound term.
+Term =.. ?List [ISO]
?Term =.. +List [ISO]
List is a list whose head is the atom corresponding to the principal functor of Term, and whose tail is a list of the arguments of Term. e.g.
| ?- product(0, n, n-1) =.. L.

L = [product,0,n,n-1]

| ?- n-1 =.. L.

L = [-,n,1]

| ?- product =.. L.

L = [product]
If Term is uninstantiated, then List must be instantiated either to a list of determinate length whose head is an atom, or to a list of length 1 whose head is a number. Note that this predicate is not strictly necessary, since its functionality can be provided by arg/3 and functor/3, and using the latter two is usually more efficient.
name(+Const,?CharList)
name(?Const,+CharList)
If Const is an atom or number, CharList is a list of the character codes of the characters comprising the name of Const. e.g.
| ?- name(product, L).

L = [112,114,111,100,117,99,116]

| ?- name(product, "product").

| ?- name(1976, L).

L = [49,57,55,54]

| ?- name('1976', L).

L = [49,57,55,54]

| ?- name((:-), L).

L = [58,45]

If Const is uninstantiated, CharList must be instantiated to a list of character codes. If CharList can be interpreted as a number, Const is unified with that number, otherwise with the atom whose name is CharList. E.g.
| ?- name(X, [58,45]).

X = :-

| ?- name(X, ":-").

X = :-

| ?- name(X, [49,50,51]).

X = 123
Note that there atoms are for which name(Const,CharList) is true, but which will not be constructed if name/2 is called with Const uninstantiated. One such atom is the atom '1976'. It is recommended that new programs use atom_chars/2 or number_chars/2, as these predicates do not have this inconsistency.
atom_chars(+Const,?CharList) [ISO]
atom_chars(?Const,+CharList) [ISO]
The same as name(Const,CharList), but Const is constrained to be an atom. This predicate is called atom_codes/2 in the ISO Prolog standard.
number_chars(+Const,?CharList) [ISO]
number_chars(?Const,+CharList) [ISO]
The same as name(Const,CharList), but Const is constrained to be a number. This predicate is called number_codes/2 in the ISO Prolog standard.
copy_term(?Term,?CopyOfTerm) [ISO]
CopyOfTerm is a renaming of Term, such that brand new variables have been substituted for all variables in Term. If any of the variables of Term have goals blocked on them, the copied variables will have copies of the goals blocked on them as well. Similarly, independent copies are substituted for any mutable terms in term. It behaves as if defined by:
copy_term(X, Y) :-
        assert('copy of'(X)),
        retract('copy of'(Y)).
The implementation of copy_term/2 conserves space by not copying ground subterms.

Modification of Terms

One of the tenets of logic programming is that terms are immutable objects of the Herbrand universe, and the only sense in which they can be modified is by means of instantiating non-ground parts. There are, however, algorithms where destructive assignment is essential for performance. Although alien to the ideals of logic programming, this feature can be defended on practical grounds.

SICStus Prolog provides an abstract datatype and three operations for efficient backtrackable destructive assignment. In other words, any destructive assignments are transparently undone on backtracking. Modifications that are intended to survive backtracking must be done by asserting or retracting dynamic program clauses instead. Unlike previous releases of SICStus Prolog, destructive assignment of arbitrary terms is not allowed.

A mutable term is represented as a compound terms with a reserved functor: '$mutable'(Value,Timestamp) where Value is the current value and Timestamp is reserved for bookkeeping purposes.

Any copy of a mutable term created by copy_term/2, assert, retract, an internal database predicate, or an all solutions predicate, is an independent copy of the original mutable term. Any destructive assignment done to one of the copies will not affect the other copy.

The following operations are provided:

create_mutable(+Datum,-Mutable)
Mutable is a new mutable term with initial value Datum. Datum must not be an unbound variable.
get_mutable(?Datum,+Mutable)
Datum is the current value of the mutable term Mutable.
update_mutable(+Datum,+Mutable)
Updates the current value of the mutable term Mutable to become Datum. Datum must not be an unbound variable.
is_mutable(?Mutable)
Checks that Mutable is currently instantiated to a mutable term (see section Modification of Terms).

Modification of the Program

The predicates defined in this section allow modification of dynamic predicates. Dynamic clauses can be added (asserted) or removed from the program (retracted).

For these predicates, the argument Head must be instantiated to an atom or a compound term, with an optional module prefix. The argument Clause must be instantiated either to a term Head :- Body or, if the body part is empty, to Head, with an optional module prefix. An empty body part is represented as true.

Note that a term Head :- Body must be enclosed in parentheses when it occurs as an argument of a compound term, as `:-' is a standard infix operator with precedence greater than 1000 (see section Operators), e.g.:

| ?- assert((Head :- Body)).

Like recorded terms (see section Internal Database), the clauses of dynamic predicates have a unique implementation-defined identifier. Some of the predicates below have an additional argument which is this identifier. This identifier makes it possible to access clauses directly instead of requiring a normal database (hash-table) lookup.

assert(:Clause)
assert(:Clause,-Ref)
The current instance of Clause is interpreted as a clause and is added to the current interpreted program. The predicate concerned must currently be dynamic or undefined and the position of the new clause within it is implementation-defined. Ref is a unique identifier of the asserted clause. Any uninstantiated variables in the Clause will be replaced by new private variables, along with copies of any subgoals blocked on these variables (see section Procedural Semantics).
asserta(:Clause) [ISO]
asserta(:Clause,-Ref)
Like assert/2, except that the new clause becomes the first clause for the predicate concerned.
assertz(:Clause) [ISO]
assertz(:Clause,-Ref)
Like assert/2, except that the new clause becomes the last clause for the predicate concerned.
clause(:Head,?Body) [ISO]
clause(:Head,?Body,?Ref)
clause(?Head,?Body,+Ref)
The clause (Head :- Body) exists in the current interpreted program, and is uniquely identified by Ref. The predicate concerned must currently be dynamic. At the time of call, either Ref must be instantiated to a valid identifier, or Head must be instantiated to an atom or a compound term. Thus clause/3 can have two different modes of use.
retract(:Clause) [ISO]
The first clause in the current interpreted program that matches Clause is erased. The predicate concerned must currently be dynamic. retract/1 may be used in a non-determinate fashion, i.e. it will successively retract clauses matching the argument through backtracking. If reactivated by backtracking, invocations of the predicate whose clauses are being retracted will proceed unaffected by the retracts. This is also true for invocations of clause/(2-3) for the same predicate. The space occupied by a retracted clause will be recovered when instances of the clause are no longer in use.
retractall(:Head)
Erases all clauses whose head matches Head, where Head must be instantiated to an atom or a compound term. The predicate concerned must currently be dynamic. The predicate definition is retained.

Note: all predicates mentioned above first look for a predicate that is visible in the module in which the call textually appears. If no predicate is found, a new dynamic predicate (with no clauses) is created automatically. During OR-parallel execution, however, predicates must not be defined on the fly like this. It is recommended to declare as dynamic predicates for which clauses will be asserted.

abolish(:Spec) [ISO]
abolish(:Name,+Arity)
Erases all clauses of the predicate specified by Spec or Name/Arity. Spec has the same form as for spy/1 (see section Spy-points) and Name may be prefixed by a module name (see section Module Prefixing). The predicate definition and all associated information such as spy-points is also erased. The predicates concerned must all be user defined.
erase(+Ref)
The dynamic clause or recorded term (see section Internal Database) whose implementation-defined identifier is Ref is effectively erased from the internal database or interpreted program.
instance(+Ref,?Term)
A (most general) instance of the dynamic clause or recorded term whose implementation-defined identifier is Ref is unified with Term. Ref must be instantiated to a legal identifier.

Internal Database

The predicates described in this section were introduced in early implementations of Prolog to provide efficient means of performing operations on large quantities of data. The introduction of indexed dynamic predicates have rendered these predicates obsolete, and the sole purpose of providing them is to support existing code. There is no reason whatsoever to use them in new code.

These predicates store arbitrary terms in the database without interfering with the clauses which make up the program. The terms which are stored in this way can subsequently be retrieved via the key on which they were stored. Many terms may be stored on the same key, and they can be individually accessed by pattern matching. Alternatively, access can be achieved via a special identifier which uniquely identifies each recorded term and which is returned when the term is stored.

recorded(?Key,?Term,?Ref)
The internal database is searched for terms recorded under the key Key. These terms are successively unified with Term in the order they occur in the database. At the same time, Ref is unified with the implementation-defined identifier uniquely identifying the recorded item. If the key is instantiated to a compound term, only its principal functor is significant. If the key is uninstantiated, all terms in the database are successively unified with Term in the order they occur.
recorda(+Key,?Term,-Ref)
The term Term is recorded in the internal database as the first item for the key Key, where Ref is its implementation-defined identifier. The key must be given, and only its principal functor is significant. Any uninstantiated variables in the Term will be replaced by new private variables, along with copies of any subgoals blocked on these variables (see section Procedural Semantics).
recordz(+Key,?Term,-Ref)
Like recorda/3, except that the new term becomes the last item for the key Key.
current_key(?KeyName,?KeyTerm)
KeyTerm is the most general form of the key for a currently recorded term, and KeyName is the name of that key. This predicate can be used to enumerate in undefined order all keys for currently recorded terms through backtracking.

Blackboard Primitives

The predicates described in this section store arbitrary terms in a per-module repository known as the "blackboard". The main purpose of the blackboard is to provide a means for communication between branches executing in parallel, but the blackboard works equally well during sequential execution. The blackboard implements a mapping from keys to values. Keys are restricted to being atoms or integers in the range [-33554432, 33554431], whereas values are arbitrary terms. In contrast to the predicates described in the previous sections, a given key can map to at most a single term.

Each Prolog module maintains its own blackboard, so as to avoid name clashes if different modules happen to use the same keys. The "key" arguments of these predicates are subject to module name expansion, so the module name does not have to be explicitly given unless multiple Prolog modules are supposed to share a single blackboard.

The predicates below implement atomic blackboard actions. In Muse, these predicates are cavalier (see section Programming Considerations).

bb_put(:Key, +Term)
A copy of Term is stored under Key. Any previous term stored under the same Key is simply deleted.
bb_get(:Key, ?Term)
If a term is currently stored under Key, a copy of it is unified with Term. Otherwise, bb_get/2 silently fails.
bb_delete(:Key, ?Term)
If a term is currently stored under Key, the term is deleted, and a copy of it is unified with Term. Otherwise, bb_delete/2 silently fails.
bb_update(:Key, ?OldTerm, ?NewTerm)
If a term is currently stored under Key and unifies with OldTerm, the term is replaced by a copy of NewTerm. Otherwise, bb_update/3 silently fails. This predicate provides an atomic swap operation.

The following example illustrates how these primitives may be used to implement a "maxof" predicate that finds the maximum value computed by some non-deterministic goal, which may execute in parallel. We use a single key max. Note the technique of using bb_update/3 in a repeat-fail loop, since other execution branches may be competing for updating the value, and we only want to store a new value if it is greater than the old value.

We assume that Goal does not produce any "false" solutions that would be eliminated by cuts in a sequential execution. Thus, Goal may need to include redundant checks to ensure that its solutions are valid, as discussed above.

maxof(Value, Goal, _) :-
        bb_put(max, -1),                % initialize max-so-far
        call(Goal),
        update_max(Value),
        fail.
maxof(_, _, Max) :-
        bb_delete(max, Max),
        Max > 1.

update_max(New):-
        repeat,
          bb_get(max, Old),
          compare(C, Old, New),
          update_max(C, Old, New), !.

update_max(<, Old, New) :- bb_update(max, Old, New).
update_max(=, _, _).
update_max(>, _, _).

All Solutions

When there are many solutions to a problem, and when all those solutions are required to be collected together, this can be achieved by repeatedly backtracking and gradually building up a list of the solutions. The following built-in predicates are provided to automate this process.

Note that the Goal argument to the predicates listed below is called as if by call/1 at runtime. Thus if Goal is complex and if performance is an issue, define an auxiliary predicate which can then be compiled, and let Goal call it.

setof(?Template,:Goal,?Set) [ISO]
Read this as "Set is the set of all instances of Template such that Goal is satisfied, where that set is non-empty". The term Goal specifies a goal or goals as in call(Goal) (see section Control). Set is a set of terms represented as a list of those terms, without duplicates, in the standard order for terms (see section Comparison of Terms). If there are no instances of Template such that Goal is satisfied then the predicate fails. The variables appearing in the term Template should not appear anywhere else in the clause except within the term Goal. Obviously, the set to be enumerated should be finite, and should be enumerable by Prolog in finite time. It is possible for the provable instances to contain variables, but in this case the list Set will only provide an imperfect representation of what is in reality an infinite set. If there are uninstantiated variables in Goal which do not also appear in Template, then a call to this built-in predicate may backtrack, generating alternative values for Set corresponding to different instantiations of the free variables of Goal. (It is to cater for such usage that the set Set is constrained to be non-empty.) Two instantiations are different iff no renaming of variables can make them literally identical. For example, given the clauses:
likes(bill, cider).
likes(dick, beer).
likes(harry, beer).
likes(jan, cider).
likes(tom, beer).
likes(tom, cider).
the query
| ?- setof(X, likes(X,Y), S).
might produce two alternative solutions via backtracking:
S = [dick,harry,tom],
Y = beer ? ;

S = [bill,jan,tom],
Y = cider ? ;
The query:
| ?- setof((Y,S), setof(X, likes(X,Y), S), SS).
would then produce:
SS = [(beer,[dick,harry,tom]),(cider,[bill,jan,tom])]
Variables occurring in Goal will not be treated as free if they are explicitly bound within Goal by an existential quantifier. An existential quantification is written:
Y^Q
meaning "there exists a Y such that Q is true", where Y is some Prolog variable. For example:
| ?- setof(X, Y^(likes(X,Y)), S).
would produce the single result:
S = [bill,dick,harry,jan,tom]
in contrast to the earlier example.
bagof(?Template,:Goal,?Bag) [ISO]
This is exactly the same as setof/3 except that the list (or alternative lists) returned will not be ordered, and may contain duplicates. The effect of this relaxation is to save a call to sort/2, which is invoked by setof/3 to return an ordered list.
?X^:P
The all solution predicates recognize this as meaning "there exists an X such that P is true", and treats it as equivalent to P (see section Control). The use of this explicit existential quantifier outside the setof/3 and bagof/3 constructs is superfluous and discouraged.
findall(?Template,:Goal,?Bag) [ISO]
Bag is a list of instances of Template in all proofs of Goal found by Prolog. The order of the list corresponds to the order in which the proofs are found. The list may be empty and all variables are taken as being existentially quantified. This means that each invocation of findall/3 succeeds exactly once, and that no variables in Goal get bound. Avoiding the management of universally quantified variables can save considerable time and space.
findall(?Template,:Goal,?Bag,?Remainder)
Same as findall/3, except Bag is the list of solution instances appended with Remainder, which is typically unbound.

Coroutining

The coroutining facility can be accessed by a number of built-in predicates. This makes it possible to use coroutines in a dynamic way, without having to rely on block declarations:

when(+Condition,:Goal)
Blocks Goal until the Condition is true, where Condition is a Prolog goal with the restricted syntax:
nonvar(X)
ground(X)
?=(X,Y)
Condition,Condition
Condition;Condition
For example:
| ?- when(((nonvar(X);?=(X,Y)),ground(T)), process(X,Y,T)).
freeze(?X,:Goal)
Blocks Goal until nonvar(X) (see section Meta-Logic) holds. This is defined as if by:
freeze(X, Goal) :- when(nonvar(X), Goal).
or
:- block freeze(-, ?).
freeze(_, Goal) :- Goal.
frozen(-Var,?Goal)
If some goal is blocked on the variable Var, or Var has attributes that can be interpreted as a goal (see section Attributed Variables), then that goal is unified with Goal. If no goals are blocked, Goal is unified with the atom true. If more than one goal is blocked, a conjunction is unified with Goal.
dif(?X,?Y)
Constrains X and Y to represent different terms i.e. to be non-unifiable. Calls to dif/2 either succeed, fail, or are blocked depending on whether X and Y are sufficiently instantiated. It is defined as if by:
dif(X, Y) :- when(?=(X,Y), X\==Y).
call_residue(:Goal,?Residue)
The Goal is executed as if by call/1. If after the execution there are still some subgoals of Goal that are blocked on some variables, then Residue is unified with a list of VariableSet-Goal pairs, and those subgoals are no longer blocked on any variables. Otherwise, Residue is unified with the empty list []. VariableSet is a set of variables such that when any of the variables is bound, Goal gets unblocked. Usually, a goal is blocked on a single variable, in which case VariableSet is a singleton. Goal is an ordinary goal, sometimes module prefixed. For example:
| ?- call_residue((dif(X,f(Y)), X=f(Z)), Res).

X = f(Z),
Res = [[Y,Z]-(prolog:dif(f(Z),f(Y)))]

Debugging

Debugging predicates are not available in Runtime Systems.

unknown(?OldState,?NewState)
OldState is the current state of the "Action on unknown predicates" flag, and sets the flag to NewState. This flag determines whether or not the system is to catch calls to undefined predicates (see section Undefined Predicates), when user:unknown_predicate_handler/3 cannot handle the goal. The possible states of the flag are:
trace
Causes calls to undefined predicates to be reported and the debugger to be entered at the earliest opportunity.
fail
Causes calls to such predicates to fail.
error
Causes calls to such predicates to raise an exception (the default). See section Error and Exception Handling.
debug
The debugger is switched on in leap mode. See section Basic Debugging Predicates.
trace
The debugger is switched on in creep mode. See section Basic Debugging Predicates.
zip
The debugger is switched on in zip mode. See section Basic Debugging Predicates.
nodebug
notrace
nozip
The debugger is switched off. See section Basic Debugging Predicates.
leash(+Mode)
Leashing Mode is set to Mode. See section Basic Debugging Predicates.
spy :Spec
Spy-points are placed on all the predicates given by Spec. See section Spy-points.
nospy :Spec
Spy-points are removed from all the predicates given by Spec. See section Spy-points.
nospyall
Removes all the spy-points that have been set.
debugging
Displays information about the debugger. See section Basic Debugging Predicates.

Execution Profiling

Execution profiling is a common aid for improving software performance. The SICStus Prolog compiler has the capability of instrumenting compiled code with counters which are initially zero and incremented whenever the flow of control passes a given point in the compiled code. This way the number of calls, backtracks, choicepoints created, etc., can be counted for the instrumented predicates, and an estimate of the time spent in individual clauses and disjuncts can be calculated.

Gauge is a graphical user interface for inspecting execution profiles. It is available as a library module (see section The Gauge Profiling Tool).

The original version of the profiling package was written by M.M. Gorlick and C.F. Kesselman at the Aerospace Corporation [Gorlick & Kesselman 87].

Profiling is not available in Muse.

Only compiled code can be instrumented. To get an execution profile of a program, the compiler must first be told to produce instrumented code. This is done by issuing the directive:

| ?- prolog_flag(compiling,_,profiledcode).

after which the program to be analyzed can be compiled as usual. Any new compiled code will be instrumented while the compilation mode flag has the value profiledcode.

The profiling data is generated by simply running the program. The predicate profile_data/4 (see below) makes available a selection of the data as a Prolog term. The predicate profile_reset/1 zeroes the profiling counters for a selection of the currently instrumented predicates.

profile_data(:Spec,?Selection,?Resolution,-Data)
Data is profiling data collected from the predicates covered by Spec, which has the same form as for spy/1 (see section Spy-points). The Selection argument determines the kind of profiling data to be collected. If uninstantiated, the predicate will backtrack over its possible values, which are:
calls
All instances of entering a clause by a procedure call are counted. This is equivalent to counting all procedure calls that have not been determined to fail by indexing on the first argument.
backtracks
All instances of entering a clause by backtracking are counted.
choice_points
All instances of creating a choicepoint are counted. This occurs, roughly, when the implementation determines that there are more than one possibly matching clauses for a procedure call, and when a disjunction is entered.
shallow_fails
Failures in the "if" part of if-then-else statements, and in the "guard" part of guarded clauses, are counted as shallow failures. See section If-Then-Else Compilation.
deep_fails
Any failures that do not classify as shallow as above are counted as deep failures. The reason for distinguishing shallow and deep failures is that the former are considerably cheaper to execute than the latter.
execution_time
The execution time for the selected predicates, clauses, or disjuncts is estimated in artificial units.
The Resolution argument determines the level of resolution of the profiling data to be collected. If uninstantiated, the predicate will backtrack over its possible values, which are:
predicate
Data is a list of Module:PredName-Count, where Count is a sum of the corresponding counts per clause.
clause
Data is a list of Module:ClauseName-Count, where Count includes counts for any disjunctions occurring inside that clause. Note, however, that the selections calls and backtracks do not include counts for disjunctions.
all
Data is a list of Module:InternalName-Count. This is the finest resolution level, counting individual clauses and disjuncts.
Above, PredName is a predicate spec, ClauseName is a compound term PredName/ClauseNumber, and InternalName is either
ClauseName---corresponding to a clause, or
(ClauseName-DisjNo)/Arity/AltNo---corresponding to a disjunct.
profile_reset(:Spec)
Zeroes all counters for predicates covered by Spec, which has the same form as for spy/1 (see section Spy-points).

Muse

The following predicates are only defined in the Muse Development System.

muse_sync
A built-in predicate that can be used to synchronize for being leftmost in the parallel search tree. Its main use is in combination with foreign language interface calls.
muse_flags
This built-in predicate lists all current Muse flag settings.
muse_flag(?Flag,-Old)
muse_flag(?Flag,-Old,+New)
These examine and/or adjust parts of the Muse scheduler state. The current value is returned in Old, and a new value may be specified in New. The state cannot be changed when Muse is executing parallel work. It is therefore recommended to perform such changes as the first (or best single) goal in a top level query. If used elsewhere, the execution may be aborted if the system cannot perform the change. Possible flag values are:
num_workers
Returns in Old the current number of workers, which is adjusted to New.
max_workers
The maximum number of Muse workers is returned. This flag is read-only.
worker_id
The identity of the currently executing Muse workers is returned. This flag is read-only.
version
The Muse version is returned. The version can be plain or trace. This flag is read-only.
The following flags also exist, but understanding them requires deep knowledge about the Muse scheduler and execution model, so they are probably not useful for the average user.
vol_susp
Used to turn voluntary suspension on (1) or off (0).
vol_susp_time
Voluntary suspension interval, in milliseconds,
vol_susp_num
Number of workers to voluntarily suspend.
vol_susp_avoid
Controls the eagerness of voluntary suspension after resumption.
eager_cut
Used to turn eager pruning on (1) or off (0).
max_sch_loops
Maximum number of scheduler loops.
max_suspended
Maximum number of megabytes for suspended branches.
muse_trace(:Goal)
muse_trace(:Goal,+FilePrefix)
The trace version generates a trace file for the goal Goal. The file may be prefixed with FilePrefix. The file is created in the current working directory if it can be written there, or otherwise in the directory that is the value of the TMPDIR environment variable. Cannot be executed in parallel when the execution changes the scheduler state.

Miscellaneous

?X = ?Y [ISO]
Defined as if by the clause Z=Z.; i.e. X and Y are unified.
length(?List,?Length)
If List is instantiated to a list of determinate length, then Length will be unified with this length. If List is of indeterminate length and Length is instantiated to an integer, then List will be unified with a list of length Length. The list elements are unique variables. If Length is unbound then Length will be unified with all possible lengths of List.
numbervars(?Term,+N,?M)
Unifies each of the variables in term Term with a special term, so that write(Term) (or writeq(Term)) (see section Input and Output of Terms) prints those variables as (A + (i mod 26))(i/26) where i ranges from N to M-1. N must be instantiated to an integer. If it is 0 you get the variable names A, B, ..., Z, A1, B1, etc. This predicate is used by listing/(0-1) (see section Information about the State of the Program).
halt [ISO]
Causes Prolog to exit back to the shell. (In recursive calls to Prolog from C, this predicate will return back to C instead.)
halt(+Code) [ISO]
Causes the Prolog process to immediately exit back to the shell with the return code Code, even if it occurs in a recursive call from C.
op(+Precedence,+Type,+Name) [ISO]
Declares the atom Name to be an operator of the stated Type and Precedence (see section Operators). Name may also be a list of atoms in which case all of them are declared to be operators. If Precedence is 0 then the operator properties of Name (if any) are cancelled.
current_op(?Precedence,?Type,?Op) [ISO]
The atom Op is currently an operator of type Type and precedence Precedence. Neither Op nor the other arguments need be instantiated at the time of the call; i.e. this predicate can be used to generate as well as to test.
break
Invokes a recursive top-level. See section Nested Executions--Break and Abort. (This predicate is not available in Runtime Systems nor in Muse.)
abort
Aborts the current execution. See section Nested Executions--Break and Abort. (In recursive calls to Prolog from C, this predicate will return back to C instead.) (In Muse, will adjust the system to one worker.)
save_program(+File)
save_program(+File, :Goal)
The system saves the program state into file File. When the program state is restored, Goal is executed. Goal defaults to true. See section Saving and Restoring Program States. (Requires Muse to be adjusted to one worker.)
restore(+File)
The system is returned to the program state previously saved to file File with start-up goal Goal. restore/1 may succeed, fail or raise an exception depending on Goal. See section Saving and Restoring Program States. (Requires Muse to be adjusted to one worker.)
reinitialise
This predicate can be used to force the reinitialization behavior to take place at any time. When SICStus Prolog is reinitialized it: (In recursive calls to Prolog from C, this predicate will return back to C instead.) (In Muse, will adjust the system to one worker.)
garbage_collect
Performs a garbage collection of the global stack immediately.
garbage_collect_atoms
Performs a garbage collection of the atoms immediately.
gc
Enables garbage collection of the global stack (the default).
nogc
Disables garbage collection of the global stack.
prompt(?Old,?New)
The sequence of characters (prompt) which indicates that the system is waiting for user input is represented as an atom, and unified with Old; the atom bound to New specifies the new prompt. In particular, the goal prompt(X, X) unifies the current prompt with X, without changing it. Note that this predicate only affects the prompt given when a user's program is trying to read from the standard input stream (e.g. by calling read/1). Note also that the prompt is reset to the default `|: ' on return to top-level.
version
Displays the introductory messages for all the component parts of the current system. Prolog will display its own introductory message when initially run and on reinitialization by calling version/0. If this message is required at some other time it can be obtained using this predicate which displays a list of introductory messages; initially this list comprises only one message (Prolog's), but you can add more messages using version/1. (This predicate is not available in Runtime Systems.)
version(+Message)
Appends Message to the end of the message list which is output by version/0. Message must be an atom. (This predicate is not available in Runtime Systems.) The idea of this message list is that, as systems are constructed on top of other systems, each can add its own identification to the message list. Thus version/0 should always indicate which modules make up a particular package. It is not possible to remove messages from the list.
initialization
Executes goals defined by initialization/1. Only the first solution is investigated. initialization/0 is called at system (re)initialization. (This predicate is not available in Runtime Systems.)
initialization(:Goal)
Appends Goal to the goal list which is executed by initialization/0. It is not possible to remove goals from the list. (This predicate is not available in Runtime Systems.) initialization/(0-1) provide a mechanism which is similar but more general than version/(0-1). It can, for example, be used by systems constructed on top of SICStus Prolog to load their own initialization files.
help
Hookable, displays basic information, or a user defined help message. It first calls user:user_help/0, and only if that call fails is a default help message printed on the current output stream. (This predicate is not available in Runtime Systems.)
user_help
user:user_help
A hook predicate. This may be defined by the user to print a help message on the current output stream.


Go to the first, previous, next, last section, table of contents.