ポートの反転

port-inverter.scm

; ポートの反転
(define-module port-inverter
  (use gauche.vport)
  (use gauche.generator)
  (use gauche.uvector)
  ;
  (use inverter)
  (export
    mtport-inverter
    ))
(select-module port-inverter)

; :key
;    queue-size  ..... スレッド同期につかうキューサイズ
;    buffer-size ..... データ転送バッファサイズ
; --->
;    [^ (produce consume) ... ]
;       produce .... 出力ポートを引数にもつ手続き(producer)
;       consume .... 入力ポートを引数にもつ手続き(consumer)
(define (mtport-inverter :key (queue-size 100) (buffer-size 8000) )
  (let1 inverter (mtgenerator-inverter :queue-size queue-size)
    (^[produce consume]
      (inverter
        (^[yield]
          (let1 outp (make <buffered-output-port> 
                           :buffer-size buffer-size
                           :flush (^ (u8v flag)
                                    (yield (u8vector-copy u8v))
                                    (uvector-length u8v) ) )
            (produce outp)
            (yield (eof-object))
            ))
        (^g
          (let1 vp (make <buffered-input-port> 
                         :buffer-size buffer-size
                         :fill (^(u8v-dst)
                                 (let1 u8v-src (g)
                                   (if (eof-object? u8v-src)
                                     0
                                     (let [(ndst (uvector-length u8v-dst))
                                           (nsrc (uvector-length u8v-src ))]
                                       (if (>= ndst nsrc )
                                         (begin 
                                           (u8vector-copy! u8v-dst 0 u8v-src ) 
                                           ;#?= u8v-dst
                                           nsrc )
                                         (begin 
                                           ; ここには来ないはずだが念の為
                                           (error "ndst < nsrc") ) ) ) ) ) ) ) 
            (consume vp)
            ) ) ) ) ) )