mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-11 14:21:10 +02:00
Code Activity

case-lambda in dup->{in,out,}port, dup

Browse source 
* module/ice-9/boot-9.scm (dup->port, dup->inport, dup->outport, dup):
  Use case-lambda. Not particularly elegant.
This commit is contained in:
Andy Wingo 2010-05-21 23:36:47 +02:00
parent 52c9a3381d
commit 02851b26c7
1 changed files with 30 additions and 14 deletions
Download patch file Download diff file Expand all files Collapse all files

44
module/ice-9/boot-9.scm
View file

@ -917,23 +917,39 @@ If there is no handler at all, Guile prints an error and then exits."
(if (> revealed 0)
(set-port-revealed! port (- revealed 1)))))
(define (dup->port port/fd mode . maybe-fd)
(let ((port (fdopen (apply dup->fdes port/fd maybe-fd)
mode)))
(if (pair? maybe-fd)
(set-port-revealed! port 1))
port))
(define dup->port
(case-lambda
((port/fd mode)
(fdopen (dup->fdes port/fd) mode))
((port/fd mode new-fd)
(let ((port (fdopen (dup->fdes port/fd new-fd) mode)))
(set-port-revealed! port 1)
port))))
(define (dup->inport port/fd . maybe-fd)
(apply dup->port port/fd "r" maybe-fd))
(define dup->inport
(case-lambda
((port/fd)
(dup->port port/fd "r"))
((port/fd new-fd)
(dup->port port/fd "r" new-fd))))
(define (dup->outport port/fd . maybe-fd)
(apply dup->port port/fd "w" maybe-fd))
(define dup->outport
(case-lambda
((port/fd)
(dup->port port/fd "w"))
((port/fd new-fd)
(dup->port port/fd "w" new-fd))))
(define (dup port/fd . maybe-fd)
(if (integer? port/fd)
(apply dup->fdes port/fd maybe-fd)
(apply dup->port port/fd (port-mode port/fd) maybe-fd)))
(define dup
(case-lambda
((port/fd)
(if (integer? port/fd)
(dup->fdes port/fd)
(dup->port port/fd (port-mode port/fd))))
((port/fd new-fd)
(if (integer? port/fd)
(dup->fdes port/fd new-fd)
(dup->port port/fd (port-mode port/fd) new-fd)))))
(define (duplicate-port port modes)
(dup->port port modes))