ポートの移動

前回の記事では Scheme のポートを覆ったオブジェクトを作ってそれに対して操作することであたかも文字をバッファに戻せるかのように見せるという手法を紹介した。

文字をバッファへ戻す

しかし、これは抽象化の手法としては欠陥がある。 ラッパーオブジェクトを作っても、依然として元のポートへアクセス可能だからだ。 ラッパーオブジェクト (のインターフェイス) を経由せずに操作されたのでは挙動が破綻してしまう。

ラッパーオブジェクトからはポートへアクセスしつつも元のポートは閉じてしまうということは出来ないのだろうかと考えてみると、 R6RS にはそれをやっている手続があった。 transcoded-port だ。 higepon 氏がブログにまとめていて参考になる。

R6RS における transcoded-port が binary port を close するとは？

とはいうものの、これは transcoded-port の挙動であって、ポートをラッピングする場合一般に何らかの機能が提供されているわけではない。 どんな機能があればこのような場合に役立つだろうか。 そんなことを先日ツイッタに書いたところ反応をもらった。

togetter: Scheme でポートをラッピングするとき

元のポートの全ての状態を相続した新しいポートを作ると同時に元のポートを無効にする (見掛け上はクローズ済みに見えればいい？) という手続きがあればよく、実装面でもなんとかなるのではないかという結論である。

C++11 のムーブセマンティクスに着想を得たものなので、仮にそのような手続を port-move と名付けるとすると前回の記事で挙げたラッパーの例は以下のように書換えればよいだけだ。

;; これを
(define (c-like-port-wrapper port)
  (c-like-port port '()))

;; こうする
(define (c-like-port-wrapper port)
  (c-like-port (port-move port) '()))

Gauche で port-move の実装を試みたものが以下だ。 拡張として実装するのが困難だったのでパッチという形式にしてある。 充分な試験をしたわけではないのであくまで実験的なものであるということは承知頂きたい。

diff --git a/src/gauche/port.h b/src/gauche/port.h
index c81c2f1..2fa2a0d 100644
--- a/src/gauche/port.h
+++ b/src/gauche/port.h
@@ -326,6 +326,7 @@ SCM_EXTERN int    Scm_CharReady(ScmPort *port);
 SCM_EXTERN int    Scm_CharReadyUnsafe(ScmPort *port);
 
 SCM_EXTERN void   Scm_ClosePort(ScmPort *port);
+SCM_EXTERN ScmObj Scm_MovePort(ScmPort* port);
 
 SCM_EXTERN ScmObj Scm_VMWithPortLocking(ScmPort *port,
                                         ScmObj closure);
diff --git a/src/libio.scm b/src/libio.scm
index 8b3676c..5f91cda 100644
--- a/src/libio.scm
+++ b/src/libio.scm
@@ -152,6 +152,7 @@
 (define-cproc close-output-port (port::<output-port>) ::<void> Scm_ClosePort)
 (select-module gauche)
 (define-cproc close-port (port::<port>) ::<void> Scm_ClosePort) ;R6RS
+(define-cproc port-move (port::<port>) ::<port> Scm_MovePort)
 
 (select-module gauche.internal)
 (inline-stub
diff --git a/src/port.c b/src/port.c
index 08a0308..c6c099f 100644
--- a/src/port.c
+++ b/src/port.c
@@ -216,6 +216,35 @@ void Scm_ClosePort(ScmPort *port)
     PORT_UNLOCK(port);
 }
 
+/*
+ * Move
+ */
+
+ScmObj Scm_MovePort(ScmPort* port) {
+  ScmVM *vm = Scm_VM();
+
+  if (SCM_PORT_CLOSED_P(port)) return SCM_FALSE;
+
+  PORT_LOCK(port, vm);
+  ScmPort* new_port = SCM_NEW(ScmPort);
+  *new_port = *port;
+
+  if (SCM_PORT_TYPE(port) == SCM_PORT_FILE)
+    if (SCM_PORT_DIR(port) == SCM_PORT_OUTPUT) {
+      unregister_buffered_port(port);
+      register_buffered_port(new_port);
+    }
+  (void)SCM_INTERNAL_FASTLOCK_DESTROY(port->lock);
+
+  SCM_PORT_CLOSED_P(port) = TRUE;
+
+  Scm_RegisterFinalizer(SCM_OBJ(new_port), port_finalize, NULL);
+  Scm_UnregisterFinalizer(SCM_OBJ(port));
+  PORT_UNLOCK(port);
+
+  return new_port;
+}
+
 /*===============================================================
  * Locking ports
  */

有用な機能だと思う。

Document ID: 8e0fa2112f51dd83db067a86b237317e