From 26216a593aaeb697033a379e4641f937b3a8516b Mon Sep 17 00:00:00 2001
From: Andy Wingo
Date: Mon, 25 Apr 2011 19:10:07 +0200
Subject: with-i/o procedures close their ports

* tekuti/util.scm (with-output-to-string*, with-input-from-string*): New
  hacky helpers, which close the port before returning the string or
  result.  Hopefully reduce pressure on the GC.
  (shell:quote):
* tekuti/git.scm (git-commit-reverse-operations, with-output-to-blob*)
  (with-input-from-blob*):
* tekuti/filters.scm (wordpress->sxml): Use the string* procedures.
---
 tekuti/filters.scm |  4 ++--
 tekuti/git.scm     |  6 +++---
 tekuti/util.scm    | 20 +++++++++++++++++---
 3 files changed, 22 insertions(+), 8 deletions(-)

diff --git a/tekuti/filters.scm b/tekuti/filters.scm
index 78a5d18..2fbb767 100644
--- a/tekuti/filters.scm
+++ b/tekuti/filters.scm
@@ -1,5 +1,5 @@
 ;; Tekuti
-;; Copyright (C) 2008, 2010 Andy Wingo <wingo at pobox dot com>
+;; Copyright (C) 2008, 2010, 2011 Andy Wingo <wingo at pobox dot com>
 
 ;; This program is free software; you can redistribute it and/or    
 ;; modify it under the terms of the GNU General Public License as   
@@ -79,7 +79,7 @@
             (cons (car in) (pclose p out))))))))
 
 (define (wordpress->sxml text)
-  (let ((sxml (cadr (with-input-from-string (string-append "<div>" text "</div>")
+  (let ((sxml (cadr (with-input-from-string* (string-append "<div>" text "</div>")
                       xml->sxml))))
     (pre-post-order
      sxml
diff --git a/tekuti/git.scm b/tekuti/git.scm
index fee9c0f..e4e9b05 100644
--- a/tekuti/git.scm
+++ b/tekuti/git.scm
@@ -235,7 +235,7 @@
 ;; probably the best that we can do, given that git does not track
 ;; directory renames.
 (define (git-commit-reverse-operations sha1)
-  (with-input-from-string (git "diff-tree" "-R" "-r" sha1)
+  (with-input-from-string* (git "diff-tree" "-R" "-r" sha1)
     (lambda ()
       (read-line) ;; throw away the header
       (let lp ((ops '()))
@@ -339,7 +339,7 @@
      (- ts (* (+ (* (quotient tz 100) 60) (remainder tz 100)) 60)))))
 
 (define (with-output-to-blob* thunk)
-  (git-hash-object (with-output-to-string thunk)))
+  (git-hash-object (with-output-to-string* thunk)))
 
 (define-syntax with-output-to-blob
   (syntax-rules ()
@@ -347,7 +347,7 @@
      (with-output-to-blob* (lambda () f f* ...)))))
 
 (define (with-input-from-blob* sha1 thunk)
-  (with-input-from-string (git "show" sha1) thunk))
+  (with-input-from-string* (git "show" sha1) thunk))
 
 (define-syntax with-input-from-blob
   (syntax-rules ()
diff --git a/tekuti/util.scm b/tekuti/util.scm
index ceb3300..cfc91fb 100644
--- a/tekuti/util.scm
+++ b/tekuti/util.scm
@@ -1,5 +1,5 @@
 ;; Tekuti
-;; Copyright (C) 2008, 2010 Andy Wingo <wingo at pobox dot com>
+;; Copyright (C) 2008, 2010, 2011 Andy Wingo <wingo at pobox dot com>
 
 ;; This program is free software; you can redistribute it and/or    
 ;; modify it under the terms of the GNU General Public License as   
@@ -28,7 +28,8 @@
   #:use-module (tekuti match-bind)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-19)
-  #:export (expanduser match-lines dbg unwind-protect dsu-sort
+  #:export (with-output-to-string* with-input-from-string*
+            expanduser match-lines dbg unwind-protect dsu-sort
             hash-push! list-has-length? list-head-match mapn filter-mapn
             take-max read-hash write-hash shell:quote foldn
             call-with-temp-file emailish? urlish?
@@ -37,6 +38,19 @@
             date->timestamp timestamp->date string-split/trimming
             list-intersperse with-time-debugging))
 
+(define (with-output-to-string* thunk)
+  (let ((port (open-output-string)))
+    (with-output-to-port port thunk)
+    (let ((str (get-output-string port)))
+      (close-port port)
+      str)))
+
+(define (with-input-from-string* str thunk)
+  (let* ((port (open-input-string str))
+         (res (with-input-from-port port thunk)))
+    (close-port port)
+    res))
+
 (define (emailish? x)
   (match-bind "^([a-zA-Z0-9._+-]+)@([a-zA-Z0-9-]+\\.)+[a-zA-Z]+$"
               x (_ . args)
@@ -75,7 +89,7 @@
      (delete-file template))))
 
 (define (shell:quote str)
-  (with-output-to-string
+  (with-output-to-string*
     (lambda ()
       (display #\')
       (string-for-each (lambda (ch)
-- 
cgit v1.2.3-54-g00ecf