From 02851b26c7862d3549a494eb895e31e48053e321 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Fri, 21 May 2010 23:36:47 +0200 Subject: [PATCH] case-lambda in dup->{in,out,}port, dup * module/ice-9/boot-9.scm (dup->port, dup->inport, dup->outport, dup): Use case-lambda. Not particularly elegant. --- module/ice-9/boot-9.scm | 44 ++++++++++++++++++++++++++++------------- 1 file changed, 30 insertions(+), 14 deletions(-) diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm index 042063fbc..30b9db129 100644 --- a/module/ice-9/boot-9.scm +++ b/module/ice-9/boot-9.scm @@ -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))