summaryrefslogtreecommitdiff
path: root/module/srfi
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2011-11-23 12:40:33 +0100
committerAndy Wingo <wingo@pobox.com>2011-11-23 12:54:09 +0100
commit9447207f0c9a52d48b2de20b444405dfdd43d465 (patch)
tree162696fc2bffb4991ef4139b89cd1d90c12bf38d /module/srfi
parentc81c2ad3a59fdfb54260af2c159fac56de4daf3a (diff)
downloadguile-9447207f0c9a52d48b2de20b444405dfdd43d465.tar.gz
Use default value for make-fluid in Scheme files
* module/ice-9/boot-9.scm (%exception-handler) (%running-exception-handlers, read-eval?, *repl-stack*) (make-mutable-parameter): * module/ice-9/getopt-long.scm (%program-name): * module/language/elisp/runtime.scm (built-in-macro, defspecial): * module/srfi/srfi-39.scm (make-parameter/helper): * module/system/base/language.scm (*current-language*): * module/system/base/message.scm (*current-warning-port*): (*current-warning-prefix*): * module/system/base/target.scm (%target-type, %target-endianness) (%target-word-size): * module/texinfo/plain-text.scm (*indent*, *itemizer*): * benchmark-suite/lib.scm (prefix-fluid): * test-suite/lib.scm (prefix-fluid): Give fluids a useful default value.
Diffstat (limited to 'module/srfi')
-rw-r--r--module/srfi/srfi-39.scm50
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))