; 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))
)

