From bb0229b51d53c10164f58cebbeeed85cd9dfe0b8 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Thu, 18 Feb 2010 17:10:29 +0100 Subject: add with-fluids objects and primitive syntax * libguile/tags.h (scm_tc7_with_fluids): Allocate a tc7 for "with-fluids" objects, which will only live on the dynamic stack (wind list), not in normal scheme-land. * libguile/fluids.h (SCM_WITH_FLUIDS_P, SCM_WITH_FLUIDS_LEN) (SCM_WITH_FLUIDS_NTH_FLUID, SCM_WITH_FLUIDS_NTH_VAL) (SCM_WITH_FLUIDS_SET_NTH_VAL): Add some accessors. * libguile/fluids.c (scm_i_make_with_fluids, scm_i_swap_with_fluids): New internal functions. (scm_c_with_fluids, scm_c_with_fluid): Push with-fluids objects on the dynwind list, not winders. * libguile/dynwind.c (scm_i_dowinds): Add cases for winding and unwinding with-fluids objects. * libguile/memoize.h (scm_sym_with_fluids, SCM_M_BEGIN): New public data. * libguile/memoize.c (scm_m_with_fluids): Define with-fluids as a primitive syntax. (unmemoize): Add with-fluids case. * libguile/eval.c (eval): * module/ice-9/eval.scm (primitive-eval): Add with-fluids cases. * test-suite/tests/fluids.test ("fluids not modified if nonfluid passed to with-fluids"): Enable a now-passing test. --- libguile/eval.c | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) (limited to 'libguile/eval.c') diff --git a/libguile/eval.c b/libguile/eval.c index ea8a77153..48eb09e93 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -229,6 +229,28 @@ eval (SCM x, SCM env) return res; } + case SCM_M_WITH_FLUIDS: + { + long i, len; + SCM *fluidv, *valuesv, walk, wf, res; + len = scm_ilength (CAR (mx)); + fluidv = alloca (sizeof (SCM)*len); + for (i = 0, walk = CAR (mx); i < len; i++, walk = CDR (walk)) + fluidv[i] = eval (CAR (walk), env); + valuesv = alloca (sizeof (SCM)*len); + for (i = 0, walk = CADR (mx); i < len; i++, walk = CDR (walk)) + valuesv[i] = eval (CAR (walk), env); + + wf = scm_i_make_with_fluids (len, fluidv, valuesv); + scm_i_swap_with_fluids (wf, SCM_I_CURRENT_THREAD->dynamic_state); + scm_i_set_dynwinds (scm_cons (wf, scm_i_dynwinds ())); + res = eval (CDDR (mx), env); + scm_i_swap_with_fluids (wf, SCM_I_CURRENT_THREAD->dynamic_state); + scm_i_set_dynwinds (CDR (scm_i_dynwinds ())); + + return res; + } + case SCM_M_APPLY: /* Evaluate the procedure to be applied. */ proc = eval (CAR (mx), env); -- cgit v1.2.3