; Equivalent to example/zebra.adb


(define (on-right l r li)
  (conde
    ((fresh (z)
      (caro li l)
      (cdro li z)
      (caro z r)))
    ((fresh (z)
      (cdro li z)
      (on-right l r z)))))


(define (next-to l r li)
  (conde
    ((on-right l r li))
    ((on-right r l li))))


(define (zebra h)
  (fresh (a b c d e)
    (== h `(,a ,b ,c ,d ,e))
    (fresh (w x y z) (== a `(norwegian ,w ,x ,y ,z)))
    (fresh (w x y z) (== c `(,w ,x milk ,y ,z)))

    (fresh (x y z) (membero `(englishman ,x ,y ,z red) h))
    (fresh (x y z) (membero `(,x kools ,y ,z yellow) h))
    (fresh (x y z) (membero `(spaniard ,x ,y dog ,z) h))
    (fresh (x y z) (membero `(,x ,y coffee ,z green) h))
    (fresh (x y z) (membero `(ukrainian ,x tea ,y ,z) h))
    (fresh (x y z) (membero `(,x luckystrikes oj ,y ,z) h))
    (fresh (x y z) (membero `(japanese parliaments ,x ,y ,z) h))
    (fresh (x y z) (membero `(,x oldgolds ,y snails ,z) h))

    (fresh (s t u v w x y z) (on-right `(,s ,t ,u ,v ivory) `(,w ,x ,y ,z green) h))

    (fresh (s t u v w x y z) (next-to `(norwegian ,s ,t ,u ,v) `(,w ,x ,y ,z blue) h))
    (fresh (s t u v w x y z) (next-to `(,s ,t ,u horse ,v) `(,w kools ,x ,y ,z) h))
    (fresh (s t u v w x y z) (next-to `(,s ,t ,u fox ,v) `(,w chesterfields ,x ,y ,z) h))

    (fresh (w x y z) (membero `(,w ,x water ,y ,z) h))
    (fresh (w x y z) (membero `(,w ,x ,y zebra ,z) h))))


(define (run-zebra args)
  (let* ((s (run 1 (h) (zebra h))))
    (for-each
      (lambda (x)
        (begin (display x) (newline)))
      (car s))))