diff options
author | Andy Wingo <wingo@pobox.com> | 2013-06-28 19:47:03 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2013-06-28 19:52:09 +0200 |
commit | c32b7c4cef1c63a677a1c447a0386e90ab2ecd42 (patch) | |
tree | a1e1aad96639736f3e18c48a73a6f9d1fd24bacc /libguile | |
parent | 5e0253f19ef146c46a08fead9d70866f4baa9ca1 (diff) | |
download | guile-c32b7c4cef1c63a677a1c447a0386e90ab2ecd42.tar.gz |
Remove with-fluids; replaced by with-fluid* and inlined push-fluid primops
* libguile/vm-i-system.c (push-fluid, pop-fluid):
* doc/ref/vm.texi (Dynamic Environment Instructions): Rename wind-fluids
to push-fluid, and unwind-fluids to pop-fluid. They now only work on
one fluid binding at a time.
* module/ice-9/boot-9.scm (with-fluid*): Implement in Scheme in terms of
primcalls to push-fluid and pop-fluid.
(custom-throw-handler, catch, with-throw-handler): Use with-fluid*
instead of with-fluids, as with-fluids is no longer available before
psyntax is loaded.
(with-fluids): Define in Scheme in terms of with-fluid*.
* libguile/fluids.c (scm_with_fluid): Rename from scm_with_fluids, and
don't expose to Scheme.
* libguile/eval.c (eval): Remove SCM_M_WITH_FLUIDS case.
* libguile/expand.c (expand_with_fluids): Remove with-fluids syntax.
(DYNLET): Remove, no longer defining dynlet in the %expanded-vtables.
* libguile/expand.h: Remove dynlet definitions.
* module/ice-9/eval.scm (primitive-eval): Remove with-fluids case.
* libguile/memoize.c (do_push_fluid, do_pop_fluid): New primitive
helpers, like wind and unwind.
(memoize): Memoize wind and unwind primcalls. Don't memoize dynlet to
with-fluids.
(scm_init_memoize): Initialize push_fluid and pop_fluid here.
* libguile/memoize.h (SCM_M_WITH_FLUIDS): Remove definition.
* module/ice-9/psyntax.scm (build-dynlet): Remove; this just supported
with-fluids, which is now defined in boot-9.
* module/ice-9/psyntax-pp.scm: Regenerate.
* doc/ref/compiler.texi (Tree-IL):
* module/language/tree-il.scm:
* module/language/tree-il/analyze.scm:
* module/language/tree-il/canonicalize.scm:
* module/language/tree-il/compile-glil.scm:
* module/language/tree-il/cse.scm:
* module/language/tree-il/debug.scm:
* module/language/tree-il/effects.scm: Remove <dynlet>. Add cases for
primcalls to push-fluid and pop-fluid in compile-glil.scm and
effects.scm.
* module/language/tree-il/peval.scm (peval): Factor out
with-temporaries; probably a bad idea, but works for now. Factor out
make-begin0 (a better idea). Inline primcalls to with-fluid*, and
remove dynlet cases.
* module/language/tree-il/primitives.scm (*interesting-primitive-names*):
Add with-fluid*.
Diffstat (limited to 'libguile')
-rw-r--r-- | libguile/eval.c | 23 | ||||
-rw-r--r-- | libguile/expand.c | 29 | ||||
-rw-r--r-- | libguile/expand.h | 17 | ||||
-rw-r--r-- | libguile/fluids.c | 8 | ||||
-rw-r--r-- | libguile/memoize.c | 47 | ||||
-rw-r--r-- | libguile/memoize.h | 2 | ||||
-rw-r--r-- | libguile/vm-i-system.c | 13 |
7 files changed, 35 insertions, 104 deletions
diff --git a/libguile/eval.c b/libguile/eval.c index ca0f731f9..b245026f0 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -40,7 +40,6 @@ #include "libguile/eq.h" #include "libguile/expand.h" #include "libguile/feature.h" -#include "libguile/fluids.h" #include "libguile/goops.h" #include "libguile/hash.h" #include "libguile/hashtab.h" @@ -265,28 +264,6 @@ eval (SCM x, SCM env) scm_define (CAR (mx), EVAL1 (CDR (mx), env)); return SCM_UNSPECIFIED; - case SCM_M_WITH_FLUIDS: - { - long i, len; - SCM *fluidv, *valuesv, walk, res; - scm_i_thread *thread = SCM_I_CURRENT_THREAD; - - len = scm_ilength (CAR (mx)); - fluidv = alloca (sizeof (SCM)*len); - for (i = 0, walk = CAR (mx); i < len; i++, walk = CDR (walk)) - fluidv[i] = EVAL1 (CAR (walk), env); - valuesv = alloca (sizeof (SCM)*len); - for (i = 0, walk = CADR (mx); i < len; i++, walk = CDR (walk)) - valuesv[i] = EVAL1 (CAR (walk), env); - - scm_dynstack_push_fluids (&thread->dynstack, len, fluidv, valuesv, - thread->dynamic_state); - res = eval (CDDR (mx), env); - scm_dynstack_unwind_fluids (&thread->dynstack, thread->dynamic_state); - - return res; - } - case SCM_M_APPLY: /* Evaluate the procedure to be applied. */ proc = EVAL1 (CAR (mx), env); diff --git a/libguile/expand.c b/libguile/expand.c index e5341b7f1..a8625eafa 100644 --- a/libguile/expand.c +++ b/libguile/expand.c @@ -88,8 +88,6 @@ static const char** exp_field_names[SCM_NUM_EXPANDED_TYPES]; SCM_MAKE_EXPANDED_LET(src, names, gensyms, vals, body) #define LETREC(src, in_order_p, names, gensyms, vals, body) \ SCM_MAKE_EXPANDED_LETREC(src, in_order_p, names, gensyms, vals, body) -#define DYNLET(src, fluids, vals, body) \ - SCM_MAKE_EXPANDED_DYNLET(src, fluids, vals, body) #define CAR(x) SCM_CAR(x) #define CDR(x) SCM_CDR(x) @@ -155,7 +153,6 @@ SCM_SYNTAX ("@", expand_at); SCM_SYNTAX ("@@", expand_atat); SCM_SYNTAX ("begin", expand_begin); SCM_SYNTAX ("define", expand_define); -SCM_SYNTAX ("with-fluids", expand_with_fluids); SCM_SYNTAX ("eval-when", expand_eval_when); SCM_SYNTAX ("if", expand_if); SCM_SYNTAX ("lambda", expand_lambda); @@ -184,7 +181,6 @@ SCM_GLOBAL_SYMBOL (scm_sym_begin, "begin"); SCM_GLOBAL_SYMBOL (scm_sym_case, "case"); SCM_GLOBAL_SYMBOL (scm_sym_cond, "cond"); SCM_GLOBAL_SYMBOL (scm_sym_define, "define"); -SCM_GLOBAL_SYMBOL (scm_sym_with_fluids, "with-fluids"); SCM_GLOBAL_SYMBOL (scm_sym_else, "else"); SCM_GLOBAL_SYMBOL (scm_sym_eval_when, "eval-when"); SCM_GLOBAL_SYMBOL (scm_sym_if, "if"); @@ -565,30 +561,6 @@ expand_define (SCM expr, SCM env) } static SCM -expand_with_fluids (SCM expr, SCM env) -{ - SCM binds, fluids, vals; - ASSERT_SYNTAX (scm_ilength (expr) >= 3, s_bad_expression, expr); - binds = CADR (expr); - ASSERT_SYNTAX_2 (scm_ilength (binds) >= 0, s_bad_bindings, binds, expr); - for (fluids = SCM_EOL, vals = SCM_EOL; - scm_is_pair (binds); - binds = CDR (binds)) - { - SCM binding = CAR (binds); - ASSERT_SYNTAX_2 (scm_ilength (CAR (binds)) == 2, s_bad_binding, - binding, expr); - fluids = scm_cons (expand (CAR (binding), env), fluids); - vals = scm_cons (expand (CADR (binding), env), vals); - } - - return DYNLET (scm_source_properties (expr), - scm_reverse_x (fluids, SCM_UNDEFINED), - scm_reverse_x (vals, SCM_UNDEFINED), - expand_sequence (CDDR (expr), env)); -} - -static SCM expand_eval_when (SCM expr, SCM env) { ASSERT_SYNTAX (scm_ilength (expr) >= 3, s_bad_expression, expr); @@ -1262,7 +1234,6 @@ scm_init_expand () DEFINE_NAMES (LAMBDA_CASE); DEFINE_NAMES (LET); DEFINE_NAMES (LETREC); - DEFINE_NAMES (DYNLET); scm_exp_vtable_vtable = scm_make_vtable (scm_from_locale_string (SCM_VTABLE_BASE_LAYOUT "pwuwpw"), diff --git a/libguile/expand.h b/libguile/expand.h index f5e7af5d4..8a578ae54 100644 --- a/libguile/expand.h +++ b/libguile/expand.h @@ -3,7 +3,7 @@ #ifndef SCM_EXPAND_H #define SCM_EXPAND_H -/* Copyright (C) 2010, 2011 +/* Copyright (C) 2010, 2011, 2013 * Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or @@ -54,7 +54,6 @@ typedef enum SCM_EXPANDED_LAMBDA_CASE, SCM_EXPANDED_LET, SCM_EXPANDED_LETREC, - SCM_EXPANDED_DYNLET, SCM_NUM_EXPANDED_TYPES, } scm_t_expanded_type; @@ -331,20 +330,6 @@ enum #define SCM_MAKE_EXPANDED_LETREC(src, in_order_p, names, gensyms, vals, body) \ scm_c_make_struct (exp_vtables[SCM_EXPANDED_LETREC], 0, SCM_NUM_EXPANDED_LETREC_FIELDS, SCM_UNPACK (src), SCM_UNPACK (in_order_p), SCM_UNPACK (names), SCM_UNPACK (gensyms), SCM_UNPACK (vals), SCM_UNPACK (body)) -#define SCM_EXPANDED_DYNLET_TYPE_NAME "dynlet" -#define SCM_EXPANDED_DYNLET_FIELD_NAMES \ - { "src", "fluids", "vals", "body", } -enum - { - SCM_EXPANDED_DYNLET_SRC, - SCM_EXPANDED_DYNLET_FLUIDS, - SCM_EXPANDED_DYNLET_VALS, - SCM_EXPANDED_DYNLET_BODY, - SCM_NUM_EXPANDED_DYNLET_FIELDS, - }; -#define SCM_MAKE_EXPANDED_DYNLET(src, fluids, vals, body) \ - scm_c_make_struct (exp_vtables[SCM_EXPANDED_DYNLET], 0, SCM_NUM_EXPANDED_DYNLET_FIELDS, SCM_UNPACK (src), SCM_UNPACK (fluids), SCM_UNPACK (vals), SCM_UNPACK (body)) - #endif /* BUILDING_LIBGUILE */ diff --git a/libguile/fluids.c b/libguile/fluids.c index 146854b96..1199451b2 100644 --- a/libguile/fluids.c +++ b/libguile/fluids.c @@ -418,16 +418,12 @@ scm_c_with_fluids (SCM fluids, SCM values, SCM (*cproc) (), void *cdata) } #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 +SCM +scm_with_fluid (SCM fluid, SCM value, SCM thunk) { 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) diff --git a/libguile/memoize.c b/libguile/memoize.c index e2c6bc65c..7dca50bd2 100644 --- a/libguile/memoize.c +++ b/libguile/memoize.c @@ -63,6 +63,8 @@ SCM_SYMBOL (sym_case_lambda_star, "case-lambda*"); /* Primitives not exposed to general Scheme. */ static SCM wind; static SCM unwind; +static SCM push_fluid; +static SCM pop_fluid; static SCM do_wind (SCM in, SCM out) @@ -78,6 +80,23 @@ do_unwind (void) return SCM_UNSPECIFIED; } +static SCM +do_push_fluid (SCM fluid, SCM val) +{ + scm_i_thread *thread = SCM_I_CURRENT_THREAD; + scm_dynstack_push_fluids (&thread->dynstack, 1, &fluid, &val, + thread->dynamic_state); + return SCM_UNSPECIFIED; +} + +static SCM +do_pop_fluid (void) +{ + scm_i_thread *thread = SCM_I_CURRENT_THREAD; + scm_dynstack_unwind_fluids (&thread->dynstack, thread->dynamic_state); + return SCM_UNSPECIFIED; +} + @@ -109,8 +128,6 @@ scm_t_bits scm_tc16_memoized; MAKMEMO (SCM_M_QUOTE, exp) #define MAKMEMO_DEFINE(var, val) \ MAKMEMO (SCM_M_DEFINE, scm_cons (var, val)) -#define MAKMEMO_WITH_FLUIDS(fluids, vals, expr) \ - MAKMEMO (SCM_M_WITH_FLUIDS, scm_cons (fluids, scm_cons (vals, expr))) #define MAKMEMO_APPLY(proc, args)\ MAKMEMO (SCM_M_APPLY, scm_list_2 (proc, args)) #define MAKMEMO_CONT(proc) \ @@ -146,7 +163,6 @@ static const char *const memoized_tags[] = "let", "quote", "define", - "with-fluids", "apply", "call/cc", "call-with-values", @@ -298,6 +314,12 @@ memoize (SCM exp, SCM env) else if (nargs == 0 && scm_is_eq (name, scm_from_latin1_symbol ("unwind"))) return MAKMEMO_CALL (MAKMEMO_QUOTE (unwind), 0, SCM_EOL); + else if (nargs == 2 + && scm_is_eq (name, scm_from_latin1_symbol ("push-fluid"))) + return MAKMEMO_CALL (MAKMEMO_QUOTE (push_fluid), 2, args); + else if (nargs == 0 + && scm_is_eq (name, scm_from_latin1_symbol ("pop-fluid"))) + return MAKMEMO_CALL (MAKMEMO_QUOTE (pop_fluid), 0, SCM_EOL); else if (scm_is_eq (scm_current_module (), scm_the_root_module ())) return MAKMEMO_CALL (MAKMEMO_TOP_REF (name), nargs, args); else @@ -511,11 +533,6 @@ memoize (SCM exp, SCM env) } } - case SCM_EXPANDED_DYNLET: - return MAKMEMO_WITH_FLUIDS (memoize_exps (REF (exp, DYNLET, FLUIDS), env), - memoize_exps (REF (exp, DYNLET, VALS), env), - memoize (REF (exp, DYNLET, BODY), env)); - default: abort (); } @@ -611,18 +628,6 @@ unmemoize (const SCM expr) unmemoize (CAR (args)), unmemoize (CDR (args))); case SCM_M_DEFINE: return scm_list_3 (scm_sym_define, CAR (args), unmemoize (CDR (args))); - case SCM_M_WITH_FLUIDS: - { - SCM binds = SCM_EOL, fluids, vals; - for (fluids = CAR (args), vals = CADR (args); scm_is_pair (fluids); - fluids = CDR (fluids), vals = CDR (vals)) - binds = scm_cons (scm_list_2 (unmemoize (CAR (fluids)), - unmemoize (CAR (vals))), - binds); - return scm_list_3 (scm_sym_with_fluids, - scm_reverse_x (binds, SCM_UNDEFINED), - unmemoize (CDDR (args))); - } case SCM_M_IF: return scm_list_4 (scm_sym_if, unmemoize (scm_car (args)), unmemoize (scm_cadr (args)), unmemoize (scm_cddr (args))); @@ -859,6 +864,8 @@ scm_init_memoize () wind = scm_c_make_gsubr ("wind", 2, 0, 0, do_wind); unwind = scm_c_make_gsubr ("unwind", 0, 0, 0, do_unwind); + push_fluid = scm_c_make_gsubr ("push-fluid", 2, 0, 0, do_push_fluid); + pop_fluid = scm_c_make_gsubr ("pop-fluid", 0, 0, 0, do_pop_fluid); list_of_guile = scm_list_1 (scm_from_latin1_symbol ("guile")); } diff --git a/libguile/memoize.h b/libguile/memoize.h index ab7e777fe..7f7624fd3 100644 --- a/libguile/memoize.h +++ b/libguile/memoize.h @@ -44,7 +44,6 @@ SCM_API SCM scm_sym_quote; SCM_API SCM scm_sym_quasiquote; SCM_API SCM scm_sym_unquote; SCM_API SCM scm_sym_uq_splicing; -SCM_API SCM scm_sym_with_fluids; SCM_API SCM scm_sym_at; SCM_API SCM scm_sym_atat; @@ -73,7 +72,6 @@ enum SCM_M_LET, SCM_M_QUOTE, SCM_M_DEFINE, - SCM_M_WITH_FLUIDS, SCM_M_APPLY, SCM_M_CONT, SCM_M_CALL_WITH_VALUES, diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c index 9b24c9295..442350d40 100644 --- a/libguile/vm-i-system.c +++ b/libguile/vm-i-system.c @@ -1490,20 +1490,17 @@ VM_DEFINE_INSTRUCTION (90, unwind, "unwind", 0, 0, 0) NEXT; } -VM_DEFINE_INSTRUCTION (91, wind_fluids, "wind-fluids", 1, -1, 0) +VM_DEFINE_INSTRUCTION (91, push_fluid, "push-fluid", 0, 2, 0) { - unsigned n = FETCH (); - + SCM fluid, val; + POP2 (val, fluid); SYNC_REGISTER (); - sp -= 2 * n; - CHECK_UNDERFLOW (); - scm_dynstack_push_fluids (¤t_thread->dynstack, n, sp + 1, sp + 1 + n, + scm_dynstack_push_fluids (¤t_thread->dynstack, 1, &fluid, &val, current_thread->dynamic_state); - NULLSTACK (2 * n); NEXT; } -VM_DEFINE_INSTRUCTION (92, unwind_fluids, "unwind-fluids", 0, 0, 0) +VM_DEFINE_INSTRUCTION (92, pop_fluid, "pop-fluid", 0, 0, 0) { /* This function must not allocate. */ scm_dynstack_unwind_fluids (¤t_thread->dynstack, |