diff options
author | Dirk Herrmann <dirk@dirk-herrmanns-seiten.de> | 2003-11-02 11:39:35 +0000 |
---|---|---|
committer | Dirk Herrmann <dirk@dirk-herrmanns-seiten.de> | 2003-11-02 11:39:35 +0000 |
commit | 0f572ba764bd30027d73fc857f0650b1e27cf967 (patch) | |
tree | bf5ac53006a56be188bf25dc28bd1400b5a18d40 /libguile/eval.c | |
parent | 2510c810619043253061794c665080dbad9353d5 (diff) | |
download | guile-0f572ba764bd30027d73fc857f0650b1e27cf967.tar.gz |
* eval.c (canonicalize_define): New static helper function.
(memoize_define, canonicalize_define): Extract handling of
function currying to canonicalize_define.
Diffstat (limited to 'libguile/eval.c')
-rw-r--r-- | libguile/eval.c | 38 |
1 files changed, 29 insertions, 9 deletions
diff --git a/libguile/eval.c b/libguile/eval.c index 31d03baf9..e86b8e9d0 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -87,6 +87,10 @@ char *alloca (); +static SCM canonicalize_define (SCM expr); + + + /* {Syntax Errors} * * This section defines the message strings for the syntax errors that can be @@ -857,8 +861,8 @@ scm_m_cond (SCM expr, SCM env) } -SCM_SYNTAX(s_define, "define", scm_i_makbimacro, scm_m_define); -SCM_GLOBAL_SYMBOL(scm_sym_define, s_define); +SCM_SYNTAX (s_define, "define", scm_i_makbimacro, scm_m_define); +SCM_GLOBAL_SYMBOL (scm_sym_define, s_define); /* Guile provides an extension to R5RS' define syntax to represent function * currying in a compact way. With this extension, it is allowed to write @@ -879,14 +883,13 @@ SCM_GLOBAL_SYMBOL(scm_sym_define, s_define); */ /* Dirk:FIXME:: We should provide an implementation for 'define' in the R5RS * module that does not implement this extension. */ -SCM -scm_m_define (SCM expr, SCM env) +static SCM +canonicalize_define (const SCM expr) { SCM body; SCM variable; const SCM cdr_expr = SCM_CDR (expr); - ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 0, s_bad_expression, expr); ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 2, s_missing_expression, expr); body = SCM_CDR (cdr_expr); @@ -910,9 +913,28 @@ scm_m_define (SCM expr, SCM env) ASSERT_SYNTAX_2 (SCM_SYMBOLP (variable), s_bad_variable, variable, expr); ASSERT_SYNTAX (scm_ilength (body) == 1, s_expression, expr); + SCM_SETCAR (cdr_expr, variable); + SCM_SETCDR (cdr_expr, body); + return expr; +} + +SCM +scm_m_define (SCM expr, SCM env) +{ + SCM canonical_definition; + SCM cdr_canonical_definition; + SCM body; + + ASSERT_SYNTAX (scm_ilength (expr) >= 0, s_bad_expression, expr); + + canonical_definition = canonicalize_define (expr); + cdr_canonical_definition = SCM_CDR (canonical_definition); + body = SCM_CDR (cdr_canonical_definition); + if (SCM_TOP_LEVEL (env)) { SCM var; + const SCM variable = SCM_CAR (cdr_canonical_definition); const SCM value = scm_eval_car (body, env); if (SCM_REC_PROCNAMES_P) { @@ -930,10 +952,8 @@ scm_m_define (SCM expr, SCM env) } else { - SCM_SETCAR (expr, SCM_IM_DEFINE); - SCM_SETCAR (cdr_expr, variable); - SCM_SETCDR (cdr_expr, body); - return expr; + SCM_SETCAR (canonical_definition, SCM_IM_DEFINE); + return canonical_definition; } } |