diff options
author | Brian Templeton <bpt@hcoop.net> | 2010-08-14 18:35:17 -0400 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2010-12-07 13:21:01 +0100 |
commit | ef94624eaf549ca9c730d4650b9dfed2ee48521b (patch) | |
tree | 5cc8343605d2fa9e9aac28bd3328ab71cdb01e7b /libguile/fluids.c | |
parent | d1079217947013dac495a95e433ad5da9f7aa80a (diff) | |
download | guile-ef94624eaf549ca9c730d4650b9dfed2ee48521b.tar.gz |
unbound fluids
* libguile/fluids.c (scm_make_undefined_fluid, scm_fluid_unset_x)
(scm_fluid_bound_p): New functions.
(fluid_ref): New function; like scm_fluid_ref, but will not throw an
error for unbound fluids.
(scm_fluid_ref, swap_fluid): Use `fluid_ref'.
* libguile/fluids.h (scm_make_undefined_fluid, scm_fluid_unset_x)
(scm_fluid_bound_p): New prototypes.
* libguile/vm-i-system.c (fluid_ref): If fluid is unbound, jump to
`vm_error_unbound_fluid'.
* libguile/vm-engine.c (VM_NAME)[vm_error_unbound_fluid]: New error
message.
* test-suite/tests/fluids.test ("unbound fluids")["fluid-ref of unbound
fluid", "fluid-bound? of bound fluid", "fluid-bound? of unbound
fluid", "unbound fluids can be set", "bound fluids can be unset"]: New
tests.
Diffstat (limited to 'libguile/fluids.c')
-rw-r--r-- | libguile/fluids.c | 64 |
1 files changed, 53 insertions, 11 deletions
diff --git a/libguile/fluids.c b/libguile/fluids.c index 8b31c85c6..6d048a005 100644 --- a/libguile/fluids.c +++ b/libguile/fluids.c @@ -181,6 +181,17 @@ SCM_DEFINE (scm_make_fluid, "make-fluid", 0, 0, 0, } #undef FUNC_NAME +SCM_DEFINE (scm_make_undefined_fluid, "make-undefined-fluid", 0, 0, 0, + (), + "") +#define FUNC_NAME s_scm_make_undefined_fluid +{ + SCM f = new_fluid (); + scm_fluid_set_x (f, SCM_UNDEFINED); + return f; +} +#undef FUNC_NAME + SCM_DEFINE (scm_fluid_p, "fluid?", 1, 0, 0, (SCM obj), "Return @code{#t} iff @var{obj} is a fluid; otherwise, return\n" @@ -197,19 +208,12 @@ scm_is_fluid (SCM obj) return IS_FLUID (obj); } - - -SCM_DEFINE (scm_fluid_ref, "fluid-ref", 1, 0, 0, - (SCM fluid), - "Return the value associated with @var{fluid} in the current\n" - "dynamic root. If @var{fluid} has not been set, then return\n" - "@code{#f}.") -#define FUNC_NAME s_scm_fluid_ref +/* Does not check type of `fluid'! */ +static SCM +fluid_ref (SCM fluid) { SCM fluids = DYNAMIC_STATE_FLUIDS (SCM_I_CURRENT_THREAD->dynamic_state); - SCM_VALIDATE_FLUID (1, fluid); - if (SCM_UNLIKELY (FLUID_NUM (fluid) >= SCM_SIMPLE_VECTOR_LENGTH (fluids))) { /* Lazily grow the current thread's dynamic state. */ @@ -220,6 +224,22 @@ SCM_DEFINE (scm_fluid_ref, "fluid-ref", 1, 0, 0, return SCM_SIMPLE_VECTOR_REF (fluids, FLUID_NUM (fluid)); } + +SCM_DEFINE (scm_fluid_ref, "fluid-ref", 1, 0, 0, + (SCM fluid), + "Return the value associated with @var{fluid} in the current\n" + "dynamic root. If @var{fluid} has not been set, then return\n" + "@code{#f}.") +#define FUNC_NAME s_scm_fluid_ref +{ + SCM val; + SCM_VALIDATE_FLUID (1, fluid); + val = fluid_ref (fluid); + if (SCM_UNBNDP (val)) + SCM_MISC_ERROR ("unbound fluid: ~S", + scm_list_1 (fluid)); + return val; +} #undef FUNC_NAME SCM_DEFINE (scm_fluid_set_x, "fluid-set!", 2, 0, 0, @@ -244,6 +264,28 @@ SCM_DEFINE (scm_fluid_set_x, "fluid-set!", 2, 0, 0, } #undef FUNC_NAME +SCM_DEFINE (scm_fluid_unset_x, "fluid-unset!", 1, 0, 0, + (SCM fluid), + "Unset the value associated with @var{fluid}.") +#define FUNC_NAME s_scm_fluid_unset_x +{ + return scm_fluid_set_x (fluid, SCM_UNDEFINED); +} +#undef FUNC_NAME + +SCM_DEFINE (scm_fluid_bound_p, "fluid-bound?", 1, 0, 0, + (SCM fluid), + "Return @code{#t} iff @var{fluid} is bound to a value.\n" + "Throw an error if @var{fluid} is not a fluid.") +#define FUNC_NAME s_scm_fluid_bound_p +{ + SCM val; + SCM_VALIDATE_FLUID (1, fluid); + val = fluid_ref (fluid); + return scm_from_bool (! (SCM_UNBNDP (val))); +} +#undef FUNC_NAME + static SCM apply_thunk (void *thunk) { @@ -406,7 +448,7 @@ static void swap_fluid (SCM data) { SCM f = SCM_CAR (data); - SCM t = scm_fluid_ref (f); + SCM t = fluid_ref (f); scm_fluid_set_x (f, SCM_CDR (data)); SCM_SETCDR (data, t); } |