Scheme で append 手続きを再実装（完成）

手続き list-append がようやく完成した。

(define list-append
  (lambda (a . b)
    (define add (lambda (x y) (reverse (cons y (reverse x)))))
    (define end (lambda (x y)
        (if (null? x)
          y
          (end (reverse (cdr (reverse x))) (cons (car (reverse x)) y)))))
    (let loop ((a a) (b b))
      (cond
        ((null? b) a)
        ((null? a) (loop (car b) (cdr b)))
        ((not (pair? b)) (end (reverse (cdr (reverse a))) (cons (car (reverse a)) b)))
        ((null? (car b)) (loop a (cdr b)))
        ((pair? (car b))
          (cond
            ((null? (car b)) (loop a (cdr b)))
            ((list? (car b))
              (loop (add a (caar b)) (cons (cdar b) (cdr b))))
            (else (loop (add a (caar b)) (cdar b)))))
        ((not (pair? (car b))) (end (reverse (cdr (reverse a))) (cons (car (reverse a)) (car b))))
        (else 'oops!)))))

(define append
  (lambda (a . b)
    (let loop ((a a) (x b))
      (cond
        ((list? a)
          (cond
            ((null? x) a)
            (else (loop (list-append a (car x)) (cdr x)))))
        ((string? a)
          (cond
            ((null? x) a)
            (else (loop (string-append a (car x)) (cdr x)))))
        (else a)))))

以下はテスト。

(equal? (append '()) '())
(equal? (append '() '() '()) '())
(equal? (append '(x)) '(x))
(equal? (append '(a b)) '(a b))
(equal? (append '(a b) '()) '(a b))
(equal? (append '(a b) '() '()) '(a b))
(equal? (append '() '(a b) '()) '(a b))
(equal? (append '(a) '(b)) '(a b))
(equal? (append '(a) '(b) '()) '(a b))
(equal? (append '() '(a) '()) '(a))
(equal? (append '() '(a b) '()) '(a b))
(equal? (append '(a b) '(c d)) '(a b c d))
(equal? (append '(a b) '(c d) '()) '(a b c d))
(equal? (append '(x y) '(z)) '(x y z))
(equal? (append '(a b) '(c d) '()) '(a b c d))
(equal? (append '(a) '(b c d)) '(a b c d))
(equal? (append '(a (b)) '((c))) '(a (b) (c)))
(equal? (append '(a b) '(c . d)) '(a b c . d))
(equal? (append '() 'a) 'a)
(equal? (append '(a b) 'c) '(a b . c))
(equal? (append '(a b) '(c) '(d e)) '(a b c d e))
(equal? (append '(a b) '() '(c d)) '(a b c d))
(equal? (append '() '() 'c) 'c)

たぶんライブラリ手続きの append と互換の動作になるはず。

最初の list-append のわずか 20 ステップの実装に、都合 10 時間ぐらいかかってしまった。

append 手続きに集約する部分も、せっかくの可変引数がうまく生かせおらず、ひとつずつ渡す形になってしまっている。

vector に関しても同様の手続きがあってもよい感じがするんだけど、なぜか R5RS では規定されていない。