arc → gauche メモ
「どうせ MzScheme なんだから Gauche への移植くらい簡単じゃね?」とは、たぶんすぐ思いつくことなんですが、やってみたら意外と大変ですね、というのが結論ぽい感じですね。
arc は MzScheme の上に乗ってるわけで、 Gauche に移行するには arc が使っている MzScheme の機能を移植、もしくは代替する機能に割り当てなければならない。で、そういう「MzSchemeの機能」なんて大して気にしていませんでしたが、一部のものは移植が大変であると。たとえばモジュールや名前空間は頑張ればそれほど大変じゃなさそうですし、セマフォも mutex と condition variable を組み合わせれば実装はできそうです。でも current-gc-milliseconds とかは Gauche レベルではちょっと実装できそうにないし、 Gauche の gc は Boehm を使ってるから Gauche を改造すればできるかどうかも怪しい。あと thread 関係は意味論が微妙に違うものがあり、 break-thread とか thread-dead? とかは Gauche でどう実装したものか、なんて問題もあるのかも。
というわけで飽きてしまった。だめだな。まあ arc にはそこまでして移植したいという気が起きないといったところか。
ところで、「ac.scm で使われていて Gauche で定義されていないシンボル」を取り出すというスクリプトを書いてみようと思ったらこれが意外と手間だった。とりあえず切り出したのは、
(ac-macex all-defined arc< arc> args break-thread call-with-semaphore char current-gc-milliseconds current-milliseconds current-process-milliseconds current-seconds delete-file directory-exists? directory-list else exn-message exn:fail? exn? flush-output fn hash-table-count hash-table-remove! int kill-thread lib make-limited-input-port make-semaphore make-thread-cell module mzscheme namespace-set-variable-value! namespace-variable-value once parameterize path->string pretty-print print-hash-table random sleep sym system tcp-accept tcp-addresses tcp-close tcp-listen tcp-listener? thread thread-cell-ref thread-cell-set! thread-dead? type vals with-handlers)
といったところ。まだノイズがあるのでイマイチですが、おおむねこんな感じなのかな。なお切り出しに使ったスクリプトは下記の通り。
(use srfi-1)
(use util.match)
(define (search-symbol sym)
(define m (find-module 'gauche))
(global-variable-bound? m sym))
(define (check-symbols-in-file filename)
(define symbol-set (make-hash-table))
(define defined-set (make-hash-table))
(define (symbol-defined? tables sym)
(any (cut hash-table-exists? <> sym) tables))
(define (symbols-resolv tables obj)
(match obj
(('quote x) #t)
(('define (var args ...) body ...)
(if (hash-table-exists? symbol-set var)
(hash-table-delete! symbol-set var))
(hash-table-put! (car tables) var #t)
(let1 new-set (make-hash-table)
(for-each (cut hash-table-put! new-set <> #t) args)
(symbols-resolv (cons new-set tables) body)))
(('define var body ...)
(if (hash-table-exists? symbol-set var)
(hash-table-delete! symbol-set var))
(hash-table-put! (car tables) var #t)
(let1 new-set (make-hash-table)
(symbols-resolv (cons new-set tables) body)))
(('let ((vs . ds) ...) body ...)
(symbols-resolv tables ds)
(let1 new-set (make-hash-table)
(for-each (cut hash-table-put! new-set <> #t) vs)
(symbols-resolv (cons new-set tables) body)))
(('let* (vars ...) body ...)
(let1 new-set (make-hash-table)
(for-each (lambda (def)
(cond ((pair? def)
(symbols-resolv (cons new-set tables)
(cdr def))
(hash-table-put! new-set (car def) #t))))
vars)
(symbols-resolv (cons new-set tables) body)))
(('let-values ((vs . ds) ...) body ...)
(symbols-resolv tables ds)
(let1 new-set (make-hash-table)
(for-each (cut for-each
(cut hash-table-put! new-set <> #t) <>) vs)
(symbols-resolv (cons new-set tables) body)))
(('lambda args body ...)
(let1 new-set (make-hash-table)
(if (list? args)
(for-each (cut hash-table-put! new-set <> #t) args)
(hash-table-put! new-set args #t))
(symbols-resolv (cons new-set tables) body)))
((body bodies ...)
(symbols-resolv tables body)
(symbols-resolv tables bodies))
((? symbol? sym)
(if (not (symbol-defined? tables sym))
(hash-table-put! symbol-set sym #t)))
(_ #t)))
(define (read-and-scan p)
(let1 obj (read p)
(cond ((eof-object? obj) symbol-set)
(else (symbols-resolv (list defined-set symbol-set) obj)
(read-and-scan p)))))
(call-with-input-file filename read-and-scan)
(filter (lambda (s) (not (search-symbol s)))
(hash-table-keys symbol-set)))