summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMarius Vollmer <mvo@zagadka.de>1997-07-26 20:08:42 +0000
committerMarius Vollmer <mvo@zagadka.de>1997-07-26 20:08:42 +0000
commitb3460a507a040d881bd02a6427fced74ba149527 (patch)
tree894832da24244b2635e60e07b1b960d94eee0f53
parent485cb6eb4f36c31f737532e3baf55bf459ae0d61 (diff)
downloadguile-b3460a507a040d881bd02a6427fced74ba149527.tar.gz
* dynwind.c (scm_dowinds): Handle fluids on the wind list.
* fluids.h (scm_internal_with_fluids, scm_with_fluids, scm_swap_fluids, scm_swap_fluids_reverse): New prototypes. * fluids.c (scm_internal_with_fluids, scm_with_fluids, scm_swap_fluids, scm_swap_fluids_reverse): New functions.
-rw-r--r--libguile/dynwind.c32
-rw-r--r--libguile/fluids.c88
-rw-r--r--libguile/fluids.h14
3 files changed, 122 insertions, 12 deletions
diff --git a/libguile/dynwind.c b/libguile/dynwind.c
index cd32158b1..9cbee31ea 100644
--- a/libguile/dynwind.c
+++ b/libguile/dynwind.c
@@ -44,12 +44,23 @@
#include "_scm.h"
#include "eval.h"
#include "alist.h"
+#include "fluids.h"
#include "dynwind.h"
/* {Dynamic wind}
- */
+
+ Things that can be on the wind list:
+
+ (enter-proc . leave-proc) dynamic-wind
+ (tag . jmpbuf) catch
+ (tag . lazy-catch) lazy-catch
+ tag is either a symbol or a boolean
+
+ ((fluid ...) . (value ...)) with-fluids
+
+*/
@@ -94,10 +105,15 @@ scm_dowinds (to, delta)
#endif
{
wind_key = SCM_CAR (wind_elt);
- if ( !(SCM_NIMP (wind_key) && SCM_SYMBOLP (wind_key))
+ if (!(SCM_NIMP (wind_key) && SCM_SYMBOLP (wind_key))
&& (wind_key != SCM_BOOL_F)
&& (wind_key != SCM_BOOL_T))
- scm_apply (wind_key, SCM_EOL, SCM_EOL);
+ {
+ if (SCM_NIMP (wind_key) && SCM_CONSP (wind_key))
+ scm_swap_fluids (wind_key, SCM_CDR (wind_elt));
+ else
+ scm_apply (wind_key, SCM_EOL, SCM_EOL);
+ }
}
scm_dynwinds = to;
}
@@ -119,10 +135,15 @@ scm_dowinds (to, delta)
#endif
{
wind_key = SCM_CAR (wind_elt);
- if ( !(SCM_NIMP (wind_key) && SCM_SYMBOLP (wind_key))
+ if (!(SCM_NIMP (wind_key) && SCM_SYMBOLP (wind_key))
&& (wind_key != SCM_BOOL_F)
&& (wind_key != SCM_BOOL_T))
- scm_apply (from, SCM_EOL, SCM_EOL);
+ {
+ if (SCM_NIMP (wind_key) && SCM_CONSP (wind_key))
+ scm_swap_fluids_reverse (wind_key, from);
+ else
+ scm_apply (from, SCM_EOL, SCM_EOL);
+ }
}
delta--;
goto tail; /* scm_dowinds(to, delta-1); */
@@ -136,4 +157,3 @@ scm_init_dynwind ()
{
#include "dynwind.x"
}
-
diff --git a/libguile/fluids.c b/libguile/fluids.c
index e71cb5bbf..91419d8eb 100644
--- a/libguile/fluids.c
+++ b/libguile/fluids.c
@@ -44,7 +44,10 @@
#include "_scm.h"
#include "print.h"
#include "smob.h"
+#include "dynwind.h"
#include "fluids.h"
+#include "alist.h"
+#include "eval.h"
#define INITIAL_FLUIDS 10
@@ -146,6 +149,15 @@ scm_make_fluid ()
return z;
}
+SCM_PROC (s_fluid_p, "fluid?", 1, 0, 0, scm_fluid_p);
+
+SCM
+scm_fluid_p (fl)
+ SCM fl;
+{
+ return (SCM_NIMP (fl) && SCM_FLUIDP (fl))? SCM_BOOL_T : SCM_BOOL_F;
+}
+
SCM_PROC (s_fluid_ref, "fluid-ref", 1, 0, 0, scm_fluid_ref);
SCM
@@ -154,7 +166,7 @@ scm_fluid_ref (fl)
{
int n;
- SCM_ASSERT (SCM_NIMP (fl) && SCM_FLUIDP (fl), SCM_ARG1, fl, s_fluid_ref);
+ SCM_ASSERT (SCM_NIMP (fl) && SCM_FLUIDP (fl), fl, SCM_ARG1, s_fluid_ref);
n = SCM_FLUID_NUM (fl);
assert (n >= 0 && n < n_fluids);
@@ -173,7 +185,7 @@ scm_fluid_set_x (fl, val)
{
int n;
- SCM_ASSERT (SCM_NIMP (fl) && SCM_FLUIDP (fl), SCM_ARG1, fl, s_fluid_set_x);
+ SCM_ASSERT (SCM_NIMP (fl) && SCM_FLUIDP (fl), fl, SCM_ARG1, s_fluid_set_x);
n = SCM_FLUID_NUM (fl);
assert (n >= 0 && n < n_fluids);
@@ -185,6 +197,78 @@ scm_fluid_set_x (fl, val)
}
void
+scm_swap_fluids (fluids, vals)
+ SCM fluids, vals;
+{
+ while (SCM_NIMP (fluids))
+ {
+ SCM fl = SCM_CAR (fluids);
+ SCM old_val = scm_fluid_ref (fl);
+ scm_fluid_set_x (fl, SCM_CAR (vals));
+ SCM_SETCAR (vals, old_val);
+ fluids = SCM_CDR (fluids);
+ vals = SCM_CDR (vals);
+ }
+}
+
+/* Swap the fluid values in reverse order. This is important when the
+same fluid appears multiple times in the fluids list. */
+
+void
+scm_swap_fluids_reverse (fluids, vals)
+ SCM fluids, vals;
+{
+ if (SCM_NIMP (fluids))
+ {
+ SCM fl, old_val;
+
+ scm_swap_fluids_reverse (SCM_CDR (fluids), SCM_CDR (vals));
+ fl = SCM_CAR (fluids);
+ old_val = scm_fluid_ref (fl);
+ scm_fluid_set_x (fl, SCM_CAR (vals));
+ SCM_SETCAR (vals, old_val);
+ }
+}
+
+SCM_PROC (s_with_fluids, "with-fluids*", 3, 0, 0, scm_with_fluids);
+
+SCM
+scm_internal_with_fluids (fluids, vals, cproc, cdata)
+ SCM fluids, vals;
+ SCM (*cproc) ();
+ void *cdata;
+{
+ SCM ans;
+
+ int flen = scm_ilength (fluids);
+ int vlen = scm_ilength (vals);
+ SCM_ASSERT (flen >= 0, fluids, SCM_ARG1, s_with_fluids);
+ SCM_ASSERT (vlen >= 0, vals, SCM_ARG2, s_with_fluids);
+ if (flen != vlen)
+ scm_out_of_range (s_with_fluids, vals);
+
+ scm_swap_fluids (fluids, vals);
+ scm_dynwinds = scm_acons (fluids, vals, scm_dynwinds);
+ ans = cproc (cdata);
+ scm_dynwinds = SCM_CDR (scm_dynwinds);
+ scm_swap_fluids_reverse (fluids, vals);
+ return ans;
+}
+
+static SCM
+apply_thunk (void *thunk)
+{
+ return scm_apply ((SCM) thunk, SCM_EOL, SCM_EOL);
+}
+
+SCM
+scm_with_fluids (fluids, vals, thunk)
+ SCM fluids, vals, thunk;
+{
+ return scm_internal_with_fluids (fluids, vals, apply_thunk, (void *)thunk);
+}
+
+void
scm_init_fluids ()
{
scm_tc16_fluid = scm_newsmob(&fluid_smob);
diff --git a/libguile/fluids.h b/libguile/fluids.h
index 6972e0bc0..cfa76dbbd 100644
--- a/libguile/fluids.h
+++ b/libguile/fluids.h
@@ -62,10 +62,10 @@
to index a vector that holds the values of all fluids. Each root
has its own vector.
- Currently, you can't get rid a certain fluid if you don't use any
- longer. The slot that has been allocated for it in the fluid
+ Currently, you can't get rid a certain fluid if you don't use it
+ any longer. The slot that has been allocated for it in the fluid
vector will not be reused for other fluids. Therefore, only use
- SCM_MAKE_FLUID or it Scheme variant `make-fluid' in initialization
+ SCM_MAKE_FLUID or its Scheme variant `make-fluid' in initialization
code that is only run once. Nevertheless, it should be possible to
implement a more lightweight version of fluids on top of this basic
mechanism. */
@@ -76,7 +76,7 @@ extern long scm_tc16_fluid;
#define SCM_FLUID_NUM(x) SCM_CDR(x)
/* The fastest way to acces/modify the value of a fluid. These macros
-does no error checking at all. You should only use them when you know
+do no error checking at all. You should only use them when you know
that the relevant fluid already exists in the current dynamic root.
The easiest way to ensure this is to execute a SCM_FLUID_SET_X in the
topmost root, for example right after SCM_MAKE_FLUID in your
@@ -91,8 +91,14 @@ SCM scm_make_fluid SCM_P ((void));
SCM scm_fluid_ref SCM_P ((SCM fluid));
SCM scm_fluid_set_x SCM_P ((SCM fluid, SCM value));
+SCM scm_internal_with_fluids SCM_P ((SCM fluids, SCM vals,
+ SCM (*cproc)(void *), void *cdata));
+SCM scm_with_fluids SCM_P ((SCM fluids, SCM vals, SCM thunk));
+
SCM scm_make_initial_fluids SCM_P ((void));
void scm_copy_fluids SCM_P ((scm_root_state *));
+void scm_swap_fluids SCM_P ((SCM fluids, SCM vals));
+void scm_swap_fluids_reverse SCM_P ((SCM fluids, SCM vals));
void scm_init_fluids SCM_P ((void));