summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/fluids.c55
-rw-r--r--libguile/fluids.h3
2 files changed, 43 insertions, 15 deletions
diff --git a/libguile/fluids.c b/libguile/fluids.c
index 7be538f9d..3f5591759 100644
--- a/libguile/fluids.c
+++ b/libguile/fluids.c
@@ -152,9 +152,11 @@ SCM_DEFINE (scm_fluid_set_x, "fluid-set!", 2, 0, 0,
}
#undef FUNC_NAME
-void
-scm_i_swap_fluids (SCM fluids, SCM vals)
+static void
+swap_fluids (SCM data)
{
+ SCM fluids = SCM_CAR (data), vals = SCM_CDR (data);
+
while (!SCM_NULL_OR_NIL_P (fluids))
{
SCM fl = SCM_CAR (fluids);
@@ -169,14 +171,14 @@ scm_i_swap_fluids (SCM fluids, SCM vals)
/* Swap the fluid values in reverse order. This is important when the
same fluid appears multiple times in the fluids list. */
-void
-scm_i_swap_fluids_reverse (SCM fluids, SCM vals)
+static void
+swap_fluids_reverse_aux (SCM fluids, SCM vals)
{
if (!SCM_NULL_OR_NIL_P (fluids))
{
SCM fl, old_val;
- scm_i_swap_fluids_reverse (SCM_CDR (fluids), SCM_CDR (vals));
+ swap_fluids_reverse_aux (SCM_CDR (fluids), SCM_CDR (vals));
fl = SCM_CAR (fluids);
old_val = scm_fluid_ref (fl);
scm_fluid_set_x (fl, SCM_CAR (vals));
@@ -184,6 +186,11 @@ scm_i_swap_fluids_reverse (SCM fluids, SCM vals)
}
}
+static void
+swap_fluids_reverse (SCM data)
+{
+ swap_fluids_reverse_aux (SCM_CAR (data), SCM_CDR (data));
+}
static SCM
apply_thunk (void *thunk)
@@ -199,7 +206,8 @@ SCM_DEFINE (scm_with_fluids, "with-fluids*", 3, 0, 0,
"one after another. @var{thunk} must be a procedure with no argument.")
#define FUNC_NAME s_scm_with_fluids
{
- return scm_c_with_fluids (fluids, values, apply_thunk, (void *) SCM_UNPACK (thunk));
+ return scm_c_with_fluids (fluids, values,
+ apply_thunk, (void *) SCM_UNPACK (thunk));
}
#undef FUNC_NAME
@@ -207,7 +215,7 @@ SCM
scm_c_with_fluids (SCM fluids, SCM values, SCM (*cproc) (), void *cdata)
#define FUNC_NAME "scm_c_with_fluids"
{
- SCM ans;
+ SCM ans, data;
long flen, vlen;
SCM_VALIDATE_LIST_COPYLEN (1, fluids, flen);
@@ -215,21 +223,42 @@ scm_c_with_fluids (SCM fluids, SCM values, SCM (*cproc) (), void *cdata)
if (flen != vlen)
scm_out_of_range (s_scm_with_fluids, values);
- scm_i_swap_fluids (fluids, values);
- scm_dynwinds = scm_acons (fluids, values, scm_dynwinds);
+ if (flen == 1)
+ return scm_c_with_fluid (SCM_CAR (fluids), SCM_CAR (values),
+ cproc, cdata);
+
+ data = scm_cons (fluids, values);
+ scm_frame_begin (SCM_F_FRAME_REWINDABLE);
+ scm_frame_rewind_with_scm (swap_fluids, data, SCM_F_WIND_EXPLICITLY);
+ scm_frame_unwind_with_scm (swap_fluids_reverse, data, SCM_F_WIND_EXPLICITLY);
ans = cproc (cdata);
- scm_dynwinds = SCM_CDR (scm_dynwinds);
- scm_i_swap_fluids_reverse (fluids, values);
+ scm_frame_end ();
return ans;
}
#undef FUNC_NAME
+SCM_DEFINE (scm_with_fluid, "with-fluid*", 3, 0, 0,
+ (SCM fluid, SCM value, SCM thunk),
+ "Set @var{fluid} to @var{value} temporarily, and call @var{thunk}.\n"
+ "@var{thunk} must be a procedure with no argument.")
+#define FUNC_NAME s_scm_with_fluid
+{
+ return scm_c_with_fluid (fluid, value,
+ apply_thunk, (void *) SCM_UNPACK (thunk));
+}
+#undef FUNC_NAME
+
SCM
scm_c_with_fluid (SCM fluid, SCM value, SCM (*cproc) (), void *cdata)
#define FUNC_NAME "scm_c_with_fluid"
{
- return scm_c_with_fluids (scm_list_1 (fluid), scm_list_1 (value),
- cproc, cdata);
+ SCM ans;
+
+ scm_frame_begin (SCM_F_FRAME_REWINDABLE);
+ scm_frame_fluid (fluid, value);
+ ans = cproc (cdata);
+ scm_frame_end ();
+ return ans;
}
#undef FUNC_NAME
diff --git a/libguile/fluids.h b/libguile/fluids.h
index 8a5150e83..cb4fba4bd 100644
--- a/libguile/fluids.h
+++ b/libguile/fluids.h
@@ -75,13 +75,12 @@ SCM_API SCM scm_c_with_fluids (SCM fluids, SCM vals,
SCM_API SCM scm_c_with_fluid (SCM fluid, SCM val,
SCM (*cproc)(void *), void *cdata);
SCM_API SCM scm_with_fluids (SCM fluids, SCM vals, SCM thunk);
+SCM_API SCM scm_with_fluid (SCM fluid, SCM val, SCM thunk);
SCM_API void scm_frame_fluid (SCM fluid, SCM value);
SCM_API SCM scm_i_make_initial_fluids (void);
SCM_API void scm_i_copy_fluids (scm_root_state *);
-SCM_API void scm_i_swap_fluids (SCM fluids, SCM vals);
-SCM_API void scm_i_swap_fluids_reverse (SCM fluids, SCM vals);
SCM_API void scm_init_fluids (void);