diff options
author | Andy Wingo <wingo@pobox.com> | 2013-06-25 22:36:08 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2013-06-27 11:31:21 +0200 |
commit | 1773bc7dd5f4c8a1d13c7cf2015f3a04c9299eeb (patch) | |
tree | 3a645fa1af56c5572d7d0933792930592e84ab6f /libguile/expand.c | |
parent | 385049949aa52b8578334d073b2c63291a5d5274 (diff) | |
download | guile-1773bc7dd5f4c8a1d13c7cf2015f3a04c9299eeb.tar.gz |
Remove @prompt memoizer
* libguile/memoize.h:
* libguile/memoize.c (MAKMEMO_CALL_WITH_PROMPT, memoize, unmemoize):
Remove the @prompt memoizer in favor of recognizing call-with-prompt
primcalls. Rename SCM_M_PROMPT to SCM_M_CALL_WITH_PROMPT, and pass a
thunk instead of an expression so that it has normal applicative
order.
* libguile/expand.c (PRIMITIVE_REF, PRIMCALL, expand): Produce primcalls
from forms whose car is a primitive.
(expand_atat): Recognize (@@ primitive FOO) as being a primitive-ref.
* module/ice-9/boot-9.scm (call-with-prompt): Instead of dispatching to
the wonky @prompt memoizer, residualize a primcall to
call-with-prompt. The memoizer will DTRT to allow call-with-prompt to
be interpreted correctly without needing an additional binding.
* module/ice-9/eval.scm (primitive-eval): Change the 'prompt clause to a
call to call-with-prompt.
* module/language/tree-il/primitives.scm: No more need to recognize
@prompt.
* libguile/eval.c (eval): Adapt to SCM_M_PROMPT renaming to
SCM_M_CALL_WITH_PROMPT, and apply the thunk.
* libguile/throw.c (pre_init_throw): Adapt to scm_abort_to_prompt_star
rename.
Diffstat (limited to 'libguile/expand.c')
-rw-r--r-- | libguile/expand.c | 33 |
1 files changed, 22 insertions, 11 deletions
diff --git a/libguile/expand.c b/libguile/expand.c index cb32e371c..396df3b07 100644 --- a/libguile/expand.c +++ b/libguile/expand.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008,2009,2010,2011,2012 +/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008,2009,2010,2011,2012,2013 * Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or @@ -56,8 +56,8 @@ static const char** exp_field_names[SCM_NUM_EXPANDED_TYPES]; SCM_MAKE_EXPANDED_VOID(src) #define CONST_(src, exp) \ SCM_MAKE_EXPANDED_CONST(src, exp) -#define PRIMITIVE_REF_TYPE(src, name) \ - SCM_MAKE_EXPANDED_PRIMITIVE_REF_TYPE(src, name) +#define PRIMITIVE_REF(src, name) \ + SCM_MAKE_EXPANDED_PRIMITIVE_REF(src, name) #define LEXICAL_REF(src, name, gensym) \ SCM_MAKE_EXPANDED_LEXICAL_REF(src, name, gensym) #define LEXICAL_SET(src, name, gensym, exp) \ @@ -74,6 +74,8 @@ static const char** exp_field_names[SCM_NUM_EXPANDED_TYPES]; SCM_MAKE_EXPANDED_TOPLEVEL_DEFINE(src, name, exp) #define CONDITIONAL(src, test, consequent, alternate) \ SCM_MAKE_EXPANDED_CONDITIONAL(src, test, consequent, alternate) +#define PRIMCALL(src, name, exps) \ + SCM_MAKE_EXPANDED_PRIMCALL(src, name, exps) #define CALL(src, proc, exps) \ SCM_MAKE_EXPANDED_CALL(src, proc, exps) #define SEQ(src, head, tail) \ @@ -195,12 +197,13 @@ SCM_GLOBAL_SYMBOL (scm_sym_let, "let"); SCM_GLOBAL_SYMBOL (scm_sym_letrec, "letrec"); SCM_GLOBAL_SYMBOL (scm_sym_letstar, "let*"); SCM_GLOBAL_SYMBOL (scm_sym_or, "or"); -SCM_GLOBAL_SYMBOL (scm_sym_at_prompt, "@prompt"); +SCM_SYMBOL (sym_call_with_prompt, "call-with-prompt"); SCM_GLOBAL_SYMBOL (scm_sym_quote, "quote"); SCM_GLOBAL_SYMBOL (scm_sym_set_x, "set!"); SCM_SYMBOL (sym_lambda_star, "lambda*"); SCM_SYMBOL (sym_eval, "eval"); SCM_SYMBOL (sym_load, "load"); +SCM_SYMBOL (sym_primitive, "primitive"); SCM_GLOBAL_SYMBOL (scm_sym_unquote, "unquote"); SCM_GLOBAL_SYMBOL (scm_sym_quasiquote, "quasiquote"); @@ -356,17 +359,22 @@ expand (SCM exp, SCM env) { SCM arg_exps = SCM_EOL; SCM args = SCM_EOL; - SCM proc = CAR (exp); + SCM proc = expand (CAR (exp), env); for (arg_exps = CDR (exp); scm_is_pair (arg_exps); arg_exps = CDR (arg_exps)) args = scm_cons (expand (CAR (arg_exps), env), args); - if (scm_is_null (arg_exps)) - return CALL (scm_source_properties (exp), - expand (proc, env), - scm_reverse_x (args, SCM_UNDEFINED)); - else + args = scm_reverse_x (args, SCM_UNDEFINED); + + if (!scm_is_null (arg_exps)) syntax_error ("expected a proper list", exp, SCM_UNDEFINED); + + if (SCM_EXPANDED_TYPE (proc) == SCM_EXPANDED_PRIMITIVE_REF) + return PRIMCALL (scm_source_properties (exp), + SCM_EXPANDED_REF (proc, PRIMITIVE_REF, NAME), + args); + else + return CALL (scm_source_properties (exp), proc, args); } } else if (scm_is_symbol (exp)) @@ -423,9 +431,12 @@ static SCM expand_atat (SCM expr, SCM env SCM_UNUSED) { ASSERT_SYNTAX (scm_ilength (expr) == 3, s_bad_expression, expr); - ASSERT_SYNTAX (scm_ilength (CADR (expr)) > 0, s_bad_expression, expr); ASSERT_SYNTAX (scm_is_symbol (CADDR (expr)), s_bad_expression, expr); + if (scm_is_eq (CADR (expr), sym_primitive)) + return PRIMITIVE_REF (scm_source_properties (expr), CADDR (expr)); + + ASSERT_SYNTAX (scm_ilength (CADR (expr)) > 0, s_bad_expression, expr); return MODULE_REF (scm_source_properties (expr), CADR (expr), CADDR (expr), SCM_BOOL_F); } |