syntax-dispatch -> $sc-dispatch

[bpt/guile.git] / libguile / macros.c

diff --git a/libguile/macros.c b/libguile/macros.c
index 32282f1..d132c01 100644 (file)
--- a/libguile/macros.c
+++ b/libguile/macros.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003, 2006, 2008 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
@@ -12,11 +12,14 @@
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  */
 
 
 \f
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
 
 #include "libguile/_scm.h"
 #include "libguile/alist.h" /* for SCM_EXTEND_ENV (well...) */
@@ -28,8 +31,11 @@
 #include "libguile/deprecation.h"
 
 #include "libguile/validate.h"
+#include "libguile/programs.h"
 #include "libguile/macros.h"
 
+#include "libguile/private-options.h"
+
 scm_t_bits scm_tc16_macro;
 
 
@@ -38,11 +44,11 @@ macro_print (SCM macro, SCM port, scm_print_state *pstate)
 {
   SCM code = SCM_MACRO_CODE (macro);
   if (!SCM_CLOSUREP (code)
-      || SCM_FALSEP (scm_procedure_p (SCM_PRINT_CLOSURE))
-      || SCM_FALSEP (scm_printer_apply (SCM_PRINT_CLOSURE,
+      || scm_is_false (scm_procedure_p (SCM_PRINT_CLOSURE))
+      || scm_is_false (scm_printer_apply (SCM_PRINT_CLOSURE,
                                        macro, port, pstate)))
     {
-      if (!SCM_CLOSUREP (code))
+      if (!SCM_CLOSUREP (code) && !SCM_PROGRAM_P (code))
        scm_puts ("#<primitive-", port);
       else
        scm_puts ("#<", port);
@@ -66,7 +72,7 @@ macro_print (SCM macro, SCM port, scm_print_state *pstate)
          SCM formals = SCM_CLOSURE_FORMALS (code);
          SCM env = SCM_ENV (code);
          SCM xenv = SCM_EXTEND_ENV (formals, SCM_EOL, env);
-         SCM src = scm_unmemocopy (SCM_CODE (code), xenv);
+         SCM src = scm_i_unmemocopy_body (SCM_CODE (code), xenv);
          scm_putc (' ', port);
          scm_iprin1 (src, port, pstate);
        }
@@ -77,6 +83,14 @@ macro_print (SCM macro, SCM port, scm_print_state *pstate)
   return 1;
 }
 
+static SCM
+makmac (SCM code, scm_t_bits flags)
+{
+  SCM z;
+  SCM_NEWSMOB (z, scm_tc16_macro, SCM_UNPACK (code));
+  SCM_SET_SMOB_FLAGS (z, flags);
+  return z;
+}
 
 /* Return a mmacro that is known to be one of guile's built in macros. */
 SCM
@@ -84,7 +98,7 @@ scm_i_makbimacro (SCM code)
 #define FUNC_NAME "scm_i_makbimacro"
 {
   SCM_VALIDATE_PROC (1, code);
-  SCM_RETURN_NEWSMOB (scm_tc16_macro | (3L << 16), SCM_UNPACK (code));
+  return makmac (code, 3);
 }
 #undef FUNC_NAME
 
@@ -102,7 +116,7 @@ SCM_DEFINE (scm_makmmacro, "procedure->memoizing-macro", 1, 0, 0,
 #define FUNC_NAME s_scm_makmmacro
 {
   SCM_VALIDATE_PROC (1, code);
-  SCM_RETURN_NEWSMOB (scm_tc16_macro | (2L << 16), SCM_UNPACK (code));
+  return makmac (code, 2);
 }
 #undef FUNC_NAME
 
@@ -116,7 +130,7 @@ SCM_DEFINE (scm_makacro, "procedure->syntax", 1, 0, 0,
 #define FUNC_NAME s_scm_makacro
 {
   SCM_VALIDATE_PROC (1, code);
-  SCM_RETURN_NEWSMOB (scm_tc16_macro, SCM_UNPACK (code));
+  return makmac (code, 0);
 }
 #undef FUNC_NAME
 
@@ -144,7 +158,7 @@ SCM_DEFINE (scm_makmacro, "procedure->macro", 1, 0, 0,
      " or r5rs macros instead.");
 
   SCM_VALIDATE_PROC (1, code);
-  SCM_RETURN_NEWSMOB (scm_tc16_macro | (1L << 16), SCM_UNPACK (code));
+  return makmac (code, 1);
 }
 #undef FUNC_NAME
 
@@ -157,7 +171,7 @@ SCM_DEFINE (scm_macro_p, "macro?", 1, 0, 0,
            "syntax transformer.")
 #define FUNC_NAME s_scm_macro_p
 {
-  return SCM_BOOL (SCM_TYP16_PREDICATE (scm_tc16_macro, obj));
+  return scm_from_bool (SCM_SMOB_PREDICATE (scm_tc16_macro, obj));
 }
 #undef FUNC_NAME
 
@@ -178,7 +192,7 @@ SCM_DEFINE (scm_macro_type, "macro-type", 1, 0, 0,
            "returned.")
 #define FUNC_NAME s_scm_macro_type
 {
-  if (!SCM_TYP16_PREDICATE (scm_tc16_macro, m))
+  if (!SCM_SMOB_PREDICATE (scm_tc16_macro, m))
     return SCM_BOOL_F;
   switch (SCM_MACRO_TYPE (m))
     {
@@ -210,9 +224,15 @@ SCM_DEFINE (scm_macro_transformer, "macro-transformer", 1, 0, 0,
            "Return the transformer of the macro @var{m}.")
 #define FUNC_NAME s_scm_macro_transformer
 {
+  SCM data;
+
   SCM_VALIDATE_SMOB (1, m, macro);
-  return ((SCM_CLOSUREP (SCM_PACK (SCM_SMOB_DATA (m)))) ?
-         SCM_PACK(SCM_SMOB_DATA (m)) : SCM_BOOL_F);
+  data = SCM_PACK (SCM_SMOB_DATA (m));
+  
+  if (SCM_CLOSUREP (data) || SCM_PROGRAM_P (data))
+    return data;
+  else
+    return SCM_BOOL_F;
 }
 #undef FUNC_NAME