mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

add with-fluids objects and primitive syntax

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2010-02-18 17:10:29 +01:00
parent 27bd1deced
commit bb0229b51d
9 changed files with 206 additions and 61 deletions
Download patch file Download diff file Expand all files Collapse all files

22
libguile/eval.c
View file

@ -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);