@ 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.

3 files changed, 47 insertions, 28 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
diff --git a/libguile/eval.h b/libguile/eval.h
index 333265263..f3ec2e19c 100644
--- a/libguile/eval.h
+++ b/libguile/eval.h
@@ -94,6 +94,8 @@ SCM_API SCM scm_sym_quasiquote;
 SCM_API SCM scm_sym_unquote;
 SCM_API SCM scm_sym_uq_splicing;
 
+SCM_API SCM scm_sym_at;
+SCM_API SCM scm_sym_atat;
 SCM_API SCM scm_sym_atapply;
 SCM_API SCM scm_sym_atcall_cc;
 SCM_API SCM scm_sym_at_call_with_values;
@@ -131,6 +133,8 @@ SCM_API SCM scm_m_future (SCM xorig, SCM env);
 SCM_API SCM scm_m_define (SCM x, SCM env);
 SCM_API SCM scm_m_letrec (SCM xorig, SCM env);
 SCM_API SCM scm_m_let (SCM xorig, SCM env);
+SCM_API SCM scm_m_at (SCM xorig, SCM env);
+SCM_API SCM scm_m_atat (SCM xorig, SCM env);
 SCM_API SCM scm_m_apply (SCM xorig, SCM env);
 SCM_API SCM scm_m_cont (SCM xorig, SCM env);
 #if SCM_ENABLE_ELISP
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 29c89b1f9..03d876907 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -2936,31 +2936,6 @@ module '(ice-9 q) '(make-q q-length))}."
 
 (define load load-module)
 
-;; The following macro allows one to write, for example,
-;;
-;;    (@ (ice-9 pretty-print) pretty-print)
-;;
-;; to refer directly to the pretty-print variable in module (ice-9
-;; pretty-print).  It works by looking up the variable and inserting
-;; it directly into the code.  This is understood by the evaluator.
-;; Indeed, all references to global variables are memoized into such
-;; variable objects.
-
-(define-macro (@ mod-name var-name)
-  (let ((var (module-variable (resolve-interface mod-name) var-name)))
-    (if (not var)
-	(error "no such public variable" (list '@ mod-name var-name)))
-    var))
-
-;; The '@@' macro is like '@' but it can also access bindings that
-;; have not been explicitely exported.
-
-(define-macro (@@ mod-name var-name)
-  (let ((var (module-variable (resolve-module mod-name) var-name)))
-    (if (not var)
-	(error "no such variable" (list '@@ mod-name var-name)))
-    var))
-
 
 
 ;;; {Compiler interface}