未束縛エクスポートのチェック

R6RS及びR7RSではexport句に未束縛なシンボルを書くとエラーになるとある。しかし、Sagittariusでは実装上の手抜きでチェックをしていない(やれば実はできるんだけど、コンパイル時間の増大を防ぎたいとか、メモリ使用率を減らしたいとか、まぁいろいろ言い訳をつけてやってない)。

っで、近頃（昨日）R7RSのドラフト7が出て、結構な数の手続きが追加または削除になったのがあり、実際に手続き及びマクロが定義されているかのチェックを目視とかテストケース書いてたらやってられないなぁと思ったのでこんなスクリプトを書いた。

(import (rnrs) (util file)
        (sagittarius vm) (match)
        (srfi :26) (srfi :64))
;; この部分を適当に変える。
;; R7RSだけ調べたいなら"./sitelib/scheme/*"とか
(define files (glob "./lib/**/*"))

(test-begin "bound check")
(define (check-exports file)
  (define (do-check name exports)
    (guard (e (#t 
               (when (message-condition? e)
                 (print (condition-message e)))
               (print "failed to find library: " name)))
      (let ((lib (find-library name #f)))
        (define (check orig export)
          (unless (keyword? export)
            (test-assert (format "~a:~a" name orig)
                         (let ((gloc (find-binding lib export #f)))
                           (and gloc (gloc-bound? gloc))))))
        (for-each
         (lambda (export)
           (match export
             (('rename renames ...)
              (for-each (lambda (rename)
                          (check rename (car rename))) renames))
             (_ (check export export))))
         exports))))
  (guard (e (#t (print "failed to read: " file)))
    (when (file-regular? file)
      (let ((expr (file->sexp-list file)))
        (match expr
          ((('library name ('export exports ...) rest ...))
           (do-check name exports))
          (_ #f)))
      )))
  

(for-each (cut check-exports <>) files)

(test-end)

やっていることは至極単純で、見つけたファイルを読み取って、中からlibraryで始まるS式見つけて、ライブラリ見つけて、exportしているものが存在するか調べる。それだけ。
なぜか、||なシンボルを読まなかったり、キーワードをキーワードとして読み取らなかったりと、変な挙動があるけど、それなりに便利。 既存のライブラリで未束縛なエクスポートを含んでいたのものさえ発見できたし・・・orz