Emacs - Scheme 間通信 ~ S 式オブジェクト記法による ~

最近 MP3 のタグを読むプログラムが必要になり、elisp で書こうとしました。が、バイナリ・データの扱いが無理っぽい気がしたので、Scheme で書くことにしました。

一応それは上手くいったんですが、アプリケーション自体は emacs 上に作りたかったため、Scheme プログラムと elisp を橋渡しする仕組みが新たに必要となりました。

たくさんの MP3 ファイルを扱うことを想定しているため、プログラムをサブプロセスとして常駐させる、とか、Scheme シェルに elisp で関数を打ち込む、といったことも考えたんですが、考慮の末、スレッドを使う方法を選びました。

まず、Scheme プログラム側を TCP サーバーとして実装し直します。そして、Scheme シェル (emacs の inferior-scheme または run-scheme モード) 上でスレッドとして走らせることで、今後色んなサービスを作っても全て一つのプロセスでまかなえることになるわけです。また TCP サーバーとすることで、複数のクライアントから利用出来ることにもなります。

ということで、Scheme サービスを立ち上げてから利用可能になるまでの手続きをカプセル化する elisp プログラムを考えてみました。

scheme-service.el:

(require 'cmuscheme)

(defun scheme-service (psym file host port &optional receiver)
  (scheme-service-load file)
  (scheme-service-connect psym host port receiver))

(defun scheme-service-load (file)
  (and file
       (comint-send-string (scheme-proc)
                           ;; XXX: Assuming PLT
                           (concat "(require (file \""
                                   (expand-file-name file)
                                   "\"))\n"))))

(defun scheme-service-filter (proc receiver)
  (set-process-filter proc
   `(lambda (proc str)
      (funcall ',receiver (car (read-from-string str))))))

(defun scheme-service-proc (psym)
  (and (boundp psym)
       (symbol-value psym)))

(defun scheme-service-ready? (proc)
  (and proc
       (memq (process-status proc) '(run open))))

(defun scheme-service-connect (psym host port receiver)
  (let ((proc (scheme-service-proc psym)))
    (if (scheme-service-ready? proc)
        (scheme-service-start receiver proc)
      (condition-case nil
          (progn
            (setq proc (open-network-stream
                        (symbol-name psym)
                        (concat "*" (symbol-name psym) "*")
                        host port))
            ;; Now client will be able to access the process with `,psym
            (set psym proc)
            (scheme-service-start receiver proc))
        ((error file-error)
         (run-with-timer 2 nil 'scheme-service-connect
                         psym host port receiver))))
    proc))

(defun scheme-service-start (receiver proc)
  (and receiver
       (scheme-service-ready? proc)
       (funcall receiver proc)))

(defun scheme-service-end (proc)
  (let ((buffer (process-buffer proc)))
    (and buffer
         (kill-buffer buffer))))

(provide 'scheme-service)

クライアント側からの呼び出しはこのようになります:

(require 'scheme-service)
(scheme-service 'a-scheme-service
                "/path/to/a-service.ss"
                "localhost" 777
                (lambda (proc)
                  ;; (eq proc a-scheme-service); => t
                  (start application)))

関数 scheme-service の引数は順に、

  • プロセスを表す変数名 (シンボルとして)
  • Scheme モジュールのファイル名
  • ホスト名
  • ポート番号
  • コールバック関数

となっています。

Scheme シェルがまだ起動していない場合はゼロからのスタートになりますので、それなりに時間がかかります。そのため、コールバック関数を介してアプリケーションを開始する仕組みになっています。

コールバックが呼ばれた時点で、第一引数がプロセスを表すグローバル変数として利用可能になります。一応コールバック関数にも同じプロセス・オブジェクトが渡されますが、無視しても構いません。

なお、既に起動中のサービス (遠隔サーバーなど) に接続する場合はファイルを nil にしておきます (その際、相手が Scheme である必要は全く無いことにご留意ください)。


具体例として、送信したメッセージを逆さまにして返す reversed echo サーバーを作ってみます。

サーバー (recho.ss):

(module recho mzscheme
  (define port 777)

  (define (server)
    (let ((listener (tcp-listen port)))
      (let-values (((in out) (tcp-accept listener)))
        (let loop ()
          (let ((mes (read-line in)))
            (cond ((or (eof-object? mes) (string-ci=? mes "bye"))
                   (close-input-port in)
                   (close-output-port out))
                  (else
                   (fprintf out "\"~a\"" (list->string
                                          (reverse!
                                           (string->list mes))))
                   (flush-output out)
                   (loop))))))))
  (thread server))

MzScheme (PLT Scheme) を使用しています。サーバーを複数起動してしまうのを防ぐため、モジュールとして定義してあります。"(thread server)" により、require した時点でサーバーが立ち上がる仕組みです。


クライアント (recho.el):

(require 'scheme-service)

(defvar recho-host "localhost")
(defvar recho-port 777)
(defvar recho-service "/path/to/recho.ss")
(defvar recho-process nil)

(defun recho (mes)
  (interactive "sSend message: ")
  (process-send-string recho-process (concat mes "\n")))

(defun recho-start ()
  (interactive)
  (scheme-service 'recho-process
                  recho-service
                  recho-host recho-port
                  'recho-init))

(defun recho-init (proc)
  (scheme-service-filter proc
   (lambda (spon)
     (message spon)))
  (message "RECHO server started!"))

(defun recho-end ()
  (interactive)
  (process-send-string recho-process "bye\n")
  (scheme-service-end recho-process))

M-x recho-start でサービスが起動します。

コールバックの中で scheme-service-filter というヘルパー関数を使用していますが、これはオプションです。JavaScriptJSON データを受け取るのと似た要領で Lisp オブジェクトを受け取るためのもので (文字列の評価には eval ではなく read-from-string を使うのがポイントです)、サーバーが S 式を返却するように設計した場合に利用できます。

ただ、これには未解決の問題がありまして、必ず一度に一つの S 式が返って来ると保証出来るかどうかが分からないんですよね。

バッファリングの関係で複数まとめて送られてきたり (これはサーバー側で出力毎にフラッシュすることで防げると思いますが)、逆に大きいデータの場合分割されてしまったり、ということが生じないかどうか、調べる必要があると思います。


追記:
scheme-service.el に関して、

  • scheme-service-filter がラムダ式でなく関数名を受け取った場合にエラーを生じる問題
  • 稼動中のサービスに接続した場合にコールバックが二度呼ばれる可能性がある問題

を修正しました。