diff options
author | Andy Wingo <wingo@pobox.com> | 2011-11-23 12:40:33 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2011-11-23 12:54:09 +0100 |
commit | 9447207f0c9a52d48b2de20b444405dfdd43d465 (patch) | |
tree | 162696fc2bffb4991ef4139b89cd1d90c12bf38d /module/srfi | |
parent | c81c2ad3a59fdfb54260af2c159fac56de4daf3a (diff) | |
download | guile-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.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)) |