Chez Scheme で Foreign Interface を使ってみた

しばらく前に Chez Scheme がオープンソース化された。

Chez Scheme のインタプリタ版である Petite Chez Scheme はソースコードこそ公開されていなかったものの、以前から無料 (オープンソースではない) で利用できていたが、 Chez Scheme は Petite Chez Scheme よりもかなり高速なようだ。

しかし、私にとっては、速度はあまり重要ではない。というより、 Petite Chez Scheme で充分すぎる速さだというべきか。時間がかかる処理をすることがあまりないので劇的に体感する機会がないのだ。たとえば二分かかる処理が一分になるなら大きな違いだが、二秒の処理が一秒になったからといってそれほどでもない。 (私の関心の外であるというだけで、技術的な高度さはまた別である。)

それよりも私が関心を持ったのは Foreign Interface だ。

http://www.scheme.com/csug8/foreign.html

基本的には Petite Chez Scheme と Chez Scheme とはほぼ互換性があるのだが、 Petite Chez Scheme で利用できなかった Foreign Interface が Chez Scheme では使える。 Foreign Interface は共有オブジェクト (Windows では DLL) の機能を呼び出すもので、 Scheme の外の世界への窓口となる。処理系が用意しているものでどうしても機能が足りないときには C で書いて Foreign Interface で繋いでしまえば何でも出来る。 Foreign Interface があれば出来ることが一気に増えるわけだ。

そこで私は試しに HTTP 接続をやってみた。 Windows で Wininet を利用するものである。

(import (chezscheme))

(load-shared-object "Wininet.dll")

(define-ftype handle void*)

(define internet-open
  (foreign-procedure __stdcall "InternetOpenW"
                     (wstring unsigned-32 wstring wstring unsigned-32)
                     handle))

(define internet-open-url
  (foreign-procedure __stdcall "InternetOpenUrlW"
                     (handle wstring wstring unsigned-32 unsigned-32 handle)
                     handle))

(define INTERNET_OPEN_TYPE_DIRECT 1)
(define INTERNET_FLAG_RELOAD #x80000000)

(define internet-read-file
  (foreign-procedure __stdcall "InternetReadFile" (handle u8* unsigned-32 u32*)
                     boolean))

(define internet-close-handle
  (foreign-procedure __stdcall "InternetCloseHandle" (handle) boolean))

(define (http-get url bport)
  (let* ((hinternet
          (internet-open "sample" INTERNET_OPEN_TYPE_DIRECT #f #f 0))
         (hfile
          (internet-open-url hinternet url #f 0 INTERNET_FLAG_RELOAD 0)))
    (let ((vec (make-bytevector 1024))
          (vsize (make-bytevector 4)))
      (let loop ((r (internet-read-file hfile vec 1024 vsize)))
        (let ((s (bytevector-u32-ref vsize 0 (endianness little))))
          (unless (zero? s)
            (put-bytevector bport vec 0 s)
            (loop (internet-read-file hfile vec 1024 vsize)))))
      (flush-output-port bport))
    (internet-close-handle hfile)
    (internet-close-handle hinternet)
    (if #f #f)))

(display
 (utf8->string
  (call-with-bytevector-output-port
    (lambda(out)
      (http-get "http://example.com/" out)))))

Foreign Interface を使うときは些細な間違いで簡単にクラッシュするので、汎用的なライブラリを作るときは引数のチェックを厳しくした方が良いと思う。

Document ID: 4469def7a696bf182842bea7e01d5154