added guile-log version of einstein

parent 6d622b14
(define-module (logic guile-log examples einstein)
#:use-module (logic guile-log)
#:use-module (logic guile-log umatch)
#:use-module (ice-9 pretty-print)
#:export (run))
;(use-modules (language prolog kanren))
(<define> (memb x l)
(<match> () (l)
((,x . _) <cc>)
((_ . l) (memb x l))
(_ <fail>)))
(<define> (on-right i j l)
(<match> () (l)
((,i ,j . _) <cc>)
((_) <fail>)
((_ . l) (on-right i j l))
(_ <fail>)))
(<define> (next-to item1 item2 rest)
(<or> (on-right item1 item2 rest)
(on-right item2 item1 rest)))
(define-syntax __
(lambda (x)
(syntax-case x ()
((x . l) #'((gp-var!) . l))
(_ #'(gp-var!)))))
(<define> (einstein h)
(<and>
(<=> h ,`((norwegian ,__ ,__ ,__ ,__) ,__ (,__ ,__ ,__ milk ,__) ,__ ,__))
(memb `(brit ,__ ,__ ,__ red) h)
(memb `(swede dog ,__ ,__ ,__ ) h)
(memb `(dane ,__ ,__ tea ,__ ) h)
(on-right `(,__ ,__ ,__ ,__ green) `(,__ ,__ ,__ ,__ white) h)
(memb `(,__ ,__ ,__ cofee green) h)
(memb `(,__ bird pallmall ,__ ,__) h)
(memb `(,__ ,__ dunhill ,__ yellow) h)
(next-to `(,__ ,__ dunhill ,__ ,__) `(,__ horse ,__ ,__ ,__) h)
(memb `(,__ ,__ ,__ milk ,__) h)
(next-to `(,__ ,__ marlboro ,__ ,__) `(,__ cat ,__ ,__ ,__) h)
(next-to `(,__ ,__ marlboro ,__ ,__) `(,__ ,__ ,__ water ,__) h)
(memb `(,__ ,__ winfield beer ,__) h)
(memb `(german ,__ rothmans ,__ ,__) h)
(next-to `(norwegian ,__ ,__ ,__ ,__) `(,__ ,__ ,__ ,__ blue) h)
(memb `(,__ fish ,__ ,__ ,__) h)
))
(define (run N)
(let loop ((n N))
(cond
((zero? n) 'done)
(else (pretty-print (<run> 1 (h) (einstein h)))
(loop (- n 1))))))
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment