Allegro Prolog

Version 1.1.2

Release 1.1.2 of Allegro Prolog continues a sequence of minor bugfix and new feature releases.

The prolog module can be loaded with (require :prolog). Symbols are exported from the prolog package. If you intend to use Prolog interactively you will probably find it convenient to execute (use-package :prolog) also.

It happens that both the prolog and cg packages export a symbol named == which will signal a package conflict if there is an attempt to use both packages. This will happen, for instance, if you try to use the prolog package in the cg-user package without first shadowing one or the other symbol. Usually you want == to refer to prolog:==. You will get that if you load the prolog module and evaluate (shadowing-import '(prolog:==)) and then (use-package :prolog).

User Documentation

This document is not intended as an introduction to programming in Prolog. It assumes some programming knowledge of both Prolog and Common Lisp.

Allegro Prolog is an implementation of Prolog in Common Lisp. It is based on the implementation developed by Peter Norvig in Paradigms of Artificial Intelligence Programming. The code has been further optimized and useful extensions provided, making an industrial-strength Prolog programming environment with a flexible calling interface in both directions between Common Lisp and Prolog.

Prolog predicates are translated to compiled Common Lisp functions. A single Lisp function combines all rules for each distinct functor/arity. Special treatment is given for facts, that is, rules with no variables in the head and no clauses in the body. The Lisp function automatically captures these as data instead of code. This allows reasonably large collections of data to be specified as regular Prolog rules. Larger, highly-scalable data sets can be implemented by extensions outlined below.

Allegro Prolog does not intend to be an ISO-compliant Prolog, nor does it implement the entire Prolog language. Its purpose is to provide Prolog logic programming as an integrated extension to Common Lisp for use in Lisp programs, not as a separate language. Many standard Prolog arithmetic, predicate operators, and I/O operators are not implemented, as they are a subset of the standard Common Lisp operators available using lisp/2. There is also no support for operator syntax (e.g. infix notation), as input notation is subsumed by sexpr syntax. These choices may be reconsidered in the future if there is reason to if there is motivation to make Allegro Prolog a self-standing Prolog implementation. What is provided is the basic Prolog engine for logic programming.

Prolog source files may be loaded either compiled or interpreted, as Prolog predicates are automatically compiled upon first use. But since Allegro Prolog programs will typically contain both Lisp and Prolog code intermixed, it is generally a good idea to compile the files so that the Lisp code is compiled.

All public symbols are exported from the prolog package. The definitions mostly follow Norvig. Lisp S-expression syntax is used rather than Edinburgh syntax, although support for Edinburgh input may be provided in the future. Prolog variables are Lisp symbols that have names that begin with the `?' character. The anonymous variable is the symbol `?' (that is, `prolog:?'). Some symbols exported from the prolog package are eq to symbols exported from the common-lisp package, but there is never any ambiguity between use of a Prolog name and a Lisp name. There is no implementation of the Prolog module system. Programmers should be aware that there is a danger of collision with inherited symbols. For example, the symbol cl:list is not defined by Prolog but would typically be inherited from the common-lisp package by an application package. An attempt to make a Lisp function definition on cl:list would be prevented by package locking, but definition as a Prolog predicate is not protected. If multiple application packages attempt to make such definitions, they would collide on the inherited symbol.

Allegro Prolog has no known dependencies on 8-bit vs. 16-bit character images or on ANSI vs. Modern mode images.

Built-in Prolog Predicates

The following Prolog predicates are predefined in Allegro Prolog and generally implement the standard Prolog functionality. The set of defined predicates may be extended in the future. A few predicates in this implementation accept varying arity and are indicated with a *, as in or/*.

=/2   ==/2   abolish/2   and/*   append/3   arg/3   assert/1   asserta/1   assertz/1   atom/1   atomic/1   bagof/3   call/1   consult/1   copy-term/2   erase/1   fail/0   first/1   functor/3   ground/1   if/2   if/3   is/2   last/1   leash/1   length/1   listing/1   member/2   memberp/2 (member without backtracking)   not/1   number/1   or/*   princ/1   read/1   recorda/1   recordz/1   recorded/2   repeat/0   rest/1   retract/1   rev/2   setof/3   true/0   var/1   write/1  

! is the Prolog cut. It may written as an atom ! as well as the 1-element list (!). The Prolog atom predicate is equivalent to Lisp's symbolp. The Prolog atomic predicate is equivalent to Lisp's atom, true for any object that is not a cons.

The Prolog Top Level

Allegro Prolog does not provide a top level listener loop other than the regular lisp listener. Prolog computation may be invoked programmatically from Lisp using the prolog macro described below, or interactively by executing the ?- macro. Here is a simple example interactive session using ?-.

cl-user(2): (require :prolog)
nil
cl-user(3): (use-package :prolog)
t
cl-user(4): (?- (append ?x ?y (1 2 3)))
?x = ()
?y = (1 2 3) <ENTER>
?x = (1)
?y = (2 3) <ENTER>
?x = (1 2)
?y = (3) <ENTER>
?x = (1 2 3)
?y = () <ENTER>
No.
cl-user(5): 

The ?- macro operates similarly to the top-level loop in interactive Prologs. A ?- expression takes zero or more subforms which are clauses and tries to solve them. When a solution is found, it prints the values of all variables in the expression then reads a character from *standard-input*. (If there are no variables it prints "Yes."). If the character is either newline (usually enter on a keyboard) or semicolon, Prolog backtracks and attempts to find another solution. If the character is a period, Prolog prints "No." and returns.

Defined Lisp Operators

<- clause*

<-- clause*

  (<-- (member ?item (?item . ?)))
  (<-  (member ?item (? . ?rest)) (member ?item ?rest))

?- clause*

consult &rest filename*

leash {functor arity}*

cl-user(2): (require :prolog)
t
cl-user(3): (use-package :prolog)
t
cl-user(4): (<-- (rev-member ?item (? . ?rest))
              (rev-member ?item ?rest))
rev-member
cl-user(5): (<- (rev-member ?item (?item . ?)))
rev-member
cl-user(6): (leash rev-member 2)
t
cl-user(7): (?- (rev-member ?animal (dog cat fish)))
[1] Entering rev-member/2 {Unbound 1000fe7cb1} (dog cat fish)
  [2] Entering rev-member/2 {Unbound 1000fe7cb1} (cat fish)
    [3] Entering rev-member/2 {Unbound 1000fe7cb1} (fish)
      [4] Entering rev-member/2 {Unbound 1000fe7cb1} ()
      [4] Failed rev-member/2
    [3] Succeeded rev-member/2 fish (fish)
  [2] Succeeded rev-member/2 fish (cat fish)
[1] Succeeded rev-member/2 fish (dog cat fish) ?animal="fish" <ENTER>
[1] Backtracking into rev-member/2
 [2] Backtracking into rev-member/2
  [3] Backtracking into rev-member/2
  [3] Failed rev-member/2
 [2] Succeeded rev-member/2 cat (cat fish)
[1] Succeeded rev-member/2 cat (dog cat fish)
?animal = cat <ENTER>
[1] Backtracking into rev-member/2
 [2] Backtracking into rev-member/2
 [2] Failed rev-member/2
[1] Succeeded rev-member/2 dog (dog cat fish)
?animal = dog <ENTER>
[1] Backtracking into rev-member/2
[1] Failed rev-member/2
No.
cl-user(8): 

leash-1 functor arity

unleash {functor arity}*

unleash-1 functor arity

*leash-limit*

*prolog-leash-indent-wrap*

prolog-compile-symbols functor*

Whether a rule is established by <- or assert/2, a Lisp form inside a prolog rule executed by the lisp/2 and similar predicates may not refer to the Lisp lexical environment outside the rule definition. This restriction is necessary because the code for the Prolog predicate is not compiled until later, after all functor/arity clauses have been combined to form its function body.

The Programming Interface between Prolog and Common Lisp

In addition to the interactive query and assertion macros (e.g. ?-> and <-) there are several operators to call in either direction between Prolog code and Lisp code.

lisp arg form

lisp form

lisp* arg form
lisp* form

lispp form

  (lispp (>= ?x 5))

lispp* form

lisp! arg form
lisp! form
lisp*! arg form
lisp*! form
lispp! form
lispp*! form

is arg form

  cl-user: (?- (is (?div ?rem) (multiple-value-list (truncate 11 3)))) 
  ?div = 3 
  ?rem = 2 
  No.

fail

prolog clause*

  (defun human-friends-of (person)
    (let ((friends nil))
      (prolog (lisp ?person person)
              (likes ?person ?x)
              (human ?x)
              (lisp (pushnew ?x friends)))
      friends))

  (defun human-friend-of (person)
    (prolog (lisp ?person person)
            (likes ?person ?x)
            (human ?x)
            (lisp (return-from prolog ?x))))

Prolog and Dynamic Extent

Computation in Prolog works by attempting to satisfy a clause and, if successful, calling a continuation function. If that continuation fails control may return to any previous choice point, undoing any intervening unifications, and trying a different solution choice. Prolog unification data and continuation functions always have dynamic extent. The implementation exploits this by allocating Prolog variables themselves, cons structure created by unification, and continuation closure functions on the stack, that is, with dynamic extent. This allows Prolog code to operate with essentially zero consing and with a resulting improvement in speed.

There are, however, certain functors that typically cons data with indefinite extent. Solutions collected by the bagof/3 and setof/3 predicates are automatically heap consed, as are any rules stored by the assert, asserta, assertz, recorda, and recordz predicate.

The family of lisp predicates are special cases. When a call to the lisp predicate is performed, the values of any Prolog variables referenced in the Lisp form are communicated efficiently to the Lisp code using symbol macros. But those variables may contain nested unification with other Prolog variables, and the structure created by unification may have been consed with dynamic extent. This is not normally a concern since the Lisp code is of course running within the dynamic extent of the surrounding Prolog code, but it would become an issue if the Lisp code stored the data somewhere with indefinite extent.

Dynamic extent is only a concern for cons structures. Numeric data is generally not stack consed.

Some examples will make this clear. Consider the following code:

(defun ancestors-of (person)
  (let ((ancestors nil))
    (prolog (lisp ?person person)
            (ancestor ?x person)
            (lisp (push ?x ancestors)))
    ancestors))

If the data returned by the ancestor predicate are atoms (e.g. symbols) there is no problem since they cannot be stack consed. Similarly, there is no problem with numbers and numeric calculation since the implementation generally does not stack cons numbers. But suppose Prolog data passed to Lisp code was created by unification:

(defun grandfather-pairs ()
  (let ((pairs nil))
    (prolog (grandfather ?gramp ?child)
            (lisp (push (?gramp ?child) pairs)))
    pairs))

are atoms, but it would not work if the objects being passed back were conses created by Prolog unification. But structure created by Prolog unification has only dynamic extent -- that is, it may be consed on the stack. Stack-consed data must be copied to the heap if it is passed outward to Lisp or otherwise preserved outside the dynamic contour where it is created. As an example see the function zebra-benchmark in the zebra example file.

A top-level list created by bagof and setof are automatically given indefinite extent, as is any substructure created by unification and collected on these lists. Therefore the programmer should not have to worry about dynamic extent when using these predicates.

Access to Certain Other Lisp Operators

There are several Prolog predicates that emulate certain Lisp operators that can be useful in integrating Lisp and Prolog control structures. Most Allegro Prolog programmers won't need these, but they may be helpful when extending novel tool architectures.

let*

   (<-- (monte-carlo-sample ?x)
     (let* *x* (random 100))
     ...)

let

unwind-protect clause*

  cl-user(2): (<-- (foo)
                (let my-stm nil)
                (unwind-protect
                    ;; These are the unwind-protect cleanup forms.
                    (write my-stm) (terpri) ; show stm is still open
                    (when my-stm (close my-stm))
                    (write my-stm) (terpri)) ; show it is now closed
                ;; The continuation that is inside the scope of the unwind-protect begins here
                (lisp (setf my-stm (open "/etc/passwd")))
                (lisp ?line (read-line my-stm))
                (write ?line))
  foo
  cl-user(3): (?- (foo))
  "root:x:0:0:root:/root:/bin/bash"
  Yes
  #<file-simple-stream #P"/etc/passwd" for input pos 32 @ #x209e6182>
  #<file-simple-stream #P"/etc/passwd" closed @ #x209e6182>
  No.
  

Tail Call Elimination

The Allegro Prolog facility for including declarations and support for declaring tail call elimination were experimental and have been removed.

The Prolog Stack

prolog-stack-overflow

prolog-stack-overflow-length

*prolog-stack-limit*

I/O Predicates

The set of built-in Prolog I/O predicates is intentionally limited because most input and output would naturally be done by Lisp code. A few predicates are provided for convenience.

read value [stream [stream [stream] ] ]

write value [stream]

princ value [stream]

nl [stream]

Unification with standard-objects.

slot= inst slot-name slot-value

  (<-- (slot= ?instance ?slot-name ?slot-value)
       (lisp ?slot-value
             (slot-value ?instance ?slot-name)))

slot=* inst slot-name slot-value

slot-value inst slot-name slot-value

  cl-user(38): (defparameter *inst* (make-instance 'foo))
  *inst*
  cl-user(39): (?- (lisp ?i *inst*)
                   (slot-value ?i a ?sv))
  No.
  cl-user(40): (?- (lisp ?i *inst*)
                   (slot-value ?i a 123)
                   (slot-value ?i a ?sv))
  ?i = #<foo>
  ?sv = 123
  No.
  cl-user(41): (?- (lisp ?i *inst*)
                   (slot-value ?i a ?sv))
  No.

slot-value! inst slot-name slot-value

  cl-user(42): (defparameter *inst* (make-instance 'foo))
  *inst*
  cl-user(43): (?- (lisp ?i *inst*)
                   (slot-value! ?i a ?sv))
  No.
  cl-user(44): (?- (lisp ?i *inst*)
                   (slot-value! ?i a 123)
                   (slot-value! ?i a ?sv))
  ?i = #<foo>
  ?sv = 123
  No.
  cl-user(45): (?- (lisp ?i *inst*)
                   (slot-value! ?i a ?sv))
  ?i = #<foo>
  ?sv = 123
  No.

The Prolog `Database' and Generators.

In its simplest model, Prolog needs only to remember rules. (A fact is simply a rule with no trailing clauses and no variables in its head.) All rules for a particular functor/arity are remembered in the order they were asserted and the Prolog implementation somehow references these when that functor/arity is invoked. Under this simple model, there is no firm distinction between that portion of a system which the programmer considers program, that part which he considers internal data and tables, and (sometimes) that part which he would consider external data.

But the scaling requirements and operating characteristics of Prolog data sets vary over enormous ranges. Many standard predicates have only one or two rules:

  (<-- (first ?x (?x . ?)))

  (<-- (member ?item (?item . ?)))
  (<-  (member ?item (? . ?rest)) (member ?item ?rest))

Predicates like these are naturally represented as compiled code, or may even be inlined. Rules which are conceptually implemented by compiled program code are managed by the Prolog assert/abolish mechanism.

Now consider a different example (from Norvig) where a predicate is defined partly by algorithm (nontrivial rules) and partly by data (facts):

  (<-- (likes Kim Robin))
  (<-  (likes Sandy Lee))
  (<-  (likes Sandy Kim))
  (<-  (likes Robin cats))
  (<-  (likes Sandy ?x) (likes ?x cats))
  (<-  (likes Kim ?x) (likes ?x Lee) (likes ?x Kim))
  (<-  (likes ?x ?x))

The likes/2 predicate has seven rules, four of which are facts. Despite the combination of programmatic rules and facts, this combined data is still small enough to be represented directly by the code implementing the functor/arity predicate. (This is true especially for Allegro Prolog since compiled predicates capture facts as constant data, rather that expanding them into volumous Lisp code.) However, this representation would become unwieldy if the number of individuals represented in the data were a few orders of magnitude larger, and especially if more of the individuals had idiosyncratic affinities. The factual data would better be represented in tabular form, usually called recorded databases in Prolog. These are managed by predicates such as recorda. Prolog stores recorded facts in an equal-key hashtable.

Note that details of the following predicates differ in some ways from those of other Prolog implementations, and the API may change in the future. The predicates assert/1, asserta/1, assertz/1 and abolish/2 pertain to the compiled predicate database. The predicates recorda/2, recordz/2, retract/1, and retractall/1 pertain to the hashtable database of facts. The hashtable database is not automatically referenced by compiled predicates; it is consulted only by the recorded/2 predicate.

There is a separate interface to the AllegroCache object database described below.

assertz rule

... (assert ((likes ?name Lisp))) ...

... (assert (likes ?name Lisp)) ...

assert rule

asserta rule

abolish functor arity

A typical Prolog application will reason over sets of data. In small programming examples, the data is simply included as `facts' that are part of the program source itself. Reading facts from an external source and asserting them into the program is not much different. While a clever Prolog implementation can optimize collections of facts, this approach cannot scale indefinitely. First, it requires the facts be captured as data belonging to the function. Second, efficient reasoning over large data sets requires knowledge about how the data will be accessed. Often this is really an indexing problem, and the application programmer must guide the system by describing (or implementing) how the data is indexed. It is no coincidence that this concern is similar to database implementation.

A Prolog functor/arity is compiled automatically the first time it is called. Any assert or retract to that functor/arity automatically invalidates the compiled function such that it will be recompiled the next time it is called. While the Allegro compiler is reasonably fast, performance may be poor if dynamic fact/rule management is performed using assert and retract with high bandwidth, interspersed with calls to the functor/arity. In such applications it would be better to use the recorded interface or some other custom fact maintenance code, perhaps using generator.

recordz rule

recorda rule

recorded key rule

retract key

A common idiom for solving the data set issue is to construct a Lisp closure that iteratively generates the data items to be returned. The following predicates support this use.

generator item generator

  ;; This asserts facts into the record database all the package
  ;; inheritances in the running Lisp. 
  cl-user(40): (?- (lisp ?gen (let ((packages (list-all-packages)))
                                (lambda () (pop packages))))
                   (generator ?package ?gen)
                   (lisp ?used-list (package-use-list ?package))
                   (member ?used ?used-list)
                   (recordz (use ?package ?used))
                   (fail))
  No.
  ;; This queries which packages are used by the current package.
  cl-user(41): (?- (lisp ?package *package*)
                   (recorded (use ?package ?) (? ? ?used)))
  ?package = #<The common-lisp-user package>
  ?t = #<The prolog package>
  ?package = #<The common-lisp-user package>
  ?t = #<The common-lisp package>
  ?package = #<The common-lisp-user package>
  ?t = #<The excl package>
  No.

generator* item generator

generating item lisp-generator

  cl-user(40): (?- (generating ?package (let ((packages (list-all-packages)))
                                          (lambda () (pop packages))))
                   (lisp ?used-list (package-use-list ?package))
                   (member ?used ?used-list)
                   (recordz (use ?package ?used))
                   (fail))
  No.

generating* item lisp-generator

A Prolog program that walks a lattice of linked objects is naturally implemented using the lisp operator to follow links using standard Lisp accessors.

  (<-- (class-subclass-gen ?gen ?class)
       (lisp ?gen
             (let ((class-stack (list
                                 (if (symbolp ?class)
                                     (find-class ?class)
                                   ?class))))
               (lambda ()
                 (let ((class (pop class-stack)))
                   (when class
                     (loop for subclass in (clos:class-direct-subclasses class)
                            do (push subclass class-stack))
                     class))))))

  (<-- (has-initarg-p ?class ?slot-name ?initarg)
       (lisp t (typep ?class 'standard-class))
       (lisp ?dslotds (clos:class-direct-slots ?class))
       (member ?dslotd ?dslotds)
       (lisp ?initargs (clos:slot-definition-initargs ?dslotd))
       (member ?initarg ?initargs)
       (lisp ?slot-name (clos:slot-definition-name ?dslotd)))

  (<-- (class-initarg ?root-class ?class ?slot-name ?initarg)
       (class-subclass-gen ?gen ?root-class)
       (generator ?class ?gen)
       (has-initarg-p ?class ?slot-name ?initarg))

  ;; This query will unify to each standard-class and slot that has a
  ;; :documentation initialization argument.
  ;;   (?- (class-initarg t ?class ?slot :documentation))

But querying large collections of relational data may require the programmer to inform the system how the data should be stored and indexed. Allegro Prolog has under development some general mechanisms for indexing data sets, or else an application programmer may implement his own custom mechanisms. For example, the application programmer might back end the Prolog program with a full relational or object database. These possibilities are under active exploration as extensions.

db class ?instance { slot-name slot-value }*

(defclass roman ()
  ((int     :accessor int     :index :any-unique :initarg :int)
   (roman   :accessor roman   :index :any-unique :initarg :roman)
   (english :accessor english :index :any-unique :initarg :english)
   (0mod100 :accessor 0mod100 :index :any        :initarg :0mod100)
   (square  :accessor square  :initarg :square))
  (:metaclass db.allegrocache:persistent-class))

(defun test-populate ()
  (with-file-database ("roman.db" :if-exists :supersede :if-does-not-exist :create)
    (loop for i from 1 to 500
        do (make-instance 'roman
             :int i
             :roman   (intern (format nil "~@r" i) (load-time-value (find-package :keyword)))
             :english (mapcar (lambda (string)
                                (intern string
                                        (load-time-value (find-package :keyword))))
                              (split-re "[ -]" (format nil "~r" i)))
             :0mod100 (zerop (mod i 100))
             :square (* i i)))))

(defmacro with-file-database ((name
                               &key (if-exists nil if-exists-p)
                                    (if-does-not-exist nil if-does-not-exist-p)
                                    read-only)
                              &body body)
  `(let ((db.allegrocache:*allegrocache* nil))
     (unwind-protect
         (multiple-value-prog1
             (progn
               (db.allegrocache:open-file-database
                ,name
                ,@(and if-exists-p
                       `(:if-exists ,if-exists))
                ,@(and if-does-not-exist-p
                       `(:if-does-not-exist ,if-does-not-exist)))
               ,@body)
           (unless ,read-only
             (db.allegrocache:commit)))
       (when db.allegrocache:*allegrocache*
         (db.allegrocache:close-database db.allegrocache:*allegrocache*)))))

cl-user(15): (test-populate)
nil
cl-user(16): (with-file-database ("roman.db")
               (?- (bagof (?half ?english)
                          (and
                           (db roman ?r 0mod100 t int ?int english ?english square ?square)
                           (lisp ?half (truncate ?int 2))
                           (db roman ?r2 int ?half english ?english-half))
                          ?bag)))
?r = 
?english = 
?square = 
?int = 
?r2 = 
?half = 
?english-half = 
?bag = ((100 (two hundred)) (150 (three hundred)) (200 (four hundred)) (250 (five hundred))
        (50 (one hundred)))
No.

Franz Inc is interested in bugs and the experience of programmers using Allegro Prolog. Contact [email protected].

Example: the zebra problem

Here is the Lisp code and the Prolog code for the zebra problem, a well known example of a puzzle with a set of facts about the attributes of people who live in adjacent houses. First here is the Lisp code:

;;;========== zebra.cl

;;;; -*- Mode: common-lisp; Syntax: Common-Lisp -*-

(in-package :user)
(eval-when (compile load eval)
  (use-package :prolog))

(eval-when (compile) (setf excl:*load-xref-info* nil))

(<-- (nextto ?x ?y ?list) (iright ?x ?y ?list))
(<-  (nextto ?x ?y ?list) (iright ?y ?x ?list))
(<-- (iright ?left ?right (?left ?right . ?rest)))
(<-  (iright ?left ?right (?x . ?rest))
     (iright ?left ?right ?rest))

(<-- (zebra ?h ?w ?z)
     ;; Each house is of the form:
     ;; (house nationality pet cigarette drink house-color)
     (= ?h ((house norwegian ? ? ? ?)   ;1,10
            ?
            (house ? ? ? milk ?) ? ?))  ; 9
     (member (house englishman ? ? ? red) ?h) ; 2
     (member (house spaniard dog ? ? ?) ?h) ; 3
     (member (house ? ? ? coffee green) ?h) ; 4
     (member (house ukrainian ? ? tea ?) ?h) ; 5
     (iright (house ? ? ? ? ivory)      ; 6
             (house ? ? ? ? green) ?h)
     (member (house ? snails winston ? ?) ?h) ; 7
     (member (house ? ? kools ? yellow) ?h) ; 8
     (nextto (house ? ? chesterfield ? ?) ;11
             (house ? fox ? ? ?) ?h)
     (nextto (house ? ? kools ? ?)      ;12
             (house ? horse ? ? ?) ?h)
     (member (house ? ? luckystrike oj ?) ?h) ;13
     (member (house japanese ? parliaments ? ?) ?h) ;14
     (nextto (house norwegian ? ? ? ?)  ;15
             (house ? ? ? ? blue) ?h)
     (member (house ?w ? ? water ?) ?h) ;Q1
     (member (house ?z zebra ? ? ?) ?h) ;Q2
     )

;; This runs the query:

(?- (zebra ?houses ?water-drinker ?zebra-owner))

;; These are benchmarking and profiling functions.  
;; It is believed that solving zebra a
;; single time requires 12825 inferences.

(defun zebra-benchmark (&optional (n 1000))
  (declare (optimize (speed 3) (safety 0)))
  (let (rt0 rt1)
    (time (loop initially (setf rt0 (get-internal-run-time))
              repeat n do (prolog (zebra ?houses ?water-drinker ?zebra-owner)
                                  !     ; Stop once answer is found.  
                                        ; This appears to be
                                        ; what other implementations do, 
                                        ; e.g. time/1 in
                                        ; SWI Prolog.
                                  )
              finally (setf rt1 (get-internal-run-time))))
    (let (zebra-owner water-drinker houses)
      (prolog (zebra ?houses ?water-drinker ?zebra-owner)
              ;; Nearly any cons structure created by Prolog 
              ;; unification will be consed with
              ;; dynamic extent.  It isn't safe to return such 
              ;; structure outside the contour
              ;; that created it.  Prolog doesn't need to worry, 
              ;; since unification always
              ;; has dynamic extent, but arbitrary Lisp 
              ;; code needs to be careful.  The first
              ;; two values this function will return are 
              ;; symbols, but the third is a cons
              ;; tree created by Prolog unification.  In order 
              ;; to return it, the tree needs
              ;; to be copied with indefinite extent.
              (lisp (setf zebra-owner ?zebra-owner
                          water-drinker ?water-drinker
                          houses (copy-tree ?houses)))
              !)
      (values (/ (* n 12825) (/ (- rt1 rt0) 1000.0)) ; real time 
                                                     ; is milliseconds
              zebra-owner water-drinker houses))))

;;;  zebra.cl end

Here is Prolog code:

========== zebra.pl

/* -*- Mode: prolog -*-
 *
 * This file for benchmarking against SWI Prolog.
 */

nextto(X, Y, List) :- iright(X, Y, List).
nextto(X, Y, List) :- iright(Y, X, List).
iright(Left, Right, [Left, Right | _]).
iright(Left, Right, [_ | Rest]) :- iright(Left, Right, Rest).

zebra(H, W, Z) :-
    H = [house(norwegian, _, _, _, _), _, house(_, _, _, milk, _), _, _],
     member(house(englishman, _, _, _, red), H),
     member(house(spaniard, dog, _, _, _), H),
     member(house(_, _, _, coffee, green), H),
     member(house(ukrainian, _,  _, tea, _), H),
     iright(house(_, _, _, _, ivory), house(_, _, _, _, green), H),
     member(house(_, snails, winston, _, _), H),
     member(house(_, _, kools, _, yellow), H),
     nextto(house(_, _, chesterfield, _, _), house(_, fox, _, _, _), H),
     nextto(house(_, _, kools, _, _), house(_, horse, _, _, _), H),
     member(house(_, _, luckystrike, oj, _), H),
     member(house(japanese, _, parliaments, _, _), H),
     nextto(house(norwegian, _, _, _, _), house(_, _, _, _, blue), H),
     member(house(W, _, _, water, _), H),
     member(house(Z, zebra, _, _, _), H).

/* This runs the query a single time:
 *  ?- zebra(Houses, WaterDrinker, ZebraOwner).
 */

zebra1(Houses, WaterDrinker, ZebraOwner) :-
        zebra(Houses, WaterDrinker, ZebraOwner), !.

benchmark1 :-
        flag(benchmark,_,0),
        repeat,
        zebra1(Houses, WaterDrinker, ZebraOwner),
        flag(benchmark,N,N+1),
        N = 1000,
        !.

benchmark :- time(benchmark1).

========== end

Copyright (c) Franz Inc. Lafayette, CA. All rights reserved.