[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.3-33-g944720
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.3-33-g9447207 |
|
Date: |
Wed, 23 Nov 2011 12:51:13 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=9447207f0c9a52d48b2de20b444405dfdd43d465
The branch, stable-2.0 has been updated
via 9447207f0c9a52d48b2de20b444405dfdd43d465 (commit)
via c81c2ad3a59fdfb54260af2c159fac56de4daf3a (commit)
via aafb4ed72414dd0dccc6ff27a59318adfda26abf (commit)
from adf8616fabbf3248cfbe4f075b5f2c02fed9e5c2 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 9447207f0c9a52d48b2de20b444405dfdd43d465
Author: Andy Wingo <address@hidden>
Date: Wed Nov 23 12:40:33 2011 +0100
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.
commit c81c2ad3a59fdfb54260af2c159fac56de4daf3a
Author: Andy Wingo <address@hidden>
Date: Wed Nov 23 12:21:22 2011 +0100
use new scm_make_fluid_with_default
* libguile/load.c (scm_init_load):
* libguile/ports.c (scm_init_ports):
* libguile/read.c (scm_init_read): Use scm_make_fluid_with_default.
commit aafb4ed72414dd0dccc6ff27a59318adfda26abf
Author: Andy Wingo <address@hidden>
Date: Wed Nov 23 12:13:12 2011 +0100
optional default-value arg to make-fluid
* libguile/fluids.c (grow_dynamic_state, new_fluid): Arrange for the
default value in the dynamic-state vector to be SCM_UNDEFINED instead
of SCM_BOOL_F. If the value in the dynamic-state is #f, default to a
value attached to the fluid instead. This allows useful default
values.
(scm_make_fluid_with_default): New function, allows the user to
specify a default value for the fluid. Defaults to #f. Bound to
`make-fluid' on the Scheme side.
(scm_make_unbound_fluid): Use SCM_UNDEFINED as the default in all
threads.
(scm_fluid_unset_x): Also unset the default value. Not sure if this
is the right thing.
(fluid_ref): Update to the new default-value strategy.
* libguile/threads.c (scm_i_reset_fluid): Reset to SCM_UNDEFINED.
* libguile/threads.h: Remove extra arg to scm_i_reset_fluid.
* libguile/vm-i-system.c (fluid-ref): Update to new default-value
strategy.
* module/ice-9/vlist.scm (block-growth-factor): Default to 2 in all
threads. Fixes http://debbugs.gnu.org/10093.
-----------------------------------------------------------------------
Summary of changes:
benchmark-suite/lib.scm | 5 +--
libguile/fluids.c | 42 ++++++++++++++++++++-----------
libguile/fluids.h | 6 +++-
libguile/load.c | 3 +-
libguile/ports.c | 10 +++---
libguile/read.c | 3 +-
libguile/threads.c | 4 +-
libguile/threads.h | 2 +-
libguile/vm-i-system.c | 2 +
module/ice-9/boot-9.scm | 40 +++++++++--------------------
module/ice-9/getopt-long.scm | 4 +-
module/ice-9/vlist.scm | 4 +--
module/language/elisp/runtime.scm | 14 +++++-----
module/srfi/srfi-39.scm | 50 ++++++++++++++++++++-----------------
module/system/base/language.scm | 4 +-
module/system/base/message.scm | 6 +---
module/system/base/target.scm | 15 +++++------
module/texinfo/plain-text.scm | 10 ++-----
test-suite/lib.scm | 3 +-
19 files changed, 109 insertions(+), 118 deletions(-)
diff --git a/benchmark-suite/lib.scm b/benchmark-suite/lib.scm
index a6feed8..4ba0e3e 100644
--- a/benchmark-suite/lib.scm
+++ b/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))
diff --git a/libguile/fluids.c b/libguile/fluids.c
index 67efd9f..f92c5dd 100644
--- a/libguile/fluids.c
+++ b/libguile/fluids.c
@@ -68,7 +68,7 @@ grow_dynamic_state (SCM state)
/* Assume the assignment below is atomic. */
len = allocated_fluids_len;
- new_fluids = scm_c_make_vector (len, SCM_BOOL_F);
+ new_fluids = scm_c_make_vector (len, SCM_UNDEFINED);
for (i = 0; i < old_len; i++)
SCM_SIMPLE_VECTOR_SET (new_fluids, i,
@@ -103,14 +103,14 @@ scm_i_with_fluids_print (SCM exp, SCM port,
scm_print_state *pstate SCM_UNUSED)
/* Return a new fluid. */
static SCM
-new_fluid ()
+new_fluid (SCM init)
{
SCM fluid;
size_t trial, n;
- /* Fluids are pointerless cells: the first word is the type tag; the second
- word is the fluid number. */
- fluid = PTR2SCM (scm_gc_malloc_pointerless (sizeof (scm_t_cell), "fluid"));
+ /* Fluids hold the type tag and the fluid number in the first word,
+ and the default value in the second word. */
+ fluid = scm_cell (scm_tc7_fluid, SCM_UNPACK (init));
SCM_SET_CELL_TYPE (fluid, scm_tc7_fluid);
scm_dynwind_begin (0);
@@ -157,7 +157,7 @@ new_fluid ()
}
allocated_fluids[n] = SCM2PTR (fluid);
- SCM_SET_CELL_WORD_1 (fluid, (scm_t_bits) n);
+ SCM_SET_CELL_WORD_0 (fluid, (scm_tc7_fluid | (n << 8)));
GC_GENERAL_REGISTER_DISAPPEARING_LINK (&allocated_fluids[n],
SCM2PTR (fluid));
@@ -166,13 +166,19 @@ new_fluid ()
/* Now null out values. We could (and probably should) do this when
the fluid is collected instead of now. */
- scm_i_reset_fluid (n, SCM_BOOL_F);
+ scm_i_reset_fluid (n);
return fluid;
}
-SCM_DEFINE (scm_make_fluid, "make-fluid", 0, 0, 0,
- (),
+SCM
+scm_make_fluid (void)
+{
+ return new_fluid (SCM_BOOL_F);
+}
+
+SCM_DEFINE (scm_make_fluid_with_default, "make-fluid", 0, 1, 0,
+ (SCM dflt),
"Return a newly created fluid.\n"
"Fluids are objects that can hold one\n"
"value per dynamic state. That is, modifications to this value
are\n"
@@ -180,9 +186,9 @@ SCM_DEFINE (scm_make_fluid, "make-fluid", 0, 0, 0,
"the modifying code. When a new dynamic state is constructed, it\n"
"inherits the values from its parent. Because each thread normally
executes\n"
"with its own dynamic state, you can use fluids for thread local
storage.")
-#define FUNC_NAME s_scm_make_fluid
+#define FUNC_NAME s_scm_make_fluid_with_default
{
- return new_fluid ();
+ return new_fluid (SCM_UNBNDP (dflt) ? SCM_BOOL_F : dflt);
}
#undef FUNC_NAME
@@ -191,9 +197,7 @@ SCM_DEFINE (scm_make_unbound_fluid, "make-unbound-fluid",
0, 0, 0,
"Make a fluid that is initially unbound.")
#define FUNC_NAME s_scm_make_unbound_fluid
{
- SCM f = new_fluid ();
- scm_fluid_set_x (f, SCM_UNDEFINED);
- return f;
+ return new_fluid (SCM_UNDEFINED);
}
#undef FUNC_NAME
@@ -217,6 +221,7 @@ scm_is_fluid (SCM obj)
static SCM
fluid_ref (SCM fluid)
{
+ SCM ret;
SCM fluids = DYNAMIC_STATE_FLUIDS (SCM_I_CURRENT_THREAD->dynamic_state);
if (SCM_UNLIKELY (FLUID_NUM (fluid) >= SCM_SIMPLE_VECTOR_LENGTH (fluids)))
@@ -227,7 +232,11 @@ fluid_ref (SCM fluid)
fluids = DYNAMIC_STATE_FLUIDS (SCM_I_CURRENT_THREAD->dynamic_state);
}
- return SCM_SIMPLE_VECTOR_REF (fluids, FLUID_NUM (fluid));
+ ret = SCM_SIMPLE_VECTOR_REF (fluids, FLUID_NUM (fluid));
+ if (SCM_UNBNDP (ret))
+ return SCM_I_FLUID_DEFAULT (fluid);
+ else
+ return ret;
}
SCM_DEFINE (scm_fluid_ref, "fluid-ref", 1, 0, 0,
@@ -274,6 +283,9 @@ SCM_DEFINE (scm_fluid_unset_x, "fluid-unset!", 1, 0, 0,
"Unset the value associated with @var{fluid}.")
#define FUNC_NAME s_scm_fluid_unset_x
{
+ /* FIXME: really unset the default value, too? The current test
+ suite demands it, but I would prefer not to. */
+ SCM_SET_CELL_OBJECT_1 (fluid, SCM_UNDEFINED);
return scm_fluid_set_x (fluid, SCM_UNDEFINED);
}
#undef FUNC_NAME
diff --git a/libguile/fluids.h b/libguile/fluids.h
index 66e3985..2b91ff3 100644
--- a/libguile/fluids.h
+++ b/libguile/fluids.h
@@ -3,7 +3,7 @@
#ifndef SCM_FLUIDS_H
#define SCM_FLUIDS_H
-/* Copyright (C) 1996,2000,2001, 2006, 2008, 2009, 2010 Free Software
Foundation, Inc.
+/* Copyright (C) 1996,2000,2001, 2006, 2008, 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 License
@@ -56,10 +56,12 @@
#define SCM_FLUID_P(x) (!SCM_IMP (x) && SCM_TYP7 (x) == scm_tc7_fluid)
#ifdef BUILDING_LIBGUILE
-#define SCM_I_FLUID_NUM(x) ((size_t)SCM_CELL_WORD_1(x))
+#define SCM_I_FLUID_NUM(x) ((size_t)(SCM_CELL_WORD_0 (x) >> 8))
+#define SCM_I_FLUID_DEFAULT(x) (SCM_CELL_OBJECT_1 (x))
#endif
SCM_API SCM scm_make_fluid (void);
+SCM_API SCM scm_make_fluid_with_default (SCM dflt);
SCM_API SCM scm_make_unbound_fluid (void);
SCM_API int scm_is_fluid (SCM obj);
SCM_API SCM scm_fluid_p (SCM fl);
diff --git a/libguile/load.c b/libguile/load.c
index 21008cb..66e3cc4 100644
--- a/libguile/load.c
+++ b/libguile/load.c
@@ -1043,8 +1043,7 @@ scm_init_load ()
scm_loc_fresh_auto_compile
= SCM_VARIABLE_LOC (scm_c_define ("%fresh-auto-compile", SCM_BOOL_F));
- the_reader = scm_make_fluid ();
- scm_fluid_set_x (the_reader, SCM_BOOL_F);
+ the_reader = scm_make_fluid_with_default (SCM_BOOL_F);
scm_c_define("current-reader", the_reader);
scm_c_define ("load-compiled",
diff --git a/libguile/ports.c b/libguile/ports.c
index 6bb9610..6467228 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -2549,13 +2549,13 @@ scm_init_ports ()
#include "libguile/ports.x"
/* Use Latin-1 as the default port encoding. */
- SCM_VARIABLE_SET (default_port_encoding_var, scm_make_fluid ());
- scm_fluid_set_x (SCM_VARIABLE_REF (default_port_encoding_var), SCM_BOOL_F);
+ SCM_VARIABLE_SET (default_port_encoding_var,
+ scm_make_fluid_with_default (SCM_BOOL_F));
scm_port_encoding_init = 1;
- SCM_VARIABLE_SET (scm_conversion_strategy, scm_make_fluid ());
- scm_fluid_set_x (SCM_VARIABLE_REF (scm_conversion_strategy),
- scm_from_int ((int) SCM_FAILED_CONVERSION_QUESTION_MARK));
+ SCM_VARIABLE_SET (scm_conversion_strategy,
+ scm_make_fluid_with_default
+ (scm_from_int ((int)
SCM_FAILED_CONVERSION_QUESTION_MARK)));
scm_conversion_strategy_init = 1;
}
diff --git a/libguile/read.c b/libguile/read.c
index a9404b1..6166724 100644
--- a/libguile/read.c
+++ b/libguile/read.c
@@ -1759,8 +1759,7 @@ scm_init_read ()
{
SCM read_hash_procs;
- read_hash_procs = scm_make_fluid ();
- scm_fluid_set_x (read_hash_procs, SCM_EOL);
+ read_hash_procs = scm_make_fluid_with_default (SCM_EOL);
scm_i_read_hash_procedures =
SCM_VARIABLE_LOC (scm_c_define ("%read-hash-procedures", read_hash_procs));
diff --git a/libguile/threads.c b/libguile/threads.c
index 7523540..e4d3e21 100644
--- a/libguile/threads.c
+++ b/libguile/threads.c
@@ -478,7 +478,7 @@ static SCM scm_i_default_dynamic_state;
/* Run when a fluid is collected. */
void
-scm_i_reset_fluid (size_t n, SCM val)
+scm_i_reset_fluid (size_t n)
{
scm_i_thread *t;
@@ -489,7 +489,7 @@ scm_i_reset_fluid (size_t n, SCM val)
SCM v = SCM_I_DYNAMIC_STATE_FLUIDS (t->dynamic_state);
if (n < SCM_SIMPLE_VECTOR_LENGTH (v))
- SCM_SIMPLE_VECTOR_SET (v, n, val);
+ SCM_SIMPLE_VECTOR_SET (v, n, SCM_UNDEFINED);
}
scm_i_pthread_mutex_unlock (&thread_admin_mutex);
}
diff --git a/libguile/threads.h b/libguile/threads.h
index edecad8..ec129bc 100644
--- a/libguile/threads.h
+++ b/libguile/threads.h
@@ -136,7 +136,7 @@ SCM_API SCM scm_spawn_thread (scm_t_catch_body body, void
*body_data,
SCM_API void *scm_without_guile (void *(*func)(void *), void *data);
SCM_API void *scm_with_guile (void *(*func)(void *), void *data);
-SCM_INTERNAL void scm_i_reset_fluid (size_t, SCM);
+SCM_INTERNAL void scm_i_reset_fluid (size_t);
SCM_INTERNAL void scm_threads_prehistory (void *);
SCM_INTERNAL void scm_init_threads (void);
SCM_INTERNAL void scm_init_thread_procs (void);
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index 1b4136f..474fe78 100644
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -1660,6 +1660,8 @@ VM_DEFINE_INSTRUCTION (91, fluid_ref, "fluid-ref", 0, 1,
1)
else
{
SCM val = SCM_SIMPLE_VECTOR_REF (fluids, num);
+ if (scm_is_eq (val, SCM_UNDEFINED))
+ val = SCM_I_FLUID_DEFAULT (*sp);
if (SCM_UNLIKELY (scm_is_eq (val, SCM_UNDEFINED)))
{
finish_args = *sp;
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 653c693..5ac01b8 100644
--- a/module/ice-9/boot-9.scm
+++ b/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))))))
diff --git a/module/ice-9/getopt-long.scm b/module/ice-9/getopt-long.scm
index 12f8c94..930ac0d 100644
--- a/module/ice-9/getopt-long.scm
+++ b/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))
diff --git a/module/ice-9/vlist.scm b/module/ice-9/vlist.scm
index 4b40b99..8c7c87b 100644
--- a/module/ice-9/vlist.scm
+++ b/module/ice-9/vlist.scm
@@ -66,9 +66,7 @@
;;;
(define block-growth-factor
- (let ((f (make-fluid)))
- (fluid-set! f 2)
- f))
+ (make-fluid 2))
(define-syntax-rule (define-inline (name formals ...) body ...)
;; Work around the lack of an inliner.
diff --git a/module/language/elisp/runtime.scm
b/module/language/elisp/runtime.scm
index 025dc96..0c84d10 100644
--- a/module/language/elisp/runtime.scm
+++ b/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.
diff --git a/module/srfi/srfi-39.scm b/module/srfi/srfi-39.scm
index dba86fd..d1c46d0 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))
diff --git a/module/system/base/language.scm b/module/system/base/language.scm
index 10d2d74..5b27bc9 100644
--- a/module/system/base/language.scm
+++ b/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*))
diff --git a/module/system/base/message.scm b/module/system/base/message.scm
index 95468ca..aed3502 100644
--- a/module/system/base/message.scm
+++ b/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>
diff --git a/module/system/base/target.scm b/module/system/base/target.scm
index 80d80f3..a81b3d9 100644
--- a/module/system/base/target.scm
+++ b/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))
diff --git a/module/texinfo/plain-text.scm b/module/texinfo/plain-text.scm
index 93a7c1d..87e43e5 100644
--- a/module/texinfo/plain-text.scm
+++ b/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*)
diff --git a/test-suite/lib.scm b/test-suite/lib.scm
index b63c595..ecf3924 100644
--- a/test-suite/lib.scm
+++ b/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))
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.3-33-g9447207,
Andy Wingo <=