Implement call-with-port for R7RS.

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index a00a914c27b68f1bb22769be813bbe9f059033db..faac808ce2bc0b238ebe88fde4d85e2ad9df759d 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -2675,6 +2675,7 @@ USA.
          with-output-to-port
          with-trace-output-port)
   (export ()
+         call-with-port
          close-input-port
          close-output-port
          close-port

diff --git a/src/runtime/textual-port.scm b/src/runtime/textual-port.scm
index 7843e0bb8c386f24fa1b56533dea21b49757422f..affb59e7865d16680a980199a9584123459ded19 100644 (file)
--- a/src/runtime/textual-port.scm
+++ b/src/runtime/textual-port.scm
@@ -653,6 +653,11 @@ USA.
   (cond ((binary-port? port) (binary-port-metadata port))
        ((textual-port? port) (textual-port-metadata port))
        (else (error:not-a port? port 'port-metadata))))
+
+(define (call-with-port port procedure)
+  (let ((value (procedure port)))
+    (close-port port)
+    value))
 \f
 ;;;; Port modes