summaryrefslogtreecommitdiff
path: root/libguile/eval.c
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2009-03-09 21:26:44 +0100
committerAndy Wingo <wingo@pobox.com>2009-04-17 15:20:18 +0200
commit249bab1c5341d957c69d1258e73898a2281c317f (patch)
tree8ee6e994ab20466c7d65c9d5c6bd5a0a6a1c46db /libguile/eval.c
parent900761bc8dd8713609c9adc886dec3f3aafb2d7b (diff)
downloadguile-249bab1c5341d957c69d1258e73898a2281c317f.tar.gz
@ and @@ as primitive macros
* libguile/eval.h: * libguile/eval.c (error_unbound_variable, error_defined_variable): Move these prototypes up earlier. (scm_m_at, scm_m_atat): New functions, provide the @ and @@ functionality. Moved here from defmacros because they are "special", inasmuch as syncase doesn't really understand them in interpreted code. * module/ice-9/boot-9.scm (@, @@): Don't define as defmacros, as defmacros have to actually return source now.
Diffstat (limited to 'libguile/eval.c')
-rw-r--r--libguile/eval.c46
1 files changed, 43 insertions, 3 deletions
diff --git a/libguile/eval.c b/libguile/eval.c
index 48b229903..12888c2fe 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -306,6 +306,9 @@ syntax_error (const char* const msg, const SCM form, const SCM expr)
{ if (SCM_UNLIKELY (!(cond))) \
syntax_error (message, form, expr); }
+static void error_unbound_variable (SCM symbol) SCM_NORETURN;
+static void error_defined_variable (SCM symbol) SCM_NORETURN;
+
/* {Ilocs}
@@ -1976,6 +1979,46 @@ 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
+scm_m_at (SCM expr, SCM env SCM_UNUSED)
+{
+ SCM mod, var;
+ ASSERT_SYNTAX (scm_ilength (expr) == 3, s_bad_expression, expr);
+ ASSERT_SYNTAX (scm_ilength (scm_cadr (expr)) > 0, s_bad_expression, expr);
+
+ mod = scm_resolve_module (scm_cadr (expr));
+ if (scm_is_false (mod))
+ error_unbound_variable (expr);
+ var = scm_module_variable (scm_module_public_interface (mod), scm_caddr (expr));
+ if (scm_is_false (var))
+ error_unbound_variable (expr);
+
+ return var;
+}
+
+SCM_SYNTAX (s_atat, "@@", scm_makmmacro, scm_m_atat);
+SCM_GLOBAL_SYMBOL (scm_sym_atat, s_atat);
+
+SCM
+scm_m_atat (SCM expr, SCM env SCM_UNUSED)
+{
+ SCM mod, var;
+ ASSERT_SYNTAX (scm_ilength (expr) == 3, s_bad_expression, expr);
+ ASSERT_SYNTAX (scm_ilength (scm_cadr (expr)) > 0, s_bad_expression, expr);
+
+ mod = scm_resolve_module (scm_cadr (expr));
+ if (scm_is_false (mod))
+ error_unbound_variable (expr);
+ var = scm_module_variable (mod, scm_caddr (expr));
+ if (scm_is_false (var))
+ error_unbound_variable (expr);
+
+ return var;
+}
+
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);
@@ -2662,9 +2705,6 @@ scm_ilookup (SCM iloc, SCM env)
SCM_SYMBOL (scm_unbound_variable_key, "unbound-variable");
-static void error_unbound_variable (SCM symbol) SCM_NORETURN;
-static void error_defined_variable (SCM symbol) SCM_NORETURN;
-
/* Call this for variables that are unfound.
*/
static void