diff options
author | Andy Wingo <wingo@pobox.com> | 2011-12-01 23:31:50 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2011-12-01 23:31:50 +0100 |
commit | b2208d2e987759270c712e35c8164394a47a52aa (patch) | |
tree | 1edd39e74a266fc53c075d328696e8fbf33eba5b /module/srfi | |
parent | 3dc9f41900a0e9f915da3aa1eea6e0fae829c40d (diff) | |
parent | 738c899e4c1ab9d25cfbcd1010f34e0cce400bca (diff) | |
download | guile-b2208d2e987759270c712e35c8164394a47a52aa.tar.gz |
Merge remote-tracking branch 'origin/stable-2.0'
Conflicts:
configure.ac
libguile/fluids.c
libguile/gc.c
libguile/gc.h
libguile/objcodes.c
libguile/procprop.c
libguile/vm.c
module/ice-9/psyntax-pp.scm
module/ice-9/psyntax.scm
Diffstat (limited to 'module/srfi')
-rw-r--r-- | module/srfi/srfi-39.scm | 50 |
1 files changed, 27 insertions, 23 deletions
diff --git a/module/srfi/srfi-39.scm b/module/srfi/srfi-39.scm index dba86fdbb..d1c46d028 100644 --- a/module/srfi/srfi-39.scm +++ b/module/srfi/srfi-39.scm @@ -57,37 +57,41 @@ (define get-conv-tag (lambda () 'get-conv)) ;; arbitrary unique (as per eq?) value (define (make-parameter/helper val conv) - (let ((value (make-fluid)) - (conv conv)) - (begin - (fluid-set! value (conv val)) - (lambda new-value - (cond - ((null? new-value) (fluid-ref value)) - ((eq? (car new-value) get-fluid-tag) value) - ((eq? (car new-value) get-conv-tag) conv) - ((null? (cdr new-value)) (fluid-set! value (conv (car new-value)))) - (else (error "make-parameter expects 0 or 1 arguments" new-value))))))) + (let ((fluid (make-fluid (conv val)))) + (case-lambda + (() + (fluid-ref fluid)) + ((new-value) + (cond + ((eq? new-value get-fluid-tag) fluid) + ((eq? new-value get-conv-tag) conv) + (else (fluid-set! fluid (conv new-value)))))))) (define-syntax-rule (parameterize ((?param ?value) ...) ?body ...) (with-parameters* (list ?param ...) (list ?value ...) (lambda () ?body ...))) -(define (current-input-port . new-value) - (if (null? new-value) - ((@ (guile) current-input-port)) - (apply set-current-input-port new-value))) +(define current-input-port + (case-lambda + (() + ((@ (guile) current-input-port))) + ((new-value) + (set-current-input-port new-value)))) -(define (current-output-port . new-value) - (if (null? new-value) - ((@ (guile) current-output-port)) - (apply set-current-output-port new-value))) +(define current-output-port + (case-lambda + (() + ((@ (guile) current-output-port))) + ((new-value) + (set-current-output-port new-value)))) -(define (current-error-port . new-value) - (if (null? new-value) - ((@ (guile) current-error-port)) - (apply set-current-error-port new-value))) +(define current-error-port + (case-lambda + (() + ((@ (guile) current-error-port))) + ((new-value) + (set-current-error-port new-value)))) (define port-list (list current-input-port current-output-port current-error-port)) |