summaryrefslogtreecommitdiff
path: root/libguile/fluids.c
diff options
context:
space:
mode:
Diffstat (limited to 'libguile/fluids.c')
-rw-r--r--libguile/fluids.c47
1 files changed, 46 insertions, 1 deletions
diff --git a/libguile/fluids.c b/libguile/fluids.c
index 72c75952d..7daad7781 100644
--- a/libguile/fluids.c
+++ b/libguile/fluids.c
@@ -148,6 +148,16 @@ save_dynamic_state (scm_t_dynamic_state *state)
}
static SCM
+saved_dynamic_state_ref (SCM saved, SCM fluid, SCM dflt)
+{
+ for (; scm_is_pair (saved); saved = SCM_CDR (saved))
+ if (scm_is_eq (SCM_CAAR (saved), fluid))
+ return SCM_CDAR (saved);
+
+ return scm_weak_table_refq (saved, fluid, dflt);
+}
+
+static SCM
add_entry (void *data, SCM k, SCM v, SCM result)
{
scm_weak_table_putq_x (result, k, v);
@@ -300,7 +310,7 @@ 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}.")
+ "its default value.")
#define FUNC_NAME s_scm_fluid_ref
{
SCM ret;
@@ -312,6 +322,33 @@ SCM_DEFINE (scm_fluid_ref, "fluid-ref", 1, 0, 0,
}
#undef FUNC_NAME
+SCM_DEFINE (scm_fluid_ref_star, "fluid-ref*", 2, 0, 0,
+ (SCM fluid, SCM depth),
+ "Return the @var{depth}th oldest value associated with\n"
+ "@var{fluid} in the current thread. If @var{depth} equals\n"
+ "or exceeds the number of values that have been assigned to\n"
+ "@var{fluid}, return the default value of the fluid.")
+#define FUNC_NAME s_scm_fluid_ref_star
+{
+ SCM ret;
+ size_t c_depth;
+
+ SCM_VALIDATE_FLUID (1, fluid);
+ c_depth = SCM_NUM2SIZE (2, depth);
+
+ if (c_depth == 0)
+ ret = fluid_ref (SCM_I_CURRENT_THREAD->dynamic_state, fluid);
+ else
+ ret = scm_dynstack_find_old_fluid_value (&SCM_I_CURRENT_THREAD->dynstack,
+ fluid, c_depth - 1,
+ SCM_I_FLUID_DEFAULT (fluid));
+
+ if (SCM_UNBNDP (ret))
+ scm_misc_error ("fluid-ref*", "unbound fluid: ~S", scm_list_1 (fluid));
+ return ret;
+}
+#undef FUNC_NAME
+
SCM_DEFINE (scm_fluid_set_x, "fluid-set!", 2, 0, 0,
(SCM fluid, SCM value),
"Set the value associated with @var{fluid} in the current dynamic root.")
@@ -499,6 +536,14 @@ SCM_DEFINE (scm_set_current_dynamic_state, "set-current-dynamic-state", 1,0,0,
}
#undef FUNC_NAME
+SCM
+scm_dynamic_state_ref (SCM state, SCM fluid, SCM dflt)
+{
+ SCM_ASSERT (is_dynamic_state (state), state, SCM_ARG1,
+ "dynamic-state-ref");
+ return saved_dynamic_state_ref (get_dynamic_state (state), fluid, dflt);
+}
+
static void
swap_dynamic_state (SCM loc)
{