summaryrefslogtreecommitdiff
path: root/libguile/fluids.c
diff options
context:
space:
mode:
authorBrian Templeton <bpt@hcoop.net>2010-08-14 18:35:17 -0400
committerAndy Wingo <wingo@pobox.com>2010-12-07 13:21:01 +0100
commitef94624eaf549ca9c730d4650b9dfed2ee48521b (patch)
tree5cc8343605d2fa9e9aac28bd3328ab71cdb01e7b /libguile/fluids.c
parentd1079217947013dac495a95e433ad5da9f7aa80a (diff)
downloadguile-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.c64
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);
}