Reasoned Schemer (60) disj, conj, defrel

Connecting the Wires

いちいち(let ... (map ... (call/fresh ... (disj2 ... (disj2 ...)))))などとは
書いていられないのでマクロ書くよ！という章

まずdisj2のいくつでもゴールを取れる版disj
実際にはcondeが使われるので補助的な位置

(define-syntax disj
  (syntax-rules ()
    ((disj) fail)
    ((disj g) g)
    ((disj g0 g ...) (disj2 g0 (disj g ...)))))

(disj)という形だったらfail、
(disj g)という形だったらgに書き替え
orみたいなものだから感覚に合う
(disj g0 g ...)という形だったらdisj2を使って書き替える

  (disj g0 g1 g2)
= (disj2 g0 (disj g1 g2))
= (disj2 g0 (disj2 g1 (disj g2)))
= (disj2 g0 (disj2 g1 g2))

ってなるわけか
ok

> ((disj) empty-s)
()
> ((disj succeed) empty-s)
(())
> ((disj fail) empty-s)
()
> ((disj fail succeed) empty-s)
(())
> ((disj fail fail) empty-s)
()
> ((disj fail fail succeed) empty-s)
(())

大丈夫そう

conjはほぼ同じ

> ((conj) empty-s)
(())
> ((conj fail) empty-s)
()
> ((conj succeed) empty-s)
(())
> ((conj succeed fail) empty-s)
()
> ((conj succeed succeed) empty-s)
(())
> ((conj succeed succeed fail) empty-s)
()

defrelはたんに置き換え

(define-syntax defrel
  (syntax-rules ()
    ((defrel (name x ...) g ...)
     (define (name x ...)
       (lambda (s)
         (lambda () ((conj g ...) s)))))))

defrel内の式はconjでつないでいる
teacupoを定義して

  (defrel (teacupo t) (disj2 (== 'tea t) (== 'cup t)))
= (define (teacupo t)
    (lambda (s)
      (lambda () ((conj (disj2 (== 'tea t) (== 'cup t))) s))))

実行

> (run-goal #f (teacupo x))
(((#(x) . tea)) ((#(x) . cup)))

大丈夫