From: =?iso-8859-1?Q?Djam=E9_Seddah?= <djame.seddah@paris-sorbonne.fr>
Content-Type: text/plain; charset=iso-8859-1
Content-Transfer-Encoding: quoted-printable
Subject: prolog in lisp
Date: Thu, 6 Jan 2011 02:48:46 +0100
Message-Id: <C2927F47-F22E-4342-A033-9947864550AF@paris-sorbonne.fr>
To: antti.ylikoski@elisanet.fi
Mime-Version: 1.0 (Apple Message framework v1082)
Status:   

Hi,=20
i've seen your post in comp.lang.prolog about your query of a prolog =
interpreter written in lisp and I've found one :)

here's the post I've sent back (I'm not sure it's got published)


Best,
Djam=E9



	From:	Djam=E9 Seddah
	Newsgroups:	comp.lang.prolog
	Date:	Tue, 23 Nov 2010 17:12:56 +0100
	Subject:	Re: LISP source of Prolog systems

On 2010-10-25 03:39:58 +0200, Antti J Ylikoski =
<antti.ylikoski@elisanet.fi> said:

Could somebody inform me where I gould get the public domain LISP source =
code of some Prolog interpreters.  I'm interested in the implementation =
of Prolog (in LISP).

I in principle know Mats Carlsson's YAQ and Carlsson-Kenneth Kahn's =
LM-PROLOG, but I have not found the (public domain) source code of those =
in the 'Net.  I have the files of the "Principles of Artificial =
Intelligence Programming" by Norvig in my hands, that is an excellent =
book, and it contains both a Prolog system and a good discussion of =
knowledge representation.


regards;; Antti J Ylikoski
Helsinki, Finland, the E.U.

Hi,
I don't know if the question still stands but I remember finding a =
prolog interpreter written in the xlisp dialect  in the XLisp src =
distribution that was available for Atari ST and Windows PC circa =
1997-1998. As far as i know that was public domain stuff.

Good luck finding that (maybe on the old atari  michigan archive)
and actually  I just found it there :)
it's  the file PROLOG.LSP in
http://www.umich.edu/~archive/atari/Languages/xlisplsp.arc


Djam=E9
ps: never actually used it below father X something, 15 years ago...
here the code for those without any arc unarchiver.


;; The following is a tiny Prolog interpreter in MacLisp

;; written by Ken Kahn and modified for XLISP by David Betz.

;; It was inspired by other tiny Lisp-based Prologs of

;; Par Emanuelson and Martin Nilsson.

;; There are no side-effects anywhere in the implementation.

;; Though it is VERY slow of course.



(defun prolog (database &aux goal)

       (do () ((not (progn (princ "Query?") (setq goal (read)))))

              (prove (list (rename-variables goal '(0)))

                     '((bottom-of-environment))

                     database

                     1)))



;; prove - proves the conjunction of the list-of-goals

;;         in the current environment



(defun prove (list-of-goals environment database level)

      (cond ((null list-of-goals) ;; succeeded since there are no goals

             (print-bindings environment environment)

             (not (y-or-n-p "More?")))

            (t (try-each database database

                         (cdr list-of-goals) (car list-of-goals)

                         environment level))))



(defun try-each (database-left database goals-left goal environment =
level=20
                 &aux assertion new-enviroment)

       (cond ((null database-left) nil) ;; fail since nothing left in =
database

             (t (setq assertion

                      (rename-variables (car database-left)

                                        (list level)))

                (setq new-environment

                      (unify goal (car assertion) environment))

                (cond ((null new-environment) ;; failed to unify

                       (try-each (cdr database-left) database

                                 goals-left goal

                                 environment level))

                      ((prove (append (cdr assertion) goals-left)

                              new-environment

                              database

                              (+ 1 level)))

                      (t (try-each (cdr database-left) database

                                   goals-left goal

                                   environment level))))))



(defun unify (x y environment &aux new-environment)

       (setq x (value x environment))

       (setq y (value y environment))

       (cond ((variable-p x) (cons (list x y) environment))

             ((variable-p y) (cons (list y x) environment))

             ((or (atom x) (atom y))

                  (cond ((equal x y) environment)

    	                (t nil)))

             (t (setq new-environment (unify (car x) (car y) =
environment))

                (cond (new-environment (unify (cdr x) (cdr y) =
new-environment))

    		      (t nil)))))



(defun value (x environment &aux binding)

       (cond ((variable-p x)

              (setq binding (assoc x environment :test #'equal))

              (cond ((null binding) x)

                    (t (value (cadr binding) environment))))

             (t x)))



(defun variable-p (x)

       (and x (listp x) (eq (car x) '?)))



(defun rename-variables (term list-of-level)

       (cond ((variable-p term) (append term list-of-level))

             ((atom term) term)

             (t (cons (rename-variables (car term) list-of-level)

                      (rename-variables (cdr term) list-of-level)))))



(defun print-bindings (environment-left environment)

       (cond ((cdr environment-left)

              (cond ((=3D 0 (nth 2 (caar environment-left)))

                     (prin1 (cadr (caar environment-left)))

                     (princ " =3D ")

                     (print (value (caar environment-left) =
environment))))

              (print-bindings (cdr environment-left) environment))))



;; a sample database:

(setq db '(((father madelyn ernest))

           ((mother madelyn virginia))

	   ((father david arnold))

	   ((mother david pauline))

	   ((father rachel david))

	   ((mother rachel madelyn))

           ((grandparent (? grandparent) (? grandchild))

            (parent (? grandparent) (? parent))

            (parent (? parent) (? grandchild)))

           ((parent (? parent) (? child))

            (mother (? parent) (? child)))

           ((parent (? parent) (? child))

            (father (? parent) (? child)))))



;; the following are utilities

(defun y-or-n-p (prompt)

       (princ prompt)

       (eq (read) 'y))



;; start things going

(prolog db)



;;;EOF