Prolog

Appeared in:
1972
Influenced:
Paradigm:
Typing discipline:
Dialects:
Versions and implementations (Collapse all | Expand all):
Programming language

Prolog (from “PROgramming in LOGic”) is a general-purpose programming language.

Prolog was created in 1972 in an attempt to combine the use of logic with knowledge representation. Since than it has spawned several dialects which extend it with different capabilities.

Prolog standard is given in ISO/IEC 13211-1, published in 1995.

Prolog is one of the oldest and remains one of the most popular logic languages today, though it is much less popular than major imperative languages. It is mostly used in natural language processing, artificial intelligence researches, expert systems, answering systems, ontologies and other object domains where use of logic paradigm is natural.

Prolog was influenced by an earlier language Planner, borrowing from it the following concepts:

  • backward-chaining (i.e., pattern-directed procedures invocation from goals);
  • general backtracking control structure;
  • negation as failure;
  • using different names to refer to different entities etc.

The main paradigm implemented in Prolog is logic programming. As in most old languages, later implementations, like Visual Prolog, feature additional, more recent object-oriented and event-driven paradigms, some with elements of imperative style.

Prolog uses one data type called term, which comes in several types:

  • atom is a name without particular meaning, used for construction of compound terms;
  • numbers and strings are the same as in other languages;
  • variable is denoted with a name which starts with an uppercase letter and is used as a placeholder for any other term;
  • compound term is a functor atom, followed by several arguments, each of them being a term.

Pure Prolog programs describe relations between processed entities using Horn clauses. Clause is a rule of form Head :- Body., which reads as “to show/solve Head, show/solve Body”. Body consists of several calls to predicates (rule’s goals), combined with conjunction and disjunction. Clauses with empty body are called facts and are equivalent to rules Head :- true. (true is a built-in predicate, not an atom like in other languages).

Another important part of Prolog are predicates. Unary predicates express properties of their arguments, while predicates with multiple arguments express the relations between them. Prolog has a variety of built-in predicates which act as functions in other languages. Predicates with multiple arguments can act in several directions depending on which of their arguments already have a binding and which have none. For example, … Finally, to be a general-purpose language, Prolog has to provide a variety of service functions, for example, input/output routines. They are implemented as predicates without particular meaning which always evaluate successfully and perform these service functions as a side effect.

The purpose of executing Prolog program is evaluation of a single predicate. Given this predicate and the set of rules provided in the program, Prolog engine tries to find a set of variable bindings which makes the predicate of interest evaluate to true (or which refutes the negation of this predicate, which is the same).

Elements of syntax:

Inline comments %
Case-sensitivity yes
Variable identifier regexp [_A-Z][_a-zA-Z0-9]*
Function identifier regexp [_a-z][_a-zA-Z0-9]*
Variable assignment is
Variable declaration = :-
Grouping expressions ( ... )
Deep equality ==
Deep inequality \==
Comparison @< @> @=< @>=

Examples:

Hello, World!:

Example for versions Visual Prolog 7.2

Visual Prolog provides automatic project creation, so you have to create a new project, choose “Console” as UI Strategy, navigate to file main.pro and replace its contents with the given code. The code differs from the standard one only in terms stdio::write (to write the message to the console) and programControl::sleep (to pause program execution).

implement main
    open core

constants
    className = "main".
    classVersion = "".

clauses
    classInfo(className, classVersion).

clauses
    run():-
        console::init(),
        stdio::write("Hello, World!"),
        programControl::sleep(1000),
        succeed().
end implement main

goal
    mainExe::run(main::run).

Factorial:

Example for versions Visual Prolog 7.2

Create a new project with UI Strategy “Console” and replace contents of files main.cl and main.pro with given code.

In main.cl the only added line factorial : (integer N, integer F) procedure (i,o). specifies that factorial is a predicate of arity 2, with known first and unknown second argument. Keyword procedure describes the behavior of predicate, indicating that is will always succeed with only one solution, so no backtracking is required.

In main.pro the actual description of newly specified predicate takes place. There are two possible matches for each call of factorial — with zero or arbitrary first argument. Visual Prolog searches the clauses for matching call in the order of their appearance in the code, so if first argument is zero, it starts with first clause factorial(0,F). The first rule in this clause is !, a so-called cut, which prevents backtracking to second clause factorial(N,F) and thus ensures that there is only one solution to the call. After this the return variable F is set to 0! = 1 and the result of the clause is printed. The second clause factorial(N,F) recursively calculates F1 as factorial of N-1, assigns N*F1 to return variable F and prints the result. Finally, stdio::nl prints a new line.

When the main program runs, factorial is called exactly once, for N=12. With each call of recursion N is decremented until it reaches 0. After this factorials are returned and printed in increasing order of N. This program can process only factorials up to 12!, since trying to calculate 13! causes an integer overflow.

% main.cl
class main
    open core

predicates
    classInfo : core::classInfo.
    factorial : (integer N, integer F) procedure (i,o).
predicates
    run : core::runnable.

end class main

% main.pro
implement main
    open core

constants
    className = "main".
    classVersion = "".

clauses
    classInfo(className, classVersion).
    factorial(0,F) :- 
        !,
        F = 1, 
        stdio::write("0! = 1"),
        stdio::nl.
    factorial(N,F) :-
        factorial(N-1,F1),
        F = N*F1,
        stdio::write(N, "! = ", F),
        stdio::nl.
        
clauses
    run():-
        console::init(),
        factorial(12,F),
        programControl::sleep(1000),
        succeed().
end implement main

goal
    mainExe::run(main::run).

Fibonacci numbers:

Example for versions Visual Prolog 7.2

Create a new project with UI Strategy “Console” and replace contents of files main.cl and main.pro with given code.

Here we define two new predicates — fibonacci(N,F) to calculate Nth Fibonacci number and loop(N) to output it. We don’t use memoization to store already calculated numbers, so this implementation is rather inefficient. Note the way the predicates are defined — each predicate is written as one clause using conjunction , and disjunction ; of elementary predicates (instead of breaking them in several clauses which use only disjunction).

% main.cl
class main
    open core

predicates
    classInfo : core::classInfo.
    fibonacci : (integer N, integer F) procedure (i,o).
    loop : (integer N) procedure (i).
predicates
    run : core::runnable.

end class main

% main.pro
implement main
    open core

constants
    className = "main".
    classVersion = "".

clauses
    classInfo(className, classVersion).
    fibonacci(N,F) :- 
        N < 3, !, F = 1;
        fibonacci(N-1,F1), fibonacci(N-2,F2), F = F1 + F2.
    loop(N) :-
        ( N = 1, !, fibonacci(1,F);
          loop(N-1), fibonacci(N,F) ),
        stdio::write(F, ", ").
        
clauses
    run():-
        console::init(),
        loop(16),
        stdio::write("..."),
        programControl::sleep(1000),
        succeed().
end implement main

goal
    mainExe::run(main::run).

Quadratic equation:

Example for versions Visual Prolog 7.2

Create a new project with UI Strategy “Console” and replace contents of files main.cl and main.pro with given code.

In main.cl the only added line q : () procedure(). specifies that q is a predicate which doesn’t accept parameters. Keyword procedure describes the behavior of predicate, indicating that is will always succeed with only one solution, so no backtracking is required.

In main.pro the actual description of newly specified predicate takes place. q takes no arguments, since it reads everything it needs from stdio. Conditional evaluation (construct if-then-else) works much like in other languages, with the difference of ! sign before then clause. This is a cut, meaning that once the condition is satisfied, no backtracking is needed.

The tricky part about this example is that we can’t calculate discriminant before checking its sign like in other examples. Default data type for D in assignment D = B*B-4*A*C is uReal, which is unsigned and can’t hold negative values. Thus, we have to check the sign of discriminant first and then assign its absolute value to a variable D.

% main.cl
class main
    open core

predicates
    classInfo : core::classInfo.
    q : () procedure().
predicates
    run : core::runnable.

end class main

% main.pro
implement main
    open core

constants
    className = "main".
    classVersion = "".

clauses
    classInfo(className, classVersion).
    q() :-
        stdio::write("A = "), 
        A = stdio::read(),
        if (A = 0), ! then
            stdio::write("Not a quadratic equation."), stdio::nl
        else
            stdio::write("B = "), 
            B = stdio::read(),
            stdio::write("C = "), 
            C = stdio::read(),
            if (B*B = 4*A*C), ! then
                stdio::writef("x = %f", -B/2.0/A)
            elseif (B*B > 4*A*C), ! then
                D = B*B-4*A*C,
                stdio::writef("x1 = %f\n", (-B+math::sqrt(D))/2.0/A),
                stdio::writef("x2 = %f", (-B-math::sqrt(D))/2.0/A)
            else
                D = -B*B+4*A*C,
                stdio::writef("x1 = (%f, %f)\n", -B/2.0/A, math::sqrt(D)/2.0/A),
                stdio::writef("x2 = (%f, %f)", -B/2.0/A, -math::sqrt(D)/2.0/A)
            end if
        end if.
        
clauses
    run():-
        console::init(),
        q(),
        succeed().
end implement main

goal
    mainExe::run(main::run).

Factorial:

Example for versions Poplog 15.5 (Prolog)

This example consists of two parts — the first part of code should be stored in a file fact.pl placed in working folder of Poplog, and the second one has to be entered manually. [-fact]. downloads facts and rules from this file to current Prolog session (and outputs fact reconsulted to note that download succeeded). Query fact(16,X). tries to find value of X for which this predicate will evaluate to true. The output required in the example is side effect of query evaluation, and the actual result will be X = 20922789888000 ?. This means that if you’re not satisfied with this binding, you can reject it (by entering ;), and the search for better binding will continue.

% fact.pl
fact(X, F) :- 
    ( X=0, F=1; 
      Y is X-1, fact(Y, Z), F is X*Z), 
    write(X), write('! = '), write(F), nl.

% interactive
[-fact].
fact(16,X).

Fibonacci numbers:

Example for versions Poplog 15.5 (Prolog)

Straightforward recursive implementation is too memory inefficient to be executed in Poplog, so this example shows a more advanced technique — recursion with memoization. An additional predicate memo(Goal) is defined so that the first time Goal is evaluated, the result of its evaluation is added to facts database, and next time it is questioned, it is not re-evaluated but taken as a known fact.

After this predicate fib(N,F) is defined recursively, but each call to fib is wrapped in memo, so for each value of N fib(N,F) is evaluated only once. With such approach printing calculated numbers can be done immediately after their calculation, without extra loop.

% fibonacci.pl
:- dynamic(stored/1).

memo(Goal) :-
    stored(Goal) -> true;
    Goal, assertz(stored(Goal)).

fib(1,1) :- !, write('1, ').
fib(2,1) :- !, write('1, ').
fib(N,F) :-
    N1 is N-1, memo(fib(N1,F1)), 
    N2 is N-2, memo(fib(N2,F2)), 
    F is F1 + F2,
    write(F), write(', ').

% interactive
[-fibonacci].
fib(16,X), write('...'), nl.

Hello, World!:

Example for versions B-Prolog 7.4 #3, Poplog 15.5 (Prolog), gprolog 1.3.0, swipl 5.6.x

This example doesn’t need any facts or rules to be evaluated. The query is executed in interactive mode, and results in the following output:

Hello, World!
yes

First line is the actual output of write predicate, and second line is the result of query evaluation.

Note that replacing single-quotes with double-quotes makes Prolog output the string as an array of ASCII-codes of individual characters:

| ?- write("Hello, World!").
[72,101,108,108,111,44,32,87,111,114,108,100,33]

yes

write('Hello, World!'), nl.

Quadratic equation:

Example for versions B-Prolog 7.4, gprolog 1.3.0, swipl 5.6.x

This is an ISO Prolog example, using standard read/1 predicate for reading input. Note that when using read/1, you have to put full stop . after each value you input.

q :- write('A = '),
     read(A),
     (   A = 0, write('Not a quadratic equation');
         write('B = '),
         read(B),
         write('C = '),
         read(C),
         D is B*B-4*A*C,
         (   D = 0, write('x = '), X is -B/2/A, write(X);
             D > 0, write('x1 = '), X1 is (-B+sqrt(D))/2/A, write(X1), nl, write('x2 = '), X2 is (-B-sqrt(D))/2/A, write(X2);
             R is -B/2/A, I is abs(sqrt(-D)/2/A), 
             write('x1 = ('), write(R), write(', '), write(I), write(')'), nl,
             write('x1 = ('), write(R), write(', -'), write(I), write(')')
         )
     ).

Factorial:

Example for versions B-Prolog 7.4 #3, gprolog 1.3.0, swipl 5.6.x

Almost identical to Poplog Prolog example, except for the syntax of compiling a file (doesn’t have a - before file name). However, the results of execution depend on the implementation. SWI-Prolog handles large numbers just fine, while in GNU Prolog and B-Prolog 12! overflows the numeric data type, so all values after 11! are incorrect.

| ?- [fact].
compiling /home/nickolas/Desktop/progopedia/prolog/fact.pl for byte code…
/home/nickolas/Desktop/progopedia/prolog/fact.pl compiled, 3 lines read — 1372 bytes written, 5 ms

yes
| ?- fact(16,X).
0! = 1
1! = 1
2! = 2
3! = 6
4! = 24
5! = 120
6! = 720
7! = 5040
8! = 40320
9! = 362880
10! = 3628800
11! = 39916800
12! = -57869312
13! = -215430144
14! = 205203456
15! = -143173632
16! = -143294464

X = -143294464 ?`

% fact.pl
fact(X, F) :- 
    ( X=0, F=1; 
      Y is X-1, fact(Y, Z), F is X*Z), 
    write(X), write('! = '), write(F), nl.

% interactive
[fact].
fact(16,X).

Fibonacci numbers:

Example for versions B-Prolog 7.4 #3, gprolog 1.3.0, swipl 5.6.x

Once again, the example is almost identical to Poplog Prolog one, except for the syntax of compiling/consulting a file.

% fibonacci.pl
:- dynamic(stored/1).

memo(Goal) :-
    stored(Goal) -> true;
    Goal, assertz(stored(Goal)).

fib(1,1) :- !, write('1, ').
fib(2,1) :- !, write('1, ').
fib(N,F) :-
    N1 is N-1, memo(fib(N1,F1)), 
    N2 is N-2, memo(fib(N2,F2)), 
    F is F1 + F2,
    write(F), write(', ').

% interactive
[fibonacci].
fib(16,X), write('...'), nl.

Quadratic equation:

Example for versions gprolog 1.3.0

Conditional branching in Prolog is done via ; and , predicates, which correspond to “or” and “and” logical operations. Evaluation starts with first branch (for example, check for A being 0 in line 3); all predicates separated with , are evaluated in row; if all of them evaluate to true, the whole program evaluates to true as well (and further evaluation stops), otherwise the next branch is evaluated.

read_integer is GNU Prolog extension, other implementations don’t have this predicate built-in.

q :- write('A = '),
     read_integer(A),
     (   A = 0, write('Not a quadratic equation');
         write('B = '),
         read_integer(B),
         write('C = '),
         read_integer(C),
         D is B*B-4*A*C,
         (   D = 0, write('x = '), X is -B/2/A, write(X);
             D > 0, write('x1 = '), X1 is (-B+sqrt(D))/2/A, write(X1), nl, write('x2 = '), X2 is (-B-sqrt(D))/2/A, write(X2);
             R is -B/2/A, I is abs(sqrt(-D)/2/A), 
             write('x1 = ('), write(R), write(', '), write(I), write(')'), nl,
             write('x1 = ('), write(R), write(', -'), write(I), write(')')
         )
     ).

q.