FFIにCの構造体サポートを追加しました

例えばFFIでlinuxのgetrusageを呼び出すライブラリはこんな感じになります。

Ypsilon 0.9.6-trunk/r327 Copyright (c) 2008 Y.Fujita, LittleWing Company Limited.
> (library (linux getrusage)
    (export print-rusage)
    (import (rnrs) (ffi) (srfi :28))

    ;; 次の定義はlinuxのバージョンに依存する可能性があります
    ;; longはUbuntu 8.10-i686の/usr/include/bits/typesizes.hで調べたものです
    ;; こういった定義は./configureで自動生成するようにしたいですね ;)
    (define-c-typedef time_t long)　    
    (define-c-typedef suseconds_t long)

    ;; timevalの定義はCのstruct { ... }を機械的に書き換えたものです
    ;; (/usr/include/sys/time.h)
    (define-c-struct-type timeval
      (time_t tv_sec)
      (suseconds_t tv_usec))

    ;; rusageの定義はCのstruct { ... }を機械的に書き換えたものです
    ;; (/usr/include/sys/resource.h)
    (define-c-struct-type rusage
      (timeval ru_utime)
      (timeval ru_stime)
      (long ru_maxrss)
      (long ru_ixrss)
      (long ru_idrss)
      (long ru_isrss)
      (long ru_minflt)
      (long ru_majflt)
      (long ru_nswap)
      (long ru_inblock)
      (long ru_oublock)
      (long ru_msgsnd)
      (long ru_msgrcv)
      (long ru_nsignals)
      (long ru_nvcsw)
      (long ru_nivcsw))

    ;; FFIを準備します
    ;; Cの構造体のアドレスが入る引数にはbyte*を書きます
    ;; これはCの構造体がbytevectorに格納されるようになっているからです
    (define libc-name "libc.so.6")
    (define libc (load-shared-object libc-name))
    (define libc-getrusage (c-function libc libc-name int getrusage (int byte*)))

    ;; フィールドはR6RSのレコードと同じ書式でアクセスします
    ;; ただしメソッドは手続きではなくマクロとして定義されることに注意してください
    (define print-rusage
      (lambda ()
        (let ((ru (make-rusage)))
          (libc-getrusage 0 ru)
          (format #t
                  "; ru_time ~a:~a, ru_stime ~a:~a, ru_nvcsw ~a, ru_nivcsw ~a ~%"
                  (timeval-tv_sec  (rusage-ru_utime ru))
                  (timeval-tv_usec (rusage-ru_utime ru))
                  (timeval-tv_sec  (rusage-ru_stime ru))
                  (timeval-tv_usec (rusage-ru_stime ru))
                  (rusage-ru_nvcsw ru)
                  (rusage-ru_nivcsw ru)))))
    ) ;[end]

> (import (linux getrusage))
> (print-rusage)
; ru_time 0:60003, ru_stime 0:12000, ru_nvcsw 295, ru_nivcsw 44 
> (import (apropos) (match) (socket) (concurrent) (pregexp)) ; *負荷を少し
> (print-rusage)
; ru_time 0:64004, ru_stime 0:12000, ru_nvcsw 1313, ru_nivcsw 44

上のプログラムはタイプの定義部分を別ライブラリに分離して次のように書くこともできます。

;;; time_t suseconds timevalの定義

> (library (linux header sys time)
    (export time_t suseconds_t timeval)
    (import (rnrs) (ffi))

    ;; これはそのまま
    (define-c-typedef time_t long)
    (define-c-typedef suseconds_t long)

    ;; タイプだけを集めるライブラリではメソッドの展開を行わないdefine-c-typedef
    ;; を使ってstructを定義します(define-c-struct-typeを使うことも可能)
    (define-c-typedef timeval
      (struct (time_t tv_sec)
              (suseconds_t tv_usec)))

    ) ;[end]

;;; rusageの定義

> (library (linux header sys resource)
    (export rusage)
    (import (linux header sys time) (rnrs) (ffi))

    ;; ここでは(linux header sys time)からimportしたtimeval
    ;; を使ってrusageを定義しています
    (define-c-typedef rusage
      (struct (timeval ru_utime)
              (timeval ru_stime)
              (long ru_maxrss)
              (long ru_ixrss)
              (long ru_idrss)
              (long ru_isrss)
              (long ru_minflt)
              (long ru_majflt)
              (long ru_nswap)
              (long ru_inblock)
              (long ru_oublock)
              (long ru_msgsnd)
              (long ru_msgrcv)
              (long ru_nsignals)
              (long ru_nvcsw)
              (long ru_nivcsw)))

    ) ;[end]

;;; 本体

> (library (linux getrusage)
    (export print-rusage)
    (import (linux header sys time)
            (linux header sys resource)
            (rnrs) (ffi) (srfi :28))

    (define libc-name "libc.so.6")
    (define libc-hdl (load-shared-object libc-name))
    (define libc-getrusage (c-function libc-hdl libc-name int getrusage (int byte*)))

    (define print-rusage
      (lambda ()

        ;; ここでdefine-c-struct-methodsを使ってtimeval-tv_secなどのメソッドを展開します
        ;; メソッドはすべてマクロなのでここで展開しても実行時のオーバヘッドになりません
        ;; また展開されたメソッドはprint-rusageのコンパイルが終わればGCされます
        (define-c-struct-methods rusage timeval)

        (let ((ru (make-rusage)))
          (libc-getrusage 0 ru)
          (format #t
                  "; ru_time ~a:~a, ru_stime ~a:~a, ru_nvcsw ~a, ru_nivcsw ~a ~%"
                  (timeval-tv_sec  (rusage-ru_utime ru))
                  (timeval-tv_usec (rusage-ru_utime ru))
                  (timeval-tv_sec  (rusage-ru_stime ru))
                  (timeval-tv_usec (rusage-ru_stime ru))
                  (rusage-ru_nvcsw ru)
                  (rusage-ru_nivcsw ru)))))
    ) ;[end]

この形式は型を定義するライブラリからメソッドを一つもexportする必要がないという特徴があります。これで気楽に型定義をいっぱい集めたライブラリをつくることができるようになりました :^)