; Beispiele zum XP-Prolog


; Beispiel 1 : EQUAL, Unifikationstest

(deflog equal
  ((x) (equal x x))
)


; Beispiel 2 : INTEGER

; (integer u), wenn u eine ganze Zahl >=0 ist.
(deflog integer
  (() (integer 0))
  ((x y) (integer x) (and (integer y) (is x (+ y 1))))
)

(defun example2 () (goal (u) (integer u)))


; Beispiel 3 : APPEND

; (append (a1 ... ak) b (a1 ... ak . b))
(deflog append
  ((x) (append nil x x))
  ((a x y z) (append (a . x) y (a . z)) (append x y z))
)

(defun example3 () (goal (x y) (append x y (b r u n o))))


; Beispiel 4 : MEMBER

(deflog member
  ((x rest) (member x (x . rest)))
  ((x y rest) (member x (y . rest)) (member x rest))
)


; Beispiel 5 : REVERSE

; (reverse0 x y) falls y = (reverse x)
; Vorsicht: (reverse0 x (1 2)) liefert Endlosschleife.
(deflog reverse0
  ((x y) (reverse0 x y) (reverse2 x y nil))
)

; (reverse1 x y) falls y = (reverse x)
; Vorsicht: (reverse1 x y z) liefert nur eine L�sung.
(deflog reverse1
  ((x y) (reverse1 x y) (and (reverse2 x y nil) (!)))
)

; (reverse2 x y z) falls y = (revappend x z)
(deflog reverse2
  ((z) (reverse2 () z z))
  ((a x y z) (reverse2 (a . x) y z) (reverse2 x y (a . z)))
)

; (palindrome x) stellt fest, ob eine Liste ist, die beim Umdrehen gleichbleibt.
(deflog palindrome
  ((x) (palindrome x) (reverse0 x x))
)


; Beispiel 6 : Olaf Wendts MISCELL-Datei
; [Olaf Wendt: Prolog-Interpreter, implementiert in LISP,
;  Jugend forscht 1984]

(deflog mensch
  (() (mensch sokrates))
  (() (mensch hannibal))
)
(deflog fehlbar
  ((x) (fehlbar x) (mensch x))
)

(deflog hanoi
  ((n) (hanoi n) (setzum n linken mittleren rechten))
)
(deflog setzum
  ((a b c) (setzum 0 a b c) (!))
  ((n m a b c) (setzum n a b c)
     (and (is m (- n 1)) (setzum m a c b) (meldung a b) (setzum m c b a)))
)
(deflog meldung
  ((a b) (meldung a b)
     (format t "~%Lege eine Scheibe vom ~(~S~) Stab zum ~(~S~) Stab." a b))
)

(deflog geh
  ((knoten l) (geh knoten knoten l))
  ((von nach passiert x) (geh von nach passiert)
     (and (or (v von x) (v x von))
          (not (member x passiert))
          (geh x nach (x . passiert))
  )  )
)
(deflog v
  (() (v drau�en windfang))
  (() (v windfang flur))
  (() (v flur e�zimmer))
  (() (v flur k�che))
  (() (v e�zimmer k�che))
  (() (v e�zimmer wohnzimmer))
  (() (v wohnzimmer diele))
  (() (v diele arbeitszimmer))
  (() (v diele bad))
  (() (v bad schlafzimmer))
  (() (v flur wohnzimmer))
  (() (v schlafzimmer wohnzimmer))
)
(deflog tresor
  (() (tresor arbeitszimmer))
)

(deflog sentence
  ((s s1 s2 s3 p p1 pp x) (sentence s s1 pp)
     (and (nounphrase s s2 x p1 p)
          (verbphrase s2 s3 x p1)
          (anding s3 s1 p pp)
) )  )
(deflog anding
  ((s s1 p p1) (anding (and . s) s1 p (& p p1)) (sentence s s1 p1))
  ((s p) (anding s s p p))
)
(deflog nounphrase
  ((s s1 s2 s3 p p1 p2 p3 x) (nounphrase s s1 x p1 p)
     (and (determiner s s2 x p2 p1 p)
          (noun s2 s3 x p3) (relclause s3 s1 x p3 p2) ))
  ((s s1 p x) (nounphrase s s1 x p p) (propernoun s s1 x))
)
(deflog verbphrase
  ((s s1 s2 p p1 x y) (verbphrase s s1 x p)
     (and (transverb s s2 x y p1) (nounphrase s2 s1 y p1 p)) )
  ((s s1 p x) (verbphrase s s1 x p) (intransverb s s1 x p))
)
(deflog relclause
  ((s s1 p1 p2 x) (relclause (that . s) s1 x p1 (& p1 p2))
                  (verbphrase s s1 x p2) )

  ((s x p) (relclause s s x p p))
)
(deflog determiner
  ((s x p1 p2) (determiner (every . s) s x p1 p2 (all x (==> p1 p2))))
  ((s x p1 p2) (determiner (a . s) s x p1 p2 (exists x (& p1 p2))))
)
(deflog noun
  ((s x) (noun (man . s) s x (man x)))
  ((s x) (noun (woman . s) s x (woman x)))
  ((s x) (noun (apple . s) s x (apple x)))
  ((s x) (noun (dog . s) s x (dog x)))
)
(deflog propernoun
  ((s) (propernoun (john . s) s john))
  ((s) (propernoun (mary . s) s mary))
)
(deflog transverb
  ((s x y) (transverb (has . s) s x y (has x y)))
  ((s x y) (transverb (loves . s) s x y (loves x y)))
  ((s x y) (transverb (eats . s) s x y (eats x y)))
)
(deflog intransverb
  ((s x) (intransverb (lives . s) s x (lives x)))
  ((s x) (intransverb (barks . s) s x (barks x)))
)


; Beispiel 7 : NOT

(deflog not
  ((pred) (not pred) (and (call pred) (!) (fail)))
  ((pred) (not pred))
)