aliens/tekuti
1
0
Fork 0
Code Activity

with-i/o procedures close their ports

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2011-04-25 19:10:07 +02:00
parent a4bad7a561
commit 26216a593a
3 changed files with 22 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
tekuti/filters.scm
View file

@ -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

6
tekuti/git.scm
View file

@ -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 ()

20
tekuti/util.scm
View file

@ -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)