From: Marko Kreuzer
Subject: HELP!
Date: Mon, 13 Sep 1999 00:00:00 +0000
Message-ID: <37DD22A5.84439340@dive.informatik.fh-schmalkalden.de>

--------------958B49D2D794D3C3AD8C9DEF
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit

Hello together!!!

In the context of a KI project at the university Schmalkalden we are to
implement the following task.

Development of a Prolog-interpreter with the help of the programming
language Golden Common LISP.
The interpreter can solve so far unfortunately only normal inquiries.
For the following problem we got stuck.

Ex.:

Database:
                            (father hugo lars)
                            (mother mary peter)

Inquiry:

(inquires ' (NOT father hugo lars)) desired result:

Examination of the database on occurrences of the inquiry. If inquiry
could be
found, the function " nil " was to supply. The inquiry cannot be solved,
i.e. the
database does not contain appropriate data should the solution " T ".

We absolutely need a solution for the conversion of the " not" problem.

Are grateful for each solution note. In advance thank you

Source-code:

; PROLOG-Interpreter
; ===================
; general structure of the variable  (? <name> <level>)

(defun var-p (s)
    (and (listp s)
         (equal (car s) '?)))

(defun var-name (s)
    (if (var-p s) (car(cdr s)) (print "Fehler !!!")))

; Variable list for testing
(setq VL '(((? x)3)((? y)5)((? z)7)*end*))
(setq VL2 '(((? x) 3)
            ((? y)(? x))
            ((? z)(? y))
            ((? u) 7)end*))

(defun var-assoc (v l)
    (cond ((null l)nil)
          ((equal l '(*end*))nil)
          ((equal v (car(car l)))(car l))
          (t(var-assoc v (cdr l)))))

; Call by (ultimate-assoc '(? z) vl2 vl2)
;(defun ultimate-assoc (v l l1)
;    (cond ((null l)nil)
;          ((equal l '(*end*))nil)
;          ((equal v (caar l))
;                        (if (var-p (cadar l))
;                                (ultimate-assoc v l1 l1)
;                                (cadar l)))
;          (t(ultimate-assoc v (cdr l) l1))))

(defun ultimate-assoc (v l)
    (cond ((var-p v) (let((binding (var-assoc v l)))
                     (if (null binding) v (ultimate-assoc (cadr binding)
l))))
          (t v)))

(defun unify (x y vl)
    (let ((x1 (ultimate-assoc x vl))
          (y1 (ultimate-assoc y vl)))
         (cond
            ((equal x1 y1) vl)
            ((var-p x1)(cons (list x1 y1) vl))
            ((var-p y1)(cons (list y1 x1) vl))
            ((or (atom x1)(atom y1)) nil)
            (t (let ((car-erg (unify (car x1)(car y1) vl)))
                    (if (null car-erg)
                           nil
                        (unify (cdr x1)(cdr y1) car-erg)))))))

;DATABASE
;====================================================
(setq pp1 '(((vater herbert mark))
     ((vater gustav herbert))
     ((mutter mary herbert))
     ((mutter karin mark))
     ((mutter marie karin))
     ((vater otto karin))
     ((mutter karin mark2))
     ((vater herbert mark2))
     ((elternt (? x) (? y)) (vater (? x) (? y)))
     ((elternt (? x) (? y)) (mutter (? x) (? y)))
     ((opa (? x) (? y)) (vater (? x) (? z))
               (elternt (? z) (? y)))
     ((oma (? x) (? y)) (mutter (? x) (? z))
               (elternt (? z) (? y)))
     ((geschw (? x) (? y)) (vater (? v) (? x))
           (mutter (? u) (? x))
           (vater (? v) (? y))
      (mutter (? u) (? y)))
    ))

; (? x) -> (? x <level>)
(defun rename-vars (s l)
    (cond ((null s)nil)
          ((atom s)s)
          ((var-p s)(list '? (cadr s) l))
          (t(cons (rename-vars (car s) l)(rename-vars (cdr s) l)))))

; prove ... Conjunction of targets  / try-each ... or-Function
(defun prove(goals bl level)
   (cond ((null goals)(print-top-bindings bl bl)
                      (cond ((y-or-n-p "more solutions ? ")nil)
                            (t t)))
         (t(try-each (car goals) *pp* (cdr goals) bl level))))

(defun try-each(goal db-left goals-left bl level)
   (cond ((null db-left)nil)
         (t (let ((klausel (rename-vars (car db-left) level)))
                 (let ((new-bl (unify goal (car klausel) bl)))
                      (cond ((null new-bl)(try-each goal (cdr db-left)
goals-left bl level))
       ((prove (append (cdr klausel) goals-left) new-bl (+ level 1)))
                            (t (try-each goal (cdr db-left) goals-left
bl level))))))))

; User inquiries get level 0
(defun anfrage(goal)
   (let ((option (car goal)))
        (cond ((equal option 'normal) (prove (rename-vars (list (cdr
goal))0)'(*end*)1))
              ((equal option 'not)    (print "not"))
  (T (print "ERROR")))))

(setq *pp* pp1)

; Output make more legible
(defun print-top-bindings(bl vbl)
   (cond ((null bl)nil)
         ((equal bl '(*end*))nil)
         ((equal (caddr (caar bl))0)
              (print (caar bl))(princ " = ")(prin1 (ultimate-assoc
(cadar bl) vbl))(terpri)
              (print-top-bindings (cdr bl) vbl))
         (t(print-top-bindings (cdr bl) vbl))))

; User inquiries
(defun y-or-n-p (message)
   (print message)
   (let ((antwort (read)))
        (cond ((equal antwort 'y)t)
              ((equal antwort 'n)nil)
              ((equal antwort 'j)t)
              (t(y-or-n-p message)))))

--------------958B49D2D794D3C3AD8C9DEF
Content-Type: text/html; charset=us-ascii
Content-Transfer-Encoding: 7bit

<!doctype html public "-//w3c//dtd html 4.0 transitional//en">
<html>
Hello together!!!
<p>In the context of a KI project at the university Schmalkalden we are
to implement the following task.
<p>Development of a Prolog-interpreter with the help of the programming
language Golden Common LISP.
<br>The interpreter can solve so far unfortunately only normal inquiries.
For the following problem we got stuck.
<p>Ex.:
<p>Database:
<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
(father hugo lars)
<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
(mother mary peter)
<p>Inquiry:
<p>(inquires ' (NOT father hugo lars)) desired result:
<p>Examination of the database on occurrences of the inquiry. If inquiry
could be
<br>found, the function " nil " was to supply. The inquiry cannot be solved,
i.e. the
<br>database does not contain appropriate data should the solution " T
".
<p>We absolutely need a solution for the conversion of the " not" problem.
<p>Are grateful for each solution note. In advance thank you
<p>Source-code:
<p><tt>; PROLOG-Interpreter</tt>
<br><tt>; ===================</tt>
<br><tt>; general structure of the variable&nbsp; (? &lt;name> &lt;level>)</tt><tt></tt>
<p><tt>(defun var-p (s)</tt>
<br><tt>&nbsp;&nbsp;&nbsp; (and (listp s)</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (equal (car s)
'?)))</tt><tt></tt>
<p><tt>(defun var-name (s)</tt>
<br><tt>&nbsp;&nbsp;&nbsp; (if (var-p s) (car(cdr s)) (print "Fehler !!!")))</tt><tt></tt>
<p><tt>; Variable list for testing</tt>
<br><tt>(setq VL '(((? x)3)((? y)5)((? z)7)*end*))</tt>
<br><tt>(setq VL2 '(((? x) 3)</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
((? y)(? x))</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
((? z)(? y))</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
((? u) 7)end*))</tt><tt></tt>
<p><tt>(defun var-assoc (v l)</tt>
<br><tt>&nbsp;&nbsp;&nbsp; (cond ((null l)nil)</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ((equal
l '(*end*))nil)</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ((equal
v (car(car l)))(car l))</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (t(var-assoc
v (cdr l)))))</tt><tt></tt>
<p><tt>; Call by (ultimate-assoc '(? z) vl2 vl2)</tt>
<br><tt>;(defun ultimate-assoc (v l l1)</tt>
<br><tt>;&nbsp;&nbsp;&nbsp; (cond ((null l)nil)</tt>
<br><tt>;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ((equal
l '(*end*))nil)</tt>
<br><tt>;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ((equal
v (caar l))</tt>
<br><tt>;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
(if (var-p (cadar l))</tt>
<br><tt>;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
(ultimate-assoc v l1 l1)</tt>
<br><tt>;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
(cadar l)))</tt>
<br><tt>;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (t(ultimate-assoc
v (cdr l) l1))))</tt><tt></tt>
<p><tt>(defun ultimate-assoc (v l)</tt>
<br><tt>&nbsp;&nbsp;&nbsp; (cond ((var-p v) (let((binding (var-assoc v
l)))</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
(if (null binding) v (ultimate-assoc (cadr binding) l))))</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (t v)))</tt><tt></tt>
<p><tt>(defun unify (x y vl)</tt>
<br><tt>&nbsp;&nbsp;&nbsp; (let ((x1 (ultimate-assoc x vl))</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (y1 (ultimate-assoc
y vl)))</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (cond</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
((equal x1 y1) vl)</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
((var-p x1)(cons (list x1 y1) vl))</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
((var-p y1)(cons (list y1 x1) vl))</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
((or (atom x1)(atom y1)) nil)</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
(t (let ((car-erg (unify (car x1)(car y1) vl)))</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
(if (null car-erg)</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
nil</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
(unify (cdr x1)(cdr y1) car-erg)))))))</tt><tt></tt>
<p><tt>;DATABASE</tt>
<br><tt>;====================================================</tt>
<br><tt>(setq pp1 '(((vater herbert mark))</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp; ((vater gustav herbert))</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp; ((mutter mary herbert))</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp; ((mutter karin mark))</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp; ((mutter marie karin))</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp; ((vater otto karin))</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp; ((mutter karin mark2))</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp; ((vater herbert mark2))</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp; ((elternt (? x) (? y)) (vater (? x) (?
y)))</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp; ((elternt (? x) (? y)) (mutter (? x) (?
y)))</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp; ((opa (? x) (? y)) (vater (? x) (? z))</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
(elternt (? z) (? y)))</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp; ((oma (? x) (? y)) (mutter (? x) (? z))</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
(elternt (? z) (? y)))</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp; ((geschw (? x) (? y)) (vater (? v) (?
x))</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (mutter
(? u) (? x))</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (vater
(? v) (? y))</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (mutter (? u) (? y)))</tt>
<br><tt>&nbsp;&nbsp;&nbsp; ))</tt><tt></tt>
<p><tt>; (? x) -> (? x &lt;level>)</tt>
<br><tt>(defun rename-vars (s l)</tt>
<br><tt>&nbsp;&nbsp;&nbsp; (cond ((null s)nil)</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ((atom s)s)</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ((var-p
s)(list '? (cadr s) l))</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (t(cons
(rename-vars (car s) l)(rename-vars (cdr s) l)))))</tt><tt></tt>
<p><tt>; prove ... Conjunction of targets&nbsp; / try-each ... or-Function</tt>
<br><tt>(defun prove(goals bl level)</tt>
<br><tt>&nbsp;&nbsp; (cond ((null goals)(print-top-bindings bl bl)</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
(cond ((y-or-n-p "more solutions ? ")nil)</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
(t t)))</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (t(try-each (car
goals) *pp* (cdr goals) bl level))))</tt><tt></tt>
<p><tt>(defun try-each(goal db-left goals-left bl level)</tt>
<br><tt>&nbsp;&nbsp; (cond ((null db-left)nil)</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (t (let ((klausel
(rename-vars (car db-left) level)))</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
(let ((new-bl (unify goal (car klausel) bl)))</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
(cond ((null new-bl)(try-each goal (cdr db-left) goals-left bl level))</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ((prove (append (cdr klausel)
goals-left) new-bl (+ level 1)))</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
(t (try-each goal (cdr db-left) goals-left bl level))))))))</tt><tt></tt>
<p><tt>; User inquiries get level 0</tt>
<br><tt>(defun anfrage(goal)</tt>
<br><tt>&nbsp;&nbsp; (let ((option (car goal)))</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (cond ((equal option
'normal) (prove (rename-vars (list (cdr goal))0)'(*end*)1))</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
((equal option 'not)&nbsp;&nbsp;&nbsp; (print "not"))</tt>
<br><tt>&nbsp; (T (print "ERROR")))))</tt><tt></tt>
<p><tt>(setq *pp* pp1)</tt><tt></tt>
<p><tt>; Output make more legible</tt>
<br><tt>(defun print-top-bindings(bl vbl)</tt>
<br><tt>&nbsp;&nbsp; (cond ((null bl)nil)</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ((equal bl '(*end*))nil)</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ((equal (caddr
(caar bl))0)</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
(print (caar bl))(princ " = ")(prin1 (ultimate-assoc (cadar bl) vbl))(terpri)</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
(print-top-bindings (cdr bl) vbl))</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (t(print-top-bindings
(cdr bl) vbl))))</tt><tt></tt>
<p><tt>; User inquiries</tt>
<br><tt>(defun y-or-n-p (message)</tt>
<br><tt>&nbsp;&nbsp; (print message)</tt>
<br><tt>&nbsp;&nbsp; (let ((antwort (read)))</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (cond ((equal antwort
'y)t)</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
((equal antwort 'n)nil)</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
((equal antwort 'j)t)</tt>
<br><tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
(t(y-or-n-p message)))))</tt></html>

--------------958B49D2D794D3C3AD8C9DEF--