57 lines
1.6 KiB
Racket
57 lines
1.6 KiB
Racket
#lang racket
|
|
|
|
(require racklog)
|
|
|
|
(define %select
|
|
(%rel (x xs S S1)
|
|
[(x (cons x xs) xs)]
|
|
[(x (cons S xs) (cons S S1)) (%select x xs S1)]
|
|
[((cons x xs) S)
|
|
(%select x S S1)
|
|
(%select xs S1)]
|
|
[('() (_))]))
|
|
|
|
(define %next-to
|
|
(%rel (A B C)
|
|
[(A B C)
|
|
(%or (%left-of A B C)
|
|
(%left-of B A C))]))
|
|
|
|
(define %left-of
|
|
(%rel (A B C)
|
|
[(A B C) (%append (_) (cons A (cons B (_))) C)]))
|
|
|
|
(define %zebra
|
|
(%rel (Owns HS)
|
|
[(Owns HS)
|
|
(%is HS (list (list (_) 'norwegian (_) (_) (_))
|
|
(_)
|
|
(list (_) (_) (_) 'milk (_))
|
|
(_) (_)))
|
|
(%select (list (list 'red 'englishman (_) (_) (_))
|
|
(list (_) 'swede 'dog (_) (_))
|
|
(list (_) 'dane (_) 'tea (_))
|
|
(list (_) 'german (_) (_) 'prince))
|
|
HS)
|
|
(%select (list (list (_) (_) 'birds (_) 'pallmall)
|
|
(list 'yellow (_) (_) (_) 'dunhill)
|
|
(list (_) (_) (_) 'beer 'bluemaster))
|
|
HS)
|
|
(%left-of (list 'green (_) (_) 'coffee (_))
|
|
(list 'white (_) (_) (_) (_))
|
|
HS)
|
|
(%next-to (list (_) (_) (_) (_) 'dunhill)
|
|
(list (_) (_) 'horse (_) (_))
|
|
HS)
|
|
(%next-to (list (_) (_) (_) (_) 'blend)
|
|
(list (_) (_) 'cats (_) (_))
|
|
HS)
|
|
(%next-to (list (_) (_) (_) (_) 'blend)
|
|
(list (_) (_) (_) 'water (_))
|
|
HS)
|
|
(%next-to (list (_) 'norwegian (_) (_) (_))
|
|
(list 'blue (_) (_) (_) (_))
|
|
HS)
|
|
(%member (list (_) Owns 'zebra (_) (_)) HS)]))
|
|
|
|
(%which (Who HS) (%zebra Who HS))
|