修正した。

S (式1) (式2) が S (式1') (式2') (式3) になることはありえない気がする。気がするだけなのが弱い。

結局、((式1) (式2) (式3)) みたいなの((式1)を簡約するとSになるようなやつ)には対応せず。つーか

(else (map expand-combinator-one seq))

を

(else (expand-combinator-one (map expand-combinator-one seq)))

にするだけで行けるやん？とか考えてたけど、 (K I) のような入力で無限ループになるだけだった。S / Kの評価で作りこめばいいのだろうけど、面倒だからあとでやるかも。toSKメソッドでバラしたものが出来るからとりあえずいーや。

SICPの4章のEval-Apply 相互再帰に似てきた気がする。
インタプリタみたいなのを作る上での黄金パターンなのかもしらん。

(define (apply-S p1 p2 p3 rest)
  (if (not (pair? p1))
        `(,p1 ,p3 ,(if (not (pair? p2)) `(,p2 ,p3) `(,@p2 ,p3)) ,@rest)
        `(,@p1 ,p3 ,(if (not (pair? p2)) `(,p2 ,p3) `(,@p2 ,p3)) ,@rest)))
 
(define (apply-K p1 p2 rest)
  (if (not (pair? p1))
          `(,p1 ,@rest)
          `(,@p1 ,@rest)))
 
(define (is-S-reduction? seq)
        (and (eq? (car seq) 'S) (not (null? (cdr seq))) (not (null? (cddr seq))) (not (null? (cdddr seq)))))
(define (is-K-reduction? seq)
        (and (eq? (car seq) 'K) (not (null? (cdr seq))) (not (null? (cddr seq)))))
 
(define beta-red-itr
  (lambda (seq)
    ;;(begin (display "---   ") (display seq) (newline)
        (cond
          ((not (pair? seq)) seq)
          ((and (not (pair? (car seq))) (null? (cdr seq))) (car seq))
          ((is-S-reduction? seq)
                (let ((p1 (cadr seq))
                          (p2 (caddr seq))
                          (p3 (cadddr seq))
                          (rest (cddddr seq)))
                        (beta-red-itr (apply-S (beta-red-itr p1)
                                         (beta-red-itr p2)
                                         (beta-red-itr p3)
                                         rest))))
          ((is-K-reduction? seq)
                (let ((p1 (cadr seq))
                          (p2 (caddr seq))
                          (rest (cdddr seq)))
                  (beta-red-itr (apply-K (beta-red-itr p1) p2 rest))))
          ((eq? (car seq) 'I)
                (beta-red-itr (cdr seq)))
          ((and (null? (cdr seq)) (symbol? (car seq))) (car seq))
          (else
                (map beta-red-itr seq)))))
    ;;)
(define (beta-reduction l)
  (let ((result (beta-red-itr l)))
        (if (and (pair? result) (null? (cdr result))) (car result) result)))