From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 29 May 2018 00:35:07 +0000 (-0700)
Subject: Implement call-with-port for R7RS.
X-Git-Tag: mit-scheme-pucked-x11-0.3.1~7^2~3
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=85fd220700d151766c767f0193ea4d10bb1056ae;p=mit-scheme.git

Implement call-with-port for R7RS.
---

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index a00a914c2..faac808ce 100644
--- 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 7843e0bb8..affb59e78 100644
--- 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))
 
 ;;;; Port modes