Merge remote-tracking branch 'origin/stable-2.0'

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

diff --git a/libguile/expand.c b/libguile/expand.c
index af6eb7d..cb32e37 100644 (file)
--- a/libguile/expand.c
+++ b/libguile/expand.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008,2009,2010,2011
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008,2009,2010,2011,2012
  * Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
@@ -49,9 +49,12 @@ static const char* exp_names[SCM_NUM_EXPANDED_TYPES];
 static const char** exp_field_names[SCM_NUM_EXPANDED_TYPES];
 
 
-#define VOID(src) \
+/* The trailing underscores on these first to are to avoid spurious
+   conflicts with macros defined on MinGW.  */
+
+#define VOID_(src) \
   SCM_MAKE_EXPANDED_VOID(src)
-#define CONST(src, exp) \
+#define CONST_(src, exp) \
   SCM_MAKE_EXPANDED_CONST(src, exp)
 #define PRIMITIVE_REF_TYPE(src, name) \
   SCM_MAKE_EXPANDED_PRIMITIVE_REF_TYPE(src, name)
@@ -73,8 +76,8 @@ static const char** exp_field_names[SCM_NUM_EXPANDED_TYPES];
   SCM_MAKE_EXPANDED_CONDITIONAL(src, test, consequent, alternate)
 #define CALL(src, proc, exps) \
   SCM_MAKE_EXPANDED_CALL(src, proc, exps)
-#define SEQUENCE(src, exps) \
-  SCM_MAKE_EXPANDED_SEQUENCE(src, exps)
+#define SEQ(src, head, tail) \
+  SCM_MAKE_EXPANDED_SEQ(src, head, tail)
 #define LAMBDA(src, meta, body) \
   SCM_MAKE_EXPANDED_LAMBDA(src, meta, body)
 #define LAMBDA_CASE(src, req, opt, rest, kw, inits, gensyms, body, alternate) \
@@ -375,7 +378,7 @@ expand (SCM exp, SCM env)
         return TOPLEVEL_REF (SCM_BOOL_F, exp);
     }
   else
-    return CONST (SCM_BOOL_F, exp);
+    return CONST_ (SCM_BOOL_F, exp);
 }
 
 static SCM
@@ -396,7 +399,9 @@ expand_sequence (const SCM forms, const SCM env)
   if (scm_is_null (CDR (forms)))
     return expand (CAR (forms), env);
   else
-    return SEQUENCE (SCM_BOOL_F, expand_exprs (forms, env));
+    return SEQ (scm_source_properties (forms),
+                expand (CAR (forms), env),
+                expand_sequence (CDR (forms), env));
 }
 
 
@@ -431,7 +436,7 @@ expand_and (SCM expr, SCM env)
   const SCM cdr_expr = CDR (expr);
 
   if (scm_is_null (cdr_expr))
-    return CONST (SCM_BOOL_F, SCM_BOOL_T);
+    return CONST_ (SCM_BOOL_F, SCM_BOOL_T);
 
   ASSERT_SYNTAX (scm_is_pair (cdr_expr), s_bad_expression, expr);
 
@@ -441,7 +446,7 @@ expand_and (SCM expr, SCM env)
     return CONDITIONAL (scm_source_properties (expr),
                         expand (CAR (cdr_expr), env),
                         expand_and (cdr_expr, env),
-                        CONST (SCM_BOOL_F, SCM_BOOL_F));
+                        CONST_ (SCM_BOOL_F, SCM_BOOL_F));
 }
 
 static SCM
@@ -469,7 +474,7 @@ expand_cond_clauses (SCM clause, SCM rest, int elp, int alp, SCM env)
     }
 
   if (scm_is_null (rest))
-    rest = VOID (SCM_BOOL_F);
+    rest = VOID_ (SCM_BOOL_F);
   else
     rest = expand_cond_clauses (CAR (rest), CDR (rest), elp, alp, env);
 
@@ -586,7 +591,7 @@ expand_eval_when (SCM expr, SCM env)
       || scm_is_true (scm_memq (sym_load, CADR (expr))))
     return expand_sequence (CDDR (expr), env);
   else
-    return VOID (scm_source_properties (expr));
+    return VOID_ (scm_source_properties (expr));
 }
 
 static SCM
@@ -600,7 +605,7 @@ expand_if (SCM expr, SCM env SCM_UNUSED)
                       expand (CADDR (expr), env),
                       ((length == 3)
                        ? expand (CADDDR (expr), env)
-                       : VOID (SCM_BOOL_F)));
+                       : VOID_ (SCM_BOOL_F)));
 }
 
 /* A helper function for expand_lambda to support checking for duplicate
@@ -789,7 +794,7 @@ expand_lambda_star_case (SCM clause, SCM alternate, SCM env)
       vars = scm_cons (scm_gensym (SCM_UNDEFINED), vars);
       env = scm_acons (x, CAR (vars), env);
       if (scm_is_symbol (x))
-        inits = scm_cons (CONST (SCM_BOOL_F, SCM_BOOL_F), inits);
+        inits = scm_cons (CONST_ (SCM_BOOL_F, SCM_BOOL_F), inits);
       else
         {
           ASSERT_SYNTAX (scm_ilength (x) == 2 && scm_is_symbol (CAR (x)),
@@ -1109,7 +1114,7 @@ expand_or (SCM expr, SCM env SCM_UNUSED)
   ASSERT_SYNTAX (length >= 0, s_bad_expression, expr);
 
   if (scm_is_null (CDR (expr)))
-    return CONST (SCM_BOOL_F, SCM_BOOL_F);
+    return CONST_ (SCM_BOOL_F, SCM_BOOL_F);
   else
     {
       SCM tmp = scm_gensym (SCM_UNDEFINED);
@@ -1133,7 +1138,7 @@ expand_quote (SCM expr, SCM env SCM_UNUSED)
   ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 0, s_bad_expression, expr);
   ASSERT_SYNTAX (scm_ilength (cdr_expr) == 1, s_expression, expr);
   quotee = CAR (cdr_expr);
-  return CONST (scm_source_properties (expr), quotee);
+  return CONST_ (scm_source_properties (expr), quotee);
 }
 
 static SCM
@@ -1212,13 +1217,13 @@ make_exp_vtable (size_t n)
     (scm_string_append (scm_make_list (scm_from_size_t (exp_nfields[n]),
                                        scm_from_locale_string ("pw"))));
   printer = SCM_BOOL_F;
-  name = scm_from_locale_symbol (exp_names[n]);
+  name = scm_from_utf8_symbol (exp_names[n]);
   code = scm_from_size_t (n);
   fields = SCM_EOL;
   {
     size_t m = exp_nfields[n];
     while (m--)
-      fields = scm_cons (scm_from_locale_symbol (exp_field_names[n][m]), fields);
+      fields = scm_cons (scm_from_utf8_symbol (exp_field_names[n][m]), fields);
   }
 
   return scm_c_make_struct (scm_exp_vtable_vtable, 0, 5,
@@ -1245,7 +1250,7 @@ scm_init_expand ()
   DEFINE_NAMES (CONDITIONAL);
   DEFINE_NAMES (CALL);
   DEFINE_NAMES (PRIMCALL);
-  DEFINE_NAMES (SEQUENCE);
+  DEFINE_NAMES (SEQ);
   DEFINE_NAMES (LAMBDA);
   DEFINE_NAMES (LAMBDA_CASE);
   DEFINE_NAMES (LET);