>From 8103963b8f8a927ba60777c4f668633fe2024071 Mon Sep 17 00:00:00 2001
From: Mario Domenech Goulart <address@hidden>
Date: Thu, 10 Apr 2014 20:59:23 -0300
Subject: [PATCH] Avoid checking ports multiple times in write, display, print
 and print*

 write, display, print and print* call ##sys#check-output-port
 then call ##sys#print, which also checks the given port with
 ##sys#check-output-port

 To avoid checking the port multiple times, ##sys#unsafe-print has
 been created, which is ##sys#print without port checking. write,
 display, print and print* check the port as they were already doing,
 then call ##sys#unsafe-print instead of ##sys#print.

 The semantics for ##sys#print has been kept: check port, then call
 ##sys#unsafe-print.
---
 library.scm |   14 +++++++++-----
 1 file changed, 9 insertions(+), 5 deletions(-)

diff --git a/library.scm b/library.scm
index 31eda65..9f2c8b9 100644
--- a/library.scm
+++ b/library.scm
@@ -33,6 +33,7 @@
 	##sys#vector-resize ##sys#default-parameter-vector 
 	current-print-length setter-tag read-marks
 	##sys#print-exit
+	##sys#unsafe-print
 	##sys#format-here-doc-warning
 	exit-in-progress
         maximal-string-length)
@@ -3199,14 +3200,14 @@ EOF
 
 (define (write x #!optional (port ##sys#standard-output))
   (##sys#check-output-port port #t 'write)
-  (##sys#print x #t port) )
+  (##sys#unsafe-print x #t port) )
 
 (define (display x #!optional (port ##sys#standard-output))
   (##sys#check-output-port port #t 'display)
-  (##sys#print x #f port) )
+  (##sys#unsafe-print x #f port) )
 
 (define-inline (*print-each lst)
-  (for-each (cut ##sys#print <> #f ##sys#standard-output) lst) )
+  (for-each (cut ##sys#unsafe-print <> #f ##sys#standard-output) lst) )
  
 (define (print . args)
   (##sys#check-output-port ##sys#standard-output #t 'print)
@@ -3224,12 +3225,15 @@ EOF
 (define ##sys#print-length-limit (make-parameter #f))
 (define ##sys#print-exit (make-parameter #f))
 
-(define ##sys#print
+(define (##sys#print x readable port)
+  (##sys#check-output-port port #t #f)
+  (##sys#unsafe-print x readable port))
+
+(define ##sys#unsafe-print
   (let ((string-append string-append)
 	(case-sensitive case-sensitive)
 	(keyword-style keyword-style))
     (lambda (x readable port)
-      (##sys#check-output-port port #t #f)
       (let ([csp (case-sensitive)]
 	    [ksp (keyword-style)]
 	    [length-limit (##sys#print-length-limit)]
-- 
1.7.10.4