Merge branch 'master' into boehm-demers-weiser-gc

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

diff --git a/libguile/macros.c b/libguile/macros.c
index 32282f1..e8899f5 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...) */
@@ -30,6 +33,8 @@
 #include "libguile/validate.h"
 #include "libguile/macros.h"
 
+#include "libguile/private-options.h"
+
 scm_t_bits scm_tc16_macro;
 
 
@@ -38,8 +43,8 @@ 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))
@@ -66,7 +71,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 +82,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 +97,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 +115,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 +129,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 +157,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 +170,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 +191,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))
     {
@@ -229,7 +242,6 @@ void
 scm_init_macros ()
 {
   scm_tc16_macro = scm_make_smob_type ("macro", 0);
-  scm_set_smob_mark (scm_tc16_macro, scm_markcdr);
   scm_set_smob_print (scm_tc16_macro, macro_print);
 #include "libguile/macros.x"
 }