summaryrefslogtreecommitdiff
path: root/libguile/fluids.c
diff options
context:
space:
mode:
Diffstat (limited to 'libguile/fluids.c')
-rw-r--r--libguile/fluids.c107
1 files changed, 51 insertions, 56 deletions
diff --git a/libguile/fluids.c b/libguile/fluids.c
index ee7651d5f..edcaa199c 100644
--- a/libguile/fluids.c
+++ b/libguile/fluids.c
@@ -39,6 +39,10 @@
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice. */
+/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
+ gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
+
+
#include "_scm.h"
#include "print.h"
#include "smob.h"
@@ -49,6 +53,7 @@
#include "eval.h"
#define INITIAL_FLUIDS 10
+#include "scm_validate.h"
static volatile int n_fluids;
long scm_tc16_fluid;
@@ -60,11 +65,8 @@ scm_make_initial_fluids ()
SCM_BOOL_F);
}
-static void grow_fluids SCM_P ((scm_root_state *, int new_length));
static void
-grow_fluids (root_state, new_length)
- scm_root_state *root_state;
- int new_length;
+grow_fluids (scm_root_state *root_state,int new_length)
{
SCM old_fluids, new_fluids;
int old_length, i;
@@ -94,12 +96,8 @@ scm_copy_fluids (root_state)
grow_fluids (root_state, SCM_LENGTH(root_state->fluids));
}
-static int print_fluid SCM_P ((SCM exp, SCM port, scm_print_state *pstate));
static int
-print_fluid (exp, port, pstate)
- SCM exp;
- SCM port;
- scm_print_state *pstate;
+print_fluid (SCM exp, SCM port, scm_print_state *pstate)
{
scm_puts ("#<fluid ", port);
scm_intprint (SCM_FLUID_NUM (exp), 10, port);
@@ -121,10 +119,10 @@ int next_fluid_num ()
return n;
}
-SCM_PROC (s_make_fluid, "make-fluid", 0, 0, 0, scm_make_fluid);
-
-SCM
-scm_make_fluid ()
+GUILE_PROC (scm_make_fluid, "make-fluid", 0, 0, 0,
+ (),
+"")
+#define FUNC_NAME s_scm_make_fluid
{
int n;
@@ -132,25 +130,25 @@ scm_make_fluid ()
n = next_fluid_num ();
SCM_RETURN_NEWSMOB (scm_tc16_fluid, n);
}
+#undef FUNC_NAME
-SCM_PROC (s_fluid_p, "fluid?", 1, 0, 0, scm_fluid_p);
-
-SCM
-scm_fluid_p (fl)
- SCM fl;
+GUILE_PROC (scm_fluid_p, "fluid?", 1, 0, 0,
+ (SCM fl),
+"")
+#define FUNC_NAME s_scm_fluid_p
{
- return (SCM_NIMP (fl) && SCM_FLUIDP (fl))? SCM_BOOL_T : SCM_BOOL_F;
+ return SCM_BOOL(SCM_NIMP (fl) && SCM_FLUIDP (fl));
}
+#undef FUNC_NAME
-SCM_PROC (s_fluid_ref, "fluid-ref", 1, 0, 0, scm_fluid_ref);
-
-SCM
-scm_fluid_ref (fl)
- SCM fl;
+GUILE_PROC (scm_fluid_ref, "fluid-ref", 1, 0, 0,
+ (SCM fl),
+"")
+#define FUNC_NAME s_scm_fluid_ref
{
int n;
- SCM_ASSERT (SCM_NIMP (fl) && SCM_FLUIDP (fl), fl, SCM_ARG1, s_fluid_ref);
+ SCM_VALIDATE_FLUID(1,fl);
n = SCM_FLUID_NUM (fl);
@@ -158,18 +156,16 @@ scm_fluid_ref (fl)
grow_fluids (scm_root, n+1);
return SCM_VELTS(scm_root->fluids)[n];
}
+#undef FUNC_NAME
-SCM_PROC (s_fluid_set_x, "fluid-set!", 2, 0, 0, scm_fluid_set_x);
-
-SCM
-scm_fluid_set_x (fl, val)
- SCM fl;
- SCM val;
+GUILE_PROC (scm_fluid_set_x, "fluid-set!", 2, 0, 0,
+ (SCM fl, SCM val),
+"")
+#define FUNC_NAME s_scm_fluid_set_x
{
int n;
- SCM_ASSERT (SCM_NIMP (fl) && SCM_FLUIDP (fl), fl, SCM_ARG1, s_fluid_set_x);
-
+ SCM_VALIDATE_FLUID(1,fl);
n = SCM_FLUID_NUM (fl);
if (SCM_LENGTH (scm_root->fluids) <= n)
@@ -177,10 +173,10 @@ scm_fluid_set_x (fl, val)
SCM_VELTS(scm_root->fluids)[n] = val;
return val;
}
+#undef FUNC_NAME
void
-scm_swap_fluids (fluids, vals)
- SCM fluids, vals;
+scm_swap_fluids (SCM fluids, SCM vals)
{
while (SCM_NIMP (fluids))
{
@@ -197,8 +193,7 @@ scm_swap_fluids (fluids, vals)
same fluid appears multiple times in the fluids list. */
void
-scm_swap_fluids_reverse (fluids, vals)
- SCM fluids, vals;
+scm_swap_fluids_reverse (SCM fluids, SCM vals)
{
if (SCM_NIMP (fluids))
{
@@ -212,22 +207,33 @@ scm_swap_fluids_reverse (fluids, vals)
}
}
-SCM_PROC (s_with_fluids, "with-fluids*", 3, 0, 0, scm_with_fluids);
+
+static SCM
+apply_thunk (void *thunk)
+{
+ return scm_apply ((SCM) thunk, SCM_EOL, SCM_EOL);
+}
+
+GUILE_PROC (scm_with_fluids, "with-fluids*", 3, 0, 0,
+ (SCM fluids, SCM vals, SCM thunk),
+"")
+#define FUNC_NAME s_scm_with_fluids
+{
+ return scm_internal_with_fluids (fluids, vals, apply_thunk, (void *)thunk);
+}
+#undef FUNC_NAME
SCM
-scm_internal_with_fluids (fluids, vals, cproc, cdata)
- SCM fluids, vals;
- SCM (*cproc) ();
- void *cdata;
+scm_internal_with_fluids (SCM fluids, SCM 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);
+ SCM_ASSERT (flen >= 0, fluids, SCM_ARG1, s_scm_with_fluids);
+ SCM_ASSERT (vlen >= 0, vals, SCM_ARG2, s_scm_with_fluids);
if (flen != vlen)
- scm_out_of_range (s_with_fluids, vals);
+ scm_out_of_range (s_scm_with_fluids, vals);
scm_swap_fluids (fluids, vals);
scm_dynwinds = scm_acons (fluids, vals, scm_dynwinds);
@@ -237,18 +243,7 @@ scm_internal_with_fluids (fluids, vals, cproc, cdata)
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 ()