Go to the previous, next section.
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 IO Stream IO Dec-10 Prolog File IO 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.
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 UNIX 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 IO 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:
stdin
stream.
The alias can be changed with prolog_flag/3
and accessed
by the C variable SP_stdin
.
stdout
stream.
The alias can be changed with prolog_flag/3
and accessed
by the C variable SP_stdout
.
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 for progress and error messages.
The DEC-10 Prolog IO 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
, 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.
user:file_search_path/2
until an
atomic filename is obtained.
Filenames beginning with `~' or `$' are treated specially. For example,
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.
When the predicates discussed in this section are invoked, filenames are
relative to the current working directory (cwd
). During the
load, the cwd
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 cwd
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.
load/1
will not write any progress or error messages in Runtime
Systems.)
ensure_loaded/1
can only load
`.ql' files.)
ensure_loaded/1
and imports all public
predicates from any module files encountered. (In Runtime Systems,
use_module/1
can only load `.ql' files.)
ensure_loaded/1
and imports
the predicates in PredicateList. If any of these are not public,
a warning is issued. PredicateList may also be set to the atom
all
in which case all public predicates are imported. (In Runtime
Systems, use_module/2
can only load `.ql' files.)
use_module/2
with the addition
that Module is unified with the loaded module after the loading.
If Module is a current module in the system then only importation
takes place and the file specification is not used.
use_module/2
. The file containing the predicate definitions will
be located in the following way:
user:library_directory/1
are
searched for a file `INDEX.pl'. This file is taken to contain
relations between all exported predicates of the module files in the
library directory and its subdirectories. If an `INDEX.pl' is not
found, require/1
will try to create one by loading the library
package mkindex
and calling
make_index:make_library_index(Directory)
(see section The Prolog Library).
require/1
.
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:
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:
user:term_expansion/2
to perform other transformations.
user:term_expansion(Term1,Term2)
is called first, and
only if it fails is the standard expansion used.
end_of_file
. If it succeeds, Term2 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.
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.
term_expansion/2
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 Term2 = ?-(ExpandedQuery)
.
term_expansion/2
is always called in the user
module.
user:term_expansion/2
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 arbitrary complex goal, and user:goal_expansion/3
is
recursively applied to its subgoals.
This predicate is also used to resolve calls to undefined predicates
encountered at runtime via the same mechanism. If the transformation
succeeds, NewGoal is simply called instead of Goal.
Otherwise, another attempt is made using
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.
goal_expansion/3
is always called in the user
module.
'C'([X|S], X, S).
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(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/(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
Prolog flag. The
default is set by that flag.
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.
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.
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.
write(Stream,Term)
.
user:portray/1
. If this succeeds then it is assumed that
Term has been output.
print/2
is called recursively on the components of
Term, unless Term is atomic in which case it is written via
write/2
. 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.
write/1
) will print the Term. portray/1
is
always called in the user
module.
listing/(0-1)
would have written it, including a period at
the end.
write/(1-2)
etc. with a list of options to provide
extra control. Options is a list of zero or more of the
following, where Booelan must be true
or false
(false
is the default). This predicate in fact subsumes the
above output predicates except portray_clause/1
which
additionally calls a version of numbervars/3
and prints a
full-stop.
read/1
. write_canonical/1
,
writeq/1
, and portray_clause/1
select this.
write_canonical/1
and
display/1
select this.
user:portray/1
is called for each subterm.
print/1
selects this.
'$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.
@/2
notation, as discussed above.
portray_clause/1
and listing/0
.
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 is only one item it may be supplied as an atom. 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.
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.
| ?- format("Hello ~1d world!", [42]). Hello 4.2 world! | ?- format("Hello ~d world!", [42]). Hello 42 world!
| ?- format("Hello ~1D world!", [12345]). Hello 1,234.5 world!
| ?- format("Hello ~2r world!", [15]). Hello 1111 world! | ?- format("Hello ~16r world!", [15]). Hello f world!
| ?- format("Hello ~16R world!", [15]). Hello F world!
| ?- format("Hello ~4s ~4s!", ["new","world"]). Hello new worl! | ?- format("Hello ~s world!", ["new"]). Hello new world!
| ?- format("Hello ~i~s world!", ["old","new"]). Hello new world!
write_canonical/2
(see section Input and Output of Terms). Example:
| ?- format("Hello ~k world!", [[a,b,c]]). Hello .(a,.(b,.(c,[]))) world!
print/2
(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!
writeq/2
(see section Input and Output of Terms). Example:
| ?- format("Hello ~q world!", [['A','B']]). Hello ['A','B'] world!
write/2
(see section Input and Output of Terms). Example:
| ?- format("Hello ~w world!", [['A','B']]). Hello [A,B] world!
| ?- format("Hello ~~ world!", []). Hello ~ world!
| ?- format("Hello ~n world!", []). Hello world!
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.
`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.
| ?- 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 * *************************************************************
There are two sets of character IO 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.
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.
These predicates are called peek_code/(1-2)
in the ISO Prolog
standard.
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.
These predicates are called put_code/(1-2)
in the ISO Prolog
standard.
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.
nl(user)
.
flush_output(user)
.
get0(user, N)
.
get(user, N)
.
put(user, N)
.
skip(user, N)
.
tab(user, N)
.
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.
fopen
) and the resulting
stream is unified with Stream. Mode is one of:
fdopen
) which is unified with
Stream.
see/1
or tell/1
, the corresponding stream
is closed.
absolute_file_name/2
may 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.
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.
NewAlias(NewName)
.
In this case, the filename expands to
NewAlias(NewName/Name)
, which is subject to
further expansion via a recursive call to user:file_search_path/2
.
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(Name)
is used. library_directory/1
is
always called in the user
module. 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.
SP_curin
.
SP_curout
.
compare/3
, but
you should not otherwise rely on their internal representation. This
operation is available for any Prolog 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
.
nofileerrors/0
.
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.
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.
The following predicates manipulate files.
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.
see/1
, with the current input stream, if it is not
user_input
, otherwise with user
.
user_input
.
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.
tell/1
, with the current output stream, if
it is not user_output
, otherwise with user
.
user_output
.
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 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.
integer(X)-integer(Y)*(X//Y)
.
"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.
integer(log(2,X))
.
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.
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:
./2
. For example, here is a list of terms in the standard order:
[ X, -1.0, -9, 1, fie, foe, X = Y, foe(0,2), fie(1,1,1) ]
These are the basic predicates for comparison of arbitrary terms:
| ?- 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).
Some further predicates involving comparison of terms are:
Thus compare(=,Term1,Term2)
is equivalent to
Term1 == Term2
.
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.)
\+(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.
if P then Q else R
and defined as if by
(P -> Q; R) :- P, !, Q. (P -> Q; R) :- R.
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; fail)
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/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/0
is discouraged, because it is
not as portable as fail/0
, and because the latter has a more
procedural flavor to it.
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)
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.
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/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.
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/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:
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
.
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.
prolog_flag/3
) is set to error
, this
error is raised with ArgNo set to 0.
read/(1-2)
. This
error is raised only if the syntax_errors
flag (see
prolog_flag/3
) is set to error
.
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
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)).
spy/1
(see section Spy-points), but which may also
contain variables. For example:
| ?- listing([concatenate/3, reverse, m:go/(2-3), bar:_]).
built_in
(for built-in predicates) or
compiled
or interpreted
(for user defined predicates),
dynamic
and multifile
, for
predicates that have been declared to have these properties
(see section Declarations),
(block Term)
for predicates that have
block declarations (see section Declarations),
exported
or terms imported_from(ModuleFrom)
for predicates exported or imported from modules (see section The Module System),
(meta_predicate Term)
for predicates that have
meta-predicate declarations (see section Meta-Predicate Declarations).
sync
for predicates that perform side
effects that must be synchronized to preserve standard semantics.
parallel
for predicates that may
be executed in parallel.
This predicate can be used to enumerate all existing predicates and their properties through backtracking.
% sicstus -a hello world 2001
then the value will be [hello,world,'2001']
.
compile/1
and fcompile/1
operate (see section Loading Programs).
debug/0
, nodebug/0
,
trace/0
, notrace/0
(see section Debugging).
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
.
on
or off
. Turns raising of exception on file errors on or
off. Equivalent to fileerrors/0
and nofileerrors/0
,
respectively (see section Stream IO). Initially on
.
on
or off
. Turns garbage collection on or off.
Initially on
.
on
or off
. Enable or disable warning messages when a
predicate is being
user
module and it was previously locally defined.
user
module from another module than it was
previously imported from.
Initially on
. (This warning is always
disabled in Runtime Systems.)
on
or off
. Enable or disable warning messages when a
clause containing non-anonymous variables occurring once only is
compiled or consulted. Initially on
.
unknown/2
(see section Debugging).
read/(1-2)
.
development
in Development
Systems and runtime
in Runtime Systems.
module/1
.
user_input
and SP_stdin
. It is initially set to a stream
connected to UNIX stdin
.
user_output
and SP_stdout
. It is initially set to a stream
connected to UNIX stdout
.
user_error
and SP_stderr
. It is initially set to a stream
connected to UNIX stderr
.
'SICStus 3 #0: Wed Mar 15 12:29:29 MET 1995'
.
user:term_expansion/2
and need to access the
source module at compile time.
[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.
[size used,free]
This refers to the local stack, where recursive predicate environments
are stored.
[size used,free]
This refers to the trail stack, where conditional variable bindings are
recorded.
[size used,free]
This refers to the choicepoint stack, where partial states are stored
for backtracking purposes.
[size used,0]
These refer to the amount of memory actually allocated by the UNIX
process.
[size used,0]
These refer to the amount of memory allocated for compiled and
interpreted clauses, symbol tables, and the like.
[since start of Prolog,since previous statistics]
These refer to CPU time used while executing, excluding time spend
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.
[since start of Prolog,since previous statistics]
These refer to absolute time elapsed.
[no. of GCs,bytes freed,time spent]
[no. of local shifts,no. of trail shifts,time spent]
Times are in milliseconds, sizes of areas in bytes.
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
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.
var/1
.
ground/1
a monotone predicate.
| ?- 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(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.
name(Const,CharList)
, but Const
is constrained to be an atom.
This predicate is called atom_codes/2
in the ISO Prolog
standard.
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(X, Y) :- assert('copy of'(X)), retract('copy of'(Y)).
The implementation of copy_term/2
conserves space by not copying
ground subterms.
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:
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, the clauses of dynamic predicates also 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. However it should be stressed that use of these predicates requires some extra care.
assert/2
, except that the new clause becomes the
first clause for the predicate concerned.
assert/2
, except that the new clause becomes the last
clause for the predicate concerned.
(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/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
for
the same predicate. The space occupied by a retracted clause will be
recovered when instances of the clause are no longer in use.
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.
Name/Arity
. Spec is described under
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.
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.
recorda/3
, except that the new term becomes the last
item for the key Key.
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_get/2
silently fails.
bb_delete/2
silently fails.
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(>, _, _).
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.
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.
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.
P
(see section Control). The use of this explicit existential
quantifier outside the setof/3
and bagof/3
constructs is
superfluous and discouraged.
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/3
, except Bag is the list of solution
instances appended with Remainder, which is typically unbound.
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:
For example:
| ?- when(((nonvar(X);?=(X,Y)),ground(T)), process(X,Y,T)).
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.
true
.
If more than one goal is blocked, a conjunction is unified with Goal.
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/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 predicates are not available in Runtime Systems.
user:goal_expansion/3
and user:unknown_predicate_handler/3
cannot handle the goal.
The possible states of the
flag are:
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 Runtime Systems nor 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.
The Selection argument determines the kind of profiling data to be collected. If uninstantiated, the predicate will backtrack over its possible values, which are:
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:
Module:PredName-Count
, where
Count is a sum of the corresponding counts per clause.
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.
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_data/4
.
The following predicates are only defined in the Muse Development System.
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.
This built-in predicate lists all current Muse flag settings.
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:
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.
TMPDIR
environment
variable.
Cannot be executed in parallel when the execution changes the scheduler state.
Z=Z.
; i.e. X and Y are
unified.
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.
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, @dots{}, Z, A1, B1, etc. This predicate is used by
listing/0, listing/1
(see section Information about the State of the Program).
call(Goal)
(see section Control) is executed on
backtracking. This predicate is useful if the Goal performs some
side-effect that must be done on backtracking to undo another side-effect.
Note that the Goal is immune to cuts. That is, undo/1
does
not behave as if it were defined by
weak_undo(_). weak_undo(Goal) :- call(Goal), fail.
since defining it this way would not guarantee that Goal be executed on backtracking.
Note also that the Prolog top level operates as a read-execute-fail
loop, and backtracks implicitly for each new query. Raised exceptions
and the predicates halt/0
, abort/0
, and
reinitialise/0
cause implicit backtracking as well.
Not available in Muse.
save/1
. See section Saving and Restoring Program States. (This predicate is not available in
Runtime Systems.) (Requires Muse to be adjusted to one worker.)
save(File)
, but in addition unifies Return to 0 or 1
depending on whether the return from the call occurs in the original
incarnation of the state or through a call restore(File)
(respectively). (This predicate is not available in Runtime Systems.)
(Requires Muse to be adjusted to one worker.)
SP_reinit_hook
(see section User Hooks).
version/0
to write banners.
-l File
was supplied as
program arguments.
initialization/0
to run user-defined initializations.
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 terminal
(e.g. by calling read/1
). Note also that the prompt is reset to
the default `|: ' on return to top-level.
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/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/1
. Only the first
solution is investigated. initialization/0
is called at system
(re)initialization. (This predicate is not available in Runtime Systems.)
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.
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/0
is
always called in the user
module.
Go to the previous, next section.