いろいろ間違ってた。

先日のschemeのプログラムは色々間違ってた。

x消去で、xを含まない合成手続きXを K X と処理すべきが、
S (K Y) (K Z) になってた。コンビネータとしては冗長だけど、間違ってはいない。といいわけしておく。

ついでにutil.matchを使って書き直してみた。(中途半端ではあるが)
かなりすっきり。

(toSK '(x y) '(y x)) => (S (K (S I)) K)

(use util.match)
(define combinator-split (match-lambda
                                [(? symbol? a) (values a '())]
                                [(a) (values a '())]
                                [(a b) (values a b)]
                                [(a b c) (values (list a b) c)]
                                [(a b c . rest) (receive (new-a new-b) (combinator-split
                                                                          (cons b (cons c rest)))
                                                  (values (cons a new-a) new-b))]))

(define (find_var v l)
  (if (eq? v l) #t
      (find (lambda (m)
              (cond ((not (pair? m)) (eq? m v))
                    ((null? m) #f)
                    (else (find_var v m)))) l)))

(define (only? v X) (or (eq? v X) (and (pair? X) (null? (cdr X)) (symbol? (car X)) (eq? v (car X)))))

(define (var_delete v X)
  (receive (Y Z) (combinator-split X)
        (cond
                ((null? Z)
                        (cond ((only? v Y) 'I)
                                  (else `(K ,Y))))
                ((and (only? v Z) (not (find_var v Y))) Y)
                ((and (not (find_var v Y)) (not (find_var v Z))) `(K ,X))
                 (else `(S ,(var_delete v Y) ,(var_delete v Z))))))

(define (toSK vars body)
  (define (toSK-iter r-vs l)
    (if (null? r-vs) l
        (toSK-iter (cdr r-vs) (var_delete (car r-vs) l))))
  (toSK-iter (reverse vars) body))

まあでも
(toSK '(x y) '((y x)))
みたいな入力だと相変わらずバグるんだが。

不要な括弧をリストから除くユーティリティがあればいいのか？

((x y z)) ;;-> (x y z)
((x) (y) (z)) ;;-> (x y z)
(x ((y y))) ;;-> (x (y y))
((x y) z) ;;-> (x y z) ;; これはやらなくてもいい

みたいな。

どうすればいいのかは思い付かない。