L.i.S.P 写経(番外)、3章

前回、バックトレース用に、こんな関数を示したのだけれども。この章のコードに対しては、いかにも違和感がある気がしますので、ジェネリック関数を使った版も書いてみました。

(define (%backtrace k)
  (for-each
   (let1 level 0
     (lambda (k)
       (with-input-from-string (with-output-to-string (cut gosh:d k))
         (lambda ()
           (let loop ((line (read-line)))
             (unless (eof-object? line)
               (dotimes (level) (display " "))
               (print (if (> (string-length line) #0=(- 66 level))
                        (string-take line #0#)
                        line))
               (loop (read-line))))))
       (update! level (pa$ + 2))))
   (let recur ((k k)
               (c values))
     (if (is-a? k <bottom-cont>)
       (cons k (c '()))
       (recur (~ k 'k) (lambda (r) (cons k (c r))))))))

我ながらパーっと書いた感が拭えません。特に、せっかくオブジェクト指向に書いているのにもかかわらず、陽にループしながら (is-a? k <bottom-cont>) のところがイケていない気がします。

というわけで以下。

(define-method trace-print ((k <continuation>) level)
  (with-input-from-string (with-output-to-string (cut gosh:d k))
    (lambda ()
      (let loop ((line (read-line)))
        (unless (eof-object? line)
          (dotimes (level) (display " "))
          (print (if (> (string-length line) #0=(- 66 level))
                   (string-take line #0#)
                   line))
          (loop (read-line)))))))

(define-constant +indent+ 2)

(define-method trace ((k <continuation>) cont)
  (trace (~ k 'k)
         (lambda (n)
           (trace-print k n)
           (cont (+ n +indent+)))))

(define-method trace ((k <bottom-cont>) cont)
  (trace-print k 0)
  (cont +indent+)
  #t)

(define (backtrace k) (trace k values))

ただし、これでも trace メソッドの中身をもう一つどうにかできるのではないかという気もします。