diff options
author | Ludovic Courtès <ludo@gnu.org> | 2009-08-13 23:08:35 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2009-08-13 23:30:49 +0200 |
commit | 4d0949ea45c46dd13e767a8a3342d02caef1b483 (patch) | |
tree | f3cf86df75337bdafa5a5a7d3818202ce279d844 /libguile/eval.c | |
parent | d785171115bb35c6e3cc3663a0023ff4e88536d5 (diff) | |
download | guile-4d0949ea45c46dd13e767a8a3342d02caef1b483.tar.gz |
Make the evaluator's memoizers private.
* libguile/eval.c (macroexp): Move upwards.
(scm_m_quote, scm_m_begin, scm_m_if, scm_m_set_x, scm_m_and, scm_m_or,
scm_m_case, scm_m_cond, scm_m_lambda, scm_m_letstar, scm_m_do,
scm_m_quasiquote, scm_m_delay, scm_m_generalized_set_x,
scm_m_define, scm_m_letrec, scm_m_let, scm_m_at, scm_m_atat,
scm_m_apply, scm_m_cont, scm_m_nil_cond, scm_m_atfop,
scm_m_atbind, scm_m_atslot_ref, scm_m_atslot_set_x,
scm_m_at_call_with_values, scm_m_eval_when): New static
declarations; definitions made static.
(s_atslot_ref, s_atslot_set_x): New, from `goops.c'.
* libguile/eval.h (scm_m_quote, scm_m_begin, scm_m_if, scm_m_set_x,
scm_m_vref, scm_m_vset, scm_m_and, scm_m_or, scm_m_case, scm_m_cond,
scm_m_lambda, scm_m_letstar, scm_m_do, scm_m_quasiquote, scm_m_delay,
scm_m_generalized_set_x, scm_m_future, scm_m_define, scm_m_letrec,
scm_m_let, scm_m_at, scm_m_atat, scm_m_apply, scm_m_cont,
scm_m_nil_cond, scm_m_atfop, scm_m_atbind, scm_m_atslot_ref,
scm_m_atslot_set_x, scm_m_atdispatch, scm_m_at_call_with_values,
scm_m_eval_when): Remove public declarations.
* libguile/goops.c (s_atslot_ref, s_atslot_set_x): Remove.
Diffstat (limited to 'libguile/eval.c')
-rw-r--r-- | libguile/eval.c | 216 |
1 files changed, 127 insertions, 89 deletions
diff --git a/libguile/eval.c b/libguile/eval.c index f7f3f27df..4640ea5f9 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -710,6 +710,101 @@ is_system_macro_p (const SCM syntactic_keyword, const SCM form, const SCM env) return 0; } +static SCM +macroexp (SCM x, SCM env) +{ + SCM res, proc, orig_sym; + + /* Don't bother to produce error messages here. We get them when we + eventually execute the code for real. */ + + macro_tail: + orig_sym = SCM_CAR (x); + if (!scm_is_symbol (orig_sym)) + return x; + + { + SCM *proc_ptr = scm_lookupcar1 (x, env, 0); + if (proc_ptr == NULL) + { + /* We have lost the race. */ + goto macro_tail; + } + proc = *proc_ptr; + } + + /* Only handle memoizing macros. `Acros' and `macros' are really + special forms and should not be evaluated here. */ + + if (!SCM_MACROP (proc) + || (SCM_MACRO_TYPE (proc) != 2 && !SCM_BUILTIN_MACRO_P (proc))) + return x; + + SCM_SETCAR (x, orig_sym); /* Undo memoizing effect of lookupcar */ + res = scm_call_2 (SCM_MACRO_CODE (proc), x, env); + + if (scm_ilength (res) <= 0) + /* Result of expansion is not a list. */ + return (scm_list_2 (SCM_IM_BEGIN, res)); + else + { + /* njrev: Several queries here: (1) I don't see how it can be + correct that the SCM_SETCAR 2 lines below this comment needs + protection, but the SCM_SETCAR 6 lines above does not, so + something here is probably wrong. (2) macroexp() is now only + used in one place - scm_m_generalized_set_x - whereas all other + macro expansion happens through expand_user_macros. Therefore + (2.1) perhaps macroexp() could be eliminated completely now? + (2.2) Does expand_user_macros need any critical section + protection? */ + + SCM_CRITICAL_SECTION_START; + SCM_SETCAR (x, SCM_CAR (res)); + SCM_SETCDR (x, SCM_CDR (res)); + SCM_CRITICAL_SECTION_END; + + goto macro_tail; + } +} + + +/* Start of the memoizers for the standard R5RS builtin macros. */ + +static SCM scm_m_quote (SCM xorig, SCM env); +static SCM scm_m_begin (SCM xorig, SCM env); +static SCM scm_m_if (SCM xorig, SCM env); +static SCM scm_m_set_x (SCM xorig, SCM env); +static SCM scm_m_and (SCM xorig, SCM env); +static SCM scm_m_or (SCM xorig, SCM env); +static SCM scm_m_case (SCM xorig, SCM env); +static SCM scm_m_cond (SCM xorig, SCM env); +static SCM scm_m_lambda (SCM xorig, SCM env); +static SCM scm_m_letstar (SCM xorig, SCM env); +static SCM scm_m_do (SCM xorig, SCM env); +static SCM scm_m_quasiquote (SCM xorig, SCM env); +static SCM scm_m_delay (SCM xorig, SCM env); +static SCM scm_m_generalized_set_x (SCM xorig, SCM env); +#if 0 /* Futures are disabled, see "futures.h". */ +static SCM scm_m_future (SCM xorig, SCM env); +#endif +static SCM scm_m_define (SCM x, SCM env); +static SCM scm_m_letrec (SCM xorig, SCM env); +static SCM scm_m_let (SCM xorig, SCM env); +static SCM scm_m_at (SCM xorig, SCM env); +static SCM scm_m_atat (SCM xorig, SCM env); +static SCM scm_m_atslot_ref (SCM xorig, SCM env); +static SCM scm_m_atslot_set_x (SCM xorig, SCM env); +static SCM scm_m_apply (SCM xorig, SCM env); +static SCM scm_m_cont (SCM xorig, SCM env); +#if SCM_ENABLE_ELISP +static SCM scm_m_nil_cond (SCM xorig, SCM env); +static SCM scm_m_atfop (SCM xorig, SCM env); +#endif /* SCM_ENABLE_ELISP */ +static SCM scm_m_atbind (SCM xorig, SCM env); +static SCM scm_m_at_call_with_values (SCM xorig, SCM env); +static SCM scm_m_eval_when (SCM xorig, SCM env); + + static void m_expand_body (const SCM forms, const SCM env) { @@ -832,70 +927,10 @@ m_expand_body (const SCM forms, const SCM env) } } -static SCM -macroexp (SCM x, SCM env) -{ - SCM res, proc, orig_sym; - - /* Don't bother to produce error messages here. We get them when we - eventually execute the code for real. */ - - macro_tail: - orig_sym = SCM_CAR (x); - if (!scm_is_symbol (orig_sym)) - return x; - - { - SCM *proc_ptr = scm_lookupcar1 (x, env, 0); - if (proc_ptr == NULL) - { - /* We have lost the race. */ - goto macro_tail; - } - proc = *proc_ptr; - } - - /* Only handle memoizing macros. `Acros' and `macros' are really - special forms and should not be evaluated here. */ - - if (!SCM_MACROP (proc) - || (SCM_MACRO_TYPE (proc) != 2 && !SCM_BUILTIN_MACRO_P (proc))) - return x; - - SCM_SETCAR (x, orig_sym); /* Undo memoizing effect of lookupcar */ - res = scm_call_2 (SCM_MACRO_CODE (proc), x, env); - - if (scm_ilength (res) <= 0) - /* Result of expansion is not a list. */ - return (scm_list_2 (SCM_IM_BEGIN, res)); - else - { - /* njrev: Several queries here: (1) I don't see how it can be - correct that the SCM_SETCAR 2 lines below this comment needs - protection, but the SCM_SETCAR 6 lines above does not, so - something here is probably wrong. (2) macroexp() is now only - used in one place - scm_m_generalized_set_x - whereas all other - macro expansion happens through expand_user_macros. Therefore - (2.1) perhaps macroexp() could be eliminated completely now? - (2.2) Does expand_user_macros need any critical section - protection? */ - - SCM_CRITICAL_SECTION_START; - SCM_SETCAR (x, SCM_CAR (res)); - SCM_SETCDR (x, SCM_CDR (res)); - SCM_CRITICAL_SECTION_END; - - goto macro_tail; - } -} - -/* Start of the memoizers for the standard R5RS builtin macros. */ - - SCM_SYNTAX (s_and, "and", scm_i_makbimacro, scm_m_and); SCM_GLOBAL_SYMBOL (scm_sym_and, s_and); -SCM +static SCM scm_m_and (SCM expr, SCM env SCM_UNUSED) { const SCM cdr_expr = SCM_CDR (expr); @@ -925,7 +960,7 @@ unmemoize_and (const SCM expr, const SCM env) SCM_SYNTAX (s_begin, "begin", scm_i_makbimacro, scm_m_begin); SCM_GLOBAL_SYMBOL (scm_sym_begin, s_begin); -SCM +static SCM scm_m_begin (SCM expr, SCM env SCM_UNUSED) { const SCM cdr_expr = SCM_CDR (expr); @@ -949,7 +984,7 @@ SCM_SYNTAX (s_case, "case", scm_i_makbimacro, scm_m_case); SCM_GLOBAL_SYMBOL (scm_sym_case, s_case); SCM_GLOBAL_SYMBOL (scm_sym_else, "else"); -SCM +static SCM scm_m_case (SCM expr, SCM env) { SCM clauses; @@ -1045,7 +1080,7 @@ SCM_SYNTAX (s_cond, "cond", scm_i_makbimacro, scm_m_cond); SCM_GLOBAL_SYMBOL (scm_sym_cond, s_cond); SCM_GLOBAL_SYMBOL (scm_sym_arrow, "=>"); -SCM +static SCM scm_m_cond (SCM expr, SCM env) { /* Check, whether 'else or '=> is a literal, i. e. not bound to a value. */ @@ -1207,7 +1242,7 @@ canonicalize_define (const SCM expr) operation. However, EXPRESSION _can_ be evaluated before VARIABLE is bound. This means that EXPRESSION won't necessarily be able to assign values to VARIABLE as in `(define foo (begin (set! foo 1) (+ foo 1)))'. */ -SCM +static SCM scm_m_define (SCM expr, SCM env) { ASSERT_SYNTAX (SCM_TOP_LEVEL (env), s_bad_define, expr); @@ -1262,7 +1297,7 @@ SCM_GLOBAL_SYMBOL (scm_sym_delay, s_delay); * (delay <expression>) is transformed into (#@delay '() <expression>), where * the empty list represents the empty parameter list. This representation * allows for easy creation of the closure during evaluation. */ -SCM +static SCM scm_m_delay (SCM expr, SCM env) { const SCM new_expr = memoize_as_thunk_prototype (expr, env); @@ -1305,7 +1340,7 @@ SCM_GLOBAL_SYMBOL(scm_sym_do, s_do); (<body>) <step1> <step2> ... <stepn>) ;; missing steps replaced by var */ -SCM +static SCM scm_m_do (SCM expr, SCM env SCM_UNUSED) { SCM variables = SCM_EOL; @@ -1403,7 +1438,7 @@ unmemoize_do (const SCM expr, const SCM env) SCM_SYNTAX (s_if, "if", scm_i_makbimacro, scm_m_if); SCM_GLOBAL_SYMBOL (scm_sym_if, s_if); -SCM +static SCM scm_m_if (SCM expr, SCM env SCM_UNUSED) { const SCM cdr_expr = SCM_CDR (expr); @@ -1453,7 +1488,7 @@ c_improper_memq (SCM obj, SCM list) return scm_is_eq (list, obj); } -SCM +static SCM scm_m_lambda (SCM expr, SCM env SCM_UNUSED) { SCM formals; @@ -1623,7 +1658,7 @@ memoize_named_let (const SCM expr, const SCM env SCM_UNUSED) /* (let ((v1 i1) (v2 i2) ...) body) with variables v1 .. vn and initializers * i1 .. in is transformed to (#@let (vn ... v2 v1) (i1 i2 ...) body). */ -SCM +static SCM scm_m_let (SCM expr, SCM env) { SCM bindings; @@ -1697,7 +1732,7 @@ unmemoize_let (const SCM expr, const SCM env) SCM_SYNTAX(s_letrec, "letrec", scm_i_makbimacro, scm_m_letrec); SCM_GLOBAL_SYMBOL(scm_sym_letrec, s_letrec); -SCM +static SCM scm_m_letrec (SCM expr, SCM env) { SCM bindings; @@ -1748,7 +1783,7 @@ SCM_GLOBAL_SYMBOL (scm_sym_letstar, s_letstar); /* (let* ((v1 i1) (v2 i2) ...) body) with variables v1 .. vn and initializers * i1 .. in is transformed into the form (#@let* (v1 i1 v2 i2 ...) body). */ -SCM +static SCM scm_m_letstar (SCM expr, SCM env SCM_UNUSED) { SCM binding_idx; @@ -1821,7 +1856,7 @@ unmemoize_letstar (const SCM expr, const SCM env) SCM_SYNTAX (s_or, "or", scm_i_makbimacro, scm_m_or); SCM_GLOBAL_SYMBOL (scm_sym_or, s_or); -SCM +static SCM scm_m_or (SCM expr, SCM env SCM_UNUSED) { const SCM cdr_expr = SCM_CDR (expr); @@ -1905,7 +1940,7 @@ iqq (SCM form, SCM env, unsigned long int depth) return form; } -SCM +static SCM scm_m_quasiquote (SCM expr, SCM env) { const SCM cdr_expr = SCM_CDR (expr); @@ -1918,7 +1953,7 @@ scm_m_quasiquote (SCM expr, SCM env) SCM_SYNTAX (s_quote, "quote", scm_i_makbimacro, scm_m_quote); SCM_GLOBAL_SYMBOL (scm_sym_quote, s_quote); -SCM +static SCM scm_m_quote (SCM expr, SCM env SCM_UNUSED) { SCM quotee; @@ -1947,7 +1982,7 @@ SCM_SYNTAX (s_set_x, "set!", scm_i_makbimacro, scm_m_set_x); */ static const char s_set_x[] = "set!"; SCM_GLOBAL_SYMBOL (scm_sym_set_x, s_set_x); -SCM +static SCM scm_m_set_x (SCM expr, SCM env SCM_UNUSED) { SCM variable; @@ -1977,13 +2012,14 @@ unmemoize_set_x (const SCM expr, const SCM env) } + /* Start of the memoizers for non-R5RS builtin macros. */ SCM_SYNTAX (s_at, "@", scm_makmmacro, scm_m_at); SCM_GLOBAL_SYMBOL (scm_sym_at, s_at); -SCM +static SCM scm_m_at (SCM expr, SCM env SCM_UNUSED) { SCM mod, var; @@ -2004,7 +2040,7 @@ scm_m_at (SCM expr, SCM env SCM_UNUSED) SCM_SYNTAX (s_atat, "@@", scm_makmmacro, scm_m_atat); SCM_GLOBAL_SYMBOL (scm_sym_atat, s_atat); -SCM +static SCM scm_m_atat (SCM expr, SCM env SCM_UNUSED) { SCM mod, var; @@ -2026,7 +2062,7 @@ SCM_SYNTAX (s_atapply, "@apply", scm_i_makbimacro, scm_m_apply); SCM_GLOBAL_SYMBOL (scm_sym_atapply, s_atapply); SCM_GLOBAL_SYMBOL (scm_sym_apply, s_atapply + 1); -SCM +static SCM scm_m_apply (SCM expr, SCM env SCM_UNUSED) { const SCM cdr_expr = SCM_CDR (expr); @@ -2063,7 +2099,7 @@ SCM_SYNTAX (s_atbind, "@bind", scm_i_makbimacro, scm_m_atbind); * * FIXME - also implement `@bind*'. */ -SCM +static SCM scm_m_atbind (SCM expr, SCM env) { SCM bindings; @@ -2102,7 +2138,7 @@ scm_m_atbind (SCM expr, SCM env) SCM_SYNTAX(s_atcall_cc, "@call-with-current-continuation", scm_i_makbimacro, scm_m_cont); SCM_GLOBAL_SYMBOL(scm_sym_atcall_cc, s_atcall_cc); -SCM +static SCM scm_m_cont (SCM expr, SCM env SCM_UNUSED) { const SCM cdr_expr = SCM_CDR (expr); @@ -2123,7 +2159,7 @@ unmemoize_atcall_cc (const SCM expr, const SCM env) SCM_SYNTAX (s_at_call_with_values, "@call-with-values", scm_i_makbimacro, scm_m_at_call_with_values); SCM_GLOBAL_SYMBOL(scm_sym_at_call_with_values, s_at_call_with_values); -SCM +static SCM scm_m_at_call_with_values (SCM expr, SCM env SCM_UNUSED) { const SCM cdr_expr = SCM_CDR (expr); @@ -2147,7 +2183,7 @@ SCM_SYMBOL (sym_eval, "eval"); SCM_SYMBOL (sym_load, "load"); -SCM +static SCM scm_m_eval_when (SCM expr, SCM env SCM_UNUSED) { ASSERT_SYNTAX (scm_ilength (expr) >= 3, s_bad_expression, expr); @@ -2173,7 +2209,7 @@ SCM_GLOBAL_SYMBOL (scm_sym_future, s_future); * (#@future '() <expression>), where the empty list represents the * empty parameter list. This representation allows for easy creation * of the closure during evaluation. */ -SCM +static SCM scm_m_future (SCM expr, SCM env) { const SCM new_expr = memoize_as_thunk_prototype (expr, env); @@ -2193,7 +2229,7 @@ unmemoize_future (const SCM expr, const SCM env) SCM_SYNTAX (s_gset_x, "set!", scm_i_makbimacro, scm_m_generalized_set_x); SCM_SYMBOL (scm_sym_setter, "setter"); -SCM +static SCM scm_m_generalized_set_x (SCM expr, SCM env) { SCM target, exp_target; @@ -2250,9 +2286,11 @@ scm_m_generalized_set_x (SCM expr, SCM env) * arbitrary modules during the startup phase, the code from goops.c should be * moved here. */ +SCM_SYNTAX (s_atslot_ref, "@slot-ref", scm_i_makbimacro, scm_m_atslot_ref); +SCM_SYNTAX (s_atslot_set_x, "@slot-set!", scm_i_makbimacro, scm_m_atslot_set_x); SCM_SYMBOL (sym_atslot_ref, "@slot-ref"); -SCM +static SCM scm_m_atslot_ref (SCM expr, SCM env SCM_UNUSED) { SCM slot_nr; @@ -2285,7 +2323,7 @@ unmemoize_atslot_ref (const SCM expr, const SCM env) SCM_SYMBOL (sym_atslot_set_x, "@slot-set!"); -SCM +static SCM scm_m_atslot_set_x (SCM expr, SCM env SCM_UNUSED) { SCM slot_nr; @@ -2323,7 +2361,7 @@ SCM_SYNTAX (s_nil_cond, "nil-cond", scm_i_makbimacro, scm_m_nil_cond); /* nil-cond expressions have the form * (nil-cond COND VAL COND VAL ... ELSEVAL) */ -SCM +static SCM scm_m_nil_cond (SCM expr, SCM env SCM_UNUSED) { const long length = scm_ilength (SCM_CDR (expr)); @@ -2346,7 +2384,7 @@ SCM_SYNTAX (s_atfop, "@fop", scm_i_makbimacro, scm_m_atfop); * if the value of var (across all aliasing) is not a macro, or * (<un-aliased var> <expr> ...) * if var is a macro. */ -SCM +static SCM scm_m_atfop (SCM expr, SCM env SCM_UNUSED) { SCM location; |