GaucheからdRuby経由でRubyライブラリを叩きまくるの巻

Gaucheはじめました。Scheme言語については前からどんなものかくらいは知っていたけど、ちょっと本格的に使いこなしたくなって取り組んでます。Gaucheは手軽な上に日本語ドキュメントもたくさんあって楽しいですね。でもやっぱりWindows環境だといまいち未サポートの機能が多いんだよなあ。Cygwinはあんまり好きじゃないのでMinGW版を使いたいのに。
そんなわけでGaucheからdRubyへ通信してしまえば、ひょっとして使い慣れたRubyのライブラリが全部利用できるのでは、というのが今回の発想のはじまり。

たぶんTCPでメソッド名と引数を送信しているんだろう、という予想の元にdRubyのソースを見てみる。ふむふむ、一番単純なパターンはそれでいけそう。とりあえずシリアライズをしてるMarshalモジュールをShemeで書き直せばよさげ。整数と文字列ぐらいが扱えればよしとしよう。Marshalでは整数が可変長整数に変換されるのか。面倒だけどなんとかなりそう。
あとはリモートメソッド呼び出し関数書けばおしまい。nil/メソッド名/引数の数/引数/nilの順で送信して成功フラグ/戻り値の順で受信するだけ。

できた。

(define-module druby-if
  (export druby-connect druby-call druby-close))
(select-module druby-if)

(use gauche.net)
(use gauche.uvector)
(use binary.pack)

(define-macro (integer->u32string n)
  `(pack "N" (list ,n) :to-string? #t))

(define-macro (druby-send-data sock str)
  `(socket-send ,sock
                (string-append
                 (integer->u32string (string-size ,str)) ,str)))

(define (fixnum->varnum n)
  (define (mk-list n l)
    (let ((byte (logand n #xFF))
          (rest (ash n -8)))
      (cond
       ((= rest  0) (append (append (list (+ 1   (length l))) l) (list byte)))
       ((= rest -1) (append (append (list (- 255 (length l))) l) (list byte)))
       (else (mk-list rest (append l (list byte)))))))
  (cond
   ((= n 0) (list #x00))
   ((and (> n 0) (< n 123)) (list (+ n 5)))
   ((and (> n -124) (< n 0)) (list (logand #xFF (- n 5))))
   (else (mk-list n ()))))

(define (varnum->fixnum v)
  (define (mk-num var ref num)
    (let* ((absref (abs ref))
           (byte (string-byte-ref var absref)))
      (if (< ref 0)
          (set! byte (- 0 (+ (logxor #xFF byte) 1))))
      (if (= absref 1)
          (+ (ash num 8) byte)
          (mk-num var (- absref 1) (+ (ash num 8) byte)))))
  (let ((b (car (unpack "c" :from-string v))))
    (cond
     ((= 0 b) 0)
     ((>= b 6) (- b 5))
     ((<= b -6) (+ b 5))
     (else (mk-num v b 0)))))

(define (varnum-size v)
  (let ((b (car (unpack "c" :from-string v))))
    (cond
     ((and (>= b 1) (<= b 5)) (+ 1 b))
     ((and (<= b -1) (>= b -5)) (abs (- 1 b)))
     (else 1))))

(define (marshal-dump-fixnum n)
  (u8vector->string
   (list->u8vector
    (append (list #x04 #x08 #x69) ; 'i'
            (fixnum->varnum n)))))

(define (marshal-dump-string s)
  (string-append
   (u8vector->string
    (list->u8vector
     (append (list #x04 #x08 #x22) ; '"'
             (fixnum->varnum (string-size s)))))
   s))

(define (marshal-dump-nil)
  (u8vector->string #u8(#x04 #x08 #x30))) ; '0'

(define (marshal-dump-boolean b)
  (if b
      (u8vector->string #u8(#x04 #x08 #x54))   ; 'T'
      (u8vector->string #u8(#x04 #x08 #x46)))) ; 'F'

(define (marshal-load s)
  (let* ((header (unpack "CCC" :from-string s))
         (type (caddr header)))
    (cond
     ((= type #x30) ())
     ((= type #x54) #t)
     ((= type #x46) #f)
     ((= type #x69) (varnum->fixnum (substring s 3 (string-size s))))
     ((= type #x22)
      (let* ((data (substring s 3 (string-size s)))
             (vnsize (varnum-size data))
             (size (varnum->fixnum data)))
        (substring data vnsize (+ 1 size))))
     (else ()))))


(define (druby-call sock func-name . args)
  (define (send-args l)
    (let ((arg (car l))
          (rest (cdr l)))
      (if (string? arg)
          (druby-send-data sock (marshal-dump-string arg))
          (druby-send-data sock (marshal-dump-fixnum arg)))
      (if (not (null? rest))
          (send-args rest))))
  (druby-send-data sock (marshal-dump-nil))
  (druby-send-data sock (marshal-dump-string func-name))
  (druby-send-data sock (marshal-dump-fixnum (length args)))
  (if (not (null? args))
      (send-args args))
  (druby-send-data sock (marshal-dump-nil))
  (let* ((succ-size (car (unpack "N" :from-string (socket-recv sock 4))))
         (succ (socket-recv sock succ-size))
         (result-size (car (unpack "N" :from-string (socket-recv sock 4))))
         (result (socket-recv sock result-size)))
    (marshal-load result)))

(define (druby-connect uri)
  (let ((l (string-split uri #/(:\/\/)|:/)))
    (make-client-socket
     'inet
     (cadr l)
     (string->number (caddr l)))))

(define (druby-close s) (socket-close s))

(provide "druby-if")


これでたとえば、先月作ったExcel操作HTAにつなげればGaucheからExcelを扱える。戻り値に実数は使えなくても文字列として受け取ればおっけー。

(add-load-path ".")
(use druby-if)

(let ((excel (druby-connect "druby://localhost:12345")))
  (druby-call excel "put" "A1" "100")
  (druby-call excel "put" "A2" "120")
  (druby-call excel "put" "A3" "150")
  (druby-call excel "put" "A4" "=\"\"&AVERAGE(A1:A3)")
  (print "\nAVERAGE = " (druby-call excel "get" "A4"))
  (druby-close excel))


で、結局これで何がやりたかったかというと、Ruby/SDLを使ってMinGWGaucheでもグラフィックを表示したかったのです。こんなやつこんなやつ。