From 25381bdbc05a54d59cff6af0f85b64c4032033f2 Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Tue, 24 May 2016 07:14:26 +0200
Subject: [PATCH] close-port implementation in sports

* module/ice-9/sports.scm (close-port): New function.
  (port-bindings): Add close-port.
---
 module/ice-9/sports.scm | 14 ++++++++++++--
 1 file changed, 12 insertions(+), 2 deletions(-)

diff --git a/module/ice-9/sports.scm b/module/ice-9/sports.scm
index b506703d6..3f6107905 100644
--- a/module/ice-9/sports.scm
+++ b/module/ice-9/sports.scm
@@ -54,7 +54,8 @@
   #:use-module (ice-9 match)
   #:replace (peek-char
              read-char
-             force-output)
+             force-output
+             close-port)
   #:export (lookahead-u8
             get-u8
             get-bytevector-n
@@ -92,6 +93,15 @@
     (error "not an open output port" port))
   (flush-output port))
 
+(define close-port
+  (let ((%close-port (@ (guile) close-port)))
+    (lambda (port)
+      (cond
+       ((port-closed? port) #f)
+       (else
+        (when (output-port? port) (flush-output port))
+        (%close-port port))))))
+
 (define (default-read-waiter port) (port-poll port "r"))
 (define (default-write-waiter port) (port-poll port "w"))
 
@@ -579,7 +589,7 @@
 
 (define saved-port-bindings #f)
 (define port-bindings
-  '(((guile) read-char peek-char force-output)
+  '(((guile) read-char peek-char force-output close-port)
     ((ice-9 binary-ports) get-u8 lookahead-u8 get-bytevector-n)
     ((ice-9 rdelim) %read-line read-line read-delimited)))
 (define (install-sports!)