Chicken で transcript-on

先日は Gauche 上に transcript-on / transcript-off を実装した。

Gauche で transcript-on

プログラミング言語 Scheme の処理系として特に人気のあるもののひとつである CHICKEN ではどうだろうかと試してみたところ同じような要領で書けた。 .csirc に以下を書いておけば利用できるようになる。

(define (%transcript-off)
  (error "Transcript mode not yet."))

(define transcript-off %transcript-off)

(define (transcript-on filename)
  (unless (eq? transcript-off %transcript-off)
    (error "Already in transcript mode."))
  (let ((log-port (open-output-file filename))
        (org-printer ##sys#repl-print-hook)
        (org-reader ##sys#repl-read-hook)
        (org-prompter ##sys#read-prompt-hook))
    (set! ##sys#repl-print-hook
          (lambda(x port)
            (org-printer x port)
            (org-printer x log-port)))
    (set! ##sys#repl-read-hook
          (lambda()
            (let ((obj (read)))
              (display obj log-port)
              (newline log-port)
              obj)))
    (set! ##sys#read-prompt-hook
          (lambda()
            (org-prompter)
            (display ((repl-prompt)) log-port)))
    (set! transcript-off
          (lambda()
            (set! transcript-off %transcript-off)
            (set! ##sys#repl-read-hook org-reader)
            (set! ##sys#repl-print-hook org-printer)
            (set! ##sys#read-prompt-hook org-prompter)
            (close-output-port log-port)
            (if #f #t)))
    (if #f #t)))

ドキュメントを読まずに書いているのでこれが CHICKEN 的にまっとうな方法かどうかわからないし、将来のバージョンの CHICKEN でも使えるかわからないが、変数名に hook と付いているからにはフックに使っていいんだろうと安直に判断した。

Document ID: 9d9afc27c1a84423c4ed3f02739cdbbf