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.

benchmark-suite/lib.scm

@@ -1,5 +1,5 @@
 ;;;; benchmark-suite/lib.scm --- generic support for benchmarking
-;;;; Copyright (C) 2002, 2006 Free Software Foundation, Inc.
+;;;; Copyright (C) 2002, 2006, 2011 Free Software Foundation, Inc.
 ;;;;
 ;;;; This program is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -348,8 +348,7 @@
   (append (current-benchmark-prefix) (list name)))
 
 ;;; A fluid containing the current benchmark prefix, as a list.
-(define prefix-fluid (make-fluid))
-(fluid-set! prefix-fluid '())
+(define prefix-fluid (make-fluid '()))
 (define (current-benchmark-prefix)
   (fluid-ref prefix-fluid))
 

module/ice-9/boot-9.scm

@@ -69,23 +69,6 @@
 
 (define with-throw-handler #f)
 (let ()
-  ;; Ideally we'd like to be able to give these default values for all threads,
-  ;; even threads not created by Guile; but alack, that does not currently seem
-  ;; possible. So wrap the getters in thunks.
-  (define %running-exception-handlers (make-fluid))
-  (define %exception-handler (make-fluid))
-
-  (define (running-exception-handlers)
-    (or (fluid-ref %running-exception-handlers)
-        (begin
-          (fluid-set! %running-exception-handlers '())
-          '())))
-  (define (exception-handler)
-    (or (fluid-ref %exception-handler)
-        (begin
-          (fluid-set! %exception-handler default-exception-handler)
-          default-exception-handler)))
-
   (define (default-exception-handler k . args)
     (cond
      ((eq? k 'quit)
@@ -98,18 +81,21 @@
       (format (current-error-port) "guile: uncaught throw to ~a: ~a\n" k args)
       (primitive-exit 1))))
 
+  (define %running-exception-handlers (make-fluid '()))
+  (define %exception-handler (make-fluid default-exception-handler))
+
   (define (default-throw-handler prompt-tag catch-k)
-    (let ((prev (exception-handler)))
+    (let ((prev (fluid-ref %exception-handler)))
       (lambda (thrown-k . args)
         (if (or (eq? thrown-k catch-k) (eqv? catch-k #t))
             (apply abort-to-prompt prompt-tag thrown-k args)
             (apply prev thrown-k args)))))
 
   (define (custom-throw-handler prompt-tag catch-k pre)
-    (let ((prev (exception-handler)))
+    (let ((prev (fluid-ref %exception-handler)))
       (lambda (thrown-k . args)
         (if (or (eq? thrown-k catch-k) (eqv? catch-k #t))
-            (let ((running (running-exception-handlers)))
+            (let ((running (fluid-ref %running-exception-handlers)))
               (with-fluids ((%running-exception-handlers (cons pre running)))
                 (if (not (memq pre running))
                     (apply pre thrown-k args))
@@ -192,9 +178,9 @@ for key @var{key}, then invoke @var{thunk}."
 
 If there is no handler at all, Guile prints an error and then exits."
           (if (not (symbol? key))
-              ((exception-handler) 'wrong-type-arg "throw"
+              ((fluid-ref %exception-handler) 'wrong-type-arg "throw"
                "Wrong type argument in position ~a: ~a" (list 1 key) (list key))
-              (apply (exception-handler) key args)))))
+              (apply (fluid-ref %exception-handler) key args)))))
 
 
 
@@ -1411,8 +1397,7 @@ VALUE."
 ;;; Reader code for various "#c" forms.
 ;;;
 
-(define read-eval? (make-fluid))
-(fluid-set! read-eval? #f)
+(define read-eval? (make-fluid #f))
 (read-hash-extend #\.
                   (lambda (c port)
                     (if (fluid-ref read-eval?)
@@ -2877,14 +2862,14 @@ module '(ice-9 q) '(make-q q-length))}."
 ;;; {Running Repls}
 ;;;
 
-(define *repl-stack* (make-fluid))
+(define *repl-stack* (make-fluid '()))
 
 ;; Programs can call `batch-mode?' to see if they are running as part of a
 ;; script or if they are running interactively. REPL implementations ensure that
 ;; `batch-mode?' returns #f during their extent.
 ;;
 (define (batch-mode?)
-  (null? (or (fluid-ref *repl-stack*) '())))
+  (null? (fluid-ref *repl-stack*)))
 
 ;; Programs can re-enter batch mode, for example after a fork, by calling
 ;; `ensure-batch-mode!'. It's not a great interface, though; it would be better
@@ -3301,8 +3286,7 @@ module '(ice-9 q) '(make-q q-length))}."
 ;;;
 
 (define* (make-mutable-parameter init #:optional (converter identity))
-  (let ((fluid (make-fluid)))
-    (fluid-set! fluid (converter init))
+  (let ((fluid (make-fluid (converter init))))
     (case-lambda
       (() (fluid-ref fluid))
       ((val) (fluid-set! fluid (converter val))))))

module/ice-9/getopt-long.scm

@@ -164,9 +164,9 @@
   #:use-module (ice-9 optargs)
   #:export (getopt-long option-ref))
 
-(define %program-name (make-fluid))
+(define %program-name (make-fluid "guile"))
 (define (program-name)
-  (or (fluid-ref %program-name) "guile"))
+  (fluid-ref %program-name))
 
 (define (fatal-error fmt . args)
   (format (current-error-port) "~a: " (program-name))

module/language/elisp/runtime.scm

@@ -1,6 +1,6 @@
 ;;; Guile Emacs Lisp
 
-;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
+;;; Copyright (C) 2009, 2010, 2011 Free Software Foundation, Inc.
 ;;;
 ;;; This library is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU Lesser General Public
@@ -131,8 +131,8 @@
       ((_ name value)
        (with-syntax ((scheme-name (make-id #'name 'macro- #'name)))
         #'(begin
-            (define-public scheme-name (make-fluid))
-            (fluid-set! scheme-name (cons 'macro value))))))))
+            (define-public scheme-name
+              (make-fluid (cons 'macro value)))))))))
 
 (define-syntax defspecial
   (lambda (x)
@@ -140,10 +140,10 @@
       ((_ name args body ...)
        (with-syntax ((scheme-name (make-id #'name 'compile- #'name)))
          #'(begin
-             (define scheme-name (make-fluid))
-             (fluid-set! scheme-name
-                         (cons 'special-operator
-                               (lambda args body ...)))))))))
+             (define scheme-name
+               (make-fluid
+                (cons 'special-operator
+                      (lambda args body ...))))))))))
 
 ;;; Call a guile-primitive that may be rebound for elisp and thus needs
 ;;; absolute addressing.

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))

module/system/base/language.scm

@@ -111,7 +111,7 @@
 ;;; Current language
 ;;;
 
-(define *current-language* (make-fluid))
+(define *current-language* (make-fluid 'scheme))
 
 (define (current-language)
-  (or (fluid-ref *current-language*) 'scheme))
+  (fluid-ref *current-language*))

module/system/base/message.scm

@@ -56,15 +56,13 @@
 
 (define *current-warning-port*
   ;; The port where warnings are sent.
-  (make-fluid))
+  (make-fluid (current-error-port)))
 
 (fluid-set! *current-warning-port* (current-error-port))
 
 (define *current-warning-prefix*
   ;; Prefix string when emitting a warning.
-  (make-fluid))
-
-(fluid-set! *current-warning-prefix* ";;; ")
+  (make-fluid ";;; "))
 
 
 (define-record-type <warning-type>

module/system/base/target.scm

@@ -34,15 +34,15 @@
 ;;; Target types
 ;;;
 
-(define %target-type (make-fluid))
-(define %target-endianness (make-fluid))
-(define %target-word-size (make-fluid))
-
 (define %native-word-size
   ;; The native word size.  Note: don't use `word-size' from
   ;; (system vm objcode) to avoid a circular dependency.
   ((@ (system foreign) sizeof) '*))
 
+(define %target-type (make-fluid %host-type))
+(define %target-endianness (make-fluid (native-endianness)))
+(define %target-word-size (make-fluid %native-word-size))
+
 (define (validate-target target)
   (if (or (not (string? target))
           (let ((parts (string-split target #\-)))
@@ -100,8 +100,7 @@
 
 (define (target-type)
   "Return the GNU configuration triplet of the target platform."
-  (or (fluid-ref %target-type)
-      %host-type))
+  (fluid-ref %target-type))
 
 (define (target-cpu)
   "Return the CPU name of the target platform."
@@ -117,8 +116,8 @@
 
 (define (target-endianness)
   "Return the endianness object of the target platform."
-  (or (fluid-ref %target-endianness) (native-endianness)))
+  (fluid-ref %target-endianness))
 
 (define (target-word-size)
   "Return the word size, in bytes, of the target platform."
-  (or (fluid-ref %target-word-size) %native-word-size))
+  (fluid-ref %target-word-size))

module/texinfo/plain-text.scm

@@ -1,6 +1,6 @@
 ;;;; (texinfo plain-text) -- rendering stexinfo as plain text
 ;;;;
-;;;; 	Copyright (C) 2009, 2010  Free Software Foundation, Inc.
+;;;; 	Copyright (C) 2009, 2010, 2011  Free Software Foundation, Inc.
 ;;;;    Copyright (C) 2003,2004,2009  Andy Wingo <wingo at pobox dot com>
 ;;;; 
 ;;;; This library is free software; you can redistribute it and/or
@@ -41,9 +41,6 @@
   (or (arg-ref key %-args)
       (error "Missing argument:" key %-args)))
 
-(define *indent* (make-fluid))
-(define *itemizer* (make-fluid))
-
 (define (make-ticker str)
   (lambda () str))
 (define (make-enumerator n)
@@ -52,9 +49,8 @@
       (set! n (1+ n))
       (format #f "~A. " last))))
 
-(fluid-set! *indent* "")
-;; Shouldn't be necessary to do this, but just in case.
-(fluid-set! *itemizer* (make-ticker "* "))
+(define *indent* (make-fluid ""))
+(define *itemizer* (make-fluid (make-ticker "* ")))
 
 (define-macro (with-indent n . body)
   `(with-fluids ((*indent* (string-append (fluid-ref *indent*)

test-suite/lib.scm

@@ -425,8 +425,7 @@
   (append (current-test-prefix) (list name)))
 
 ;;; A fluid containing the current test prefix, as a list.
-(define prefix-fluid (make-fluid))
-(fluid-set! prefix-fluid '())
+(define prefix-fluid (make-fluid '()))
 (define (current-test-prefix)
   (fluid-ref prefix-fluid))