* eval.c (RETURN): Wrap in do{}while(0) in order to make it

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

diff --git a/libguile/pairs.c b/libguile/pairs.c
index 8fa082a..88ce017 100644 (file)
--- a/libguile/pairs.c
+++ b/libguile/pairs.c
@@ -1,4 +1,4 @@
-/*     Copyright (C) 1995,1996 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,2000,2001 Free Software Foundation, Inc.
  * 
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
@@ -39,12 +39,9 @@
  * whether to permit this exception to apply to your modifications.
  * If you do not wish that, delete this exception notice.  */
 
-/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
-   gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
 
 \f
 
-#include <stdio.h>
 #include "libguile/_scm.h"
 #include "libguile/validate.h"
 
@@ -55,11 +52,32 @@
 /* {Pairs}
  */
 
+#if (SCM_DEBUG_PAIR_ACCESSES == 1)
+
+#include "libguile/ports.h"
+#include "libguile/strings.h"
+
+void scm_error_pair_access (SCM non_pair)
+{
+  static unsigned int running = 0;
+  SCM message = scm_makfrom0str ("Non-pair accessed with SCM_C[AD]R: `~S´\n");
+
+  if (!running)
+    {
+      running = 1;
+      scm_simple_format (scm_current_error_port (),
+                        message, scm_list_1 (non_pair));
+      abort ();
+    }
+}
+
+#endif
+
 SCM_DEFINE (scm_cons, "cons", 2, 0, 0,
            (SCM x, SCM y),
-            "Returns a newly allocated pair whose car is @var{x} and whose cdr is\n"
-            "@var{y}.  The pair is guaranteed to be different (in the sense of\n"
-            "@code{eqv?}) from every previously existing object.")
+           "Return a newly allocated pair whose car is @var{x} and whose\n"
+           "cdr is @var{y}.  The pair is guaranteed to be different (in the\n"
+           "sense of @code{eq?}) from every previously existing object.")
 #define FUNC_NAME s_scm_cons
 {
   SCM z;
@@ -91,7 +109,8 @@ scm_cons2 (SCM w, SCM x, SCM y)
 
 SCM_DEFINE (scm_pair_p, "pair?", 1, 0, 0, 
             (SCM x),
-            "Returns @code{#t} if @var{x} is a pair; otherwise returns @code{#f}.")
+           "Return @code{#t} if @var{x} is a pair; otherwise return\n"
+           "@code{#f}.")
 #define FUNC_NAME s_scm_pair_p
 {
   return SCM_BOOL (SCM_CONSP (x));
@@ -169,9 +188,11 @@ scm_init_pairs ()
   unsigned int subnr = 0;
 
   for (subnr = 0; cxrs [subnr]; subnr++)
-    scm_make_subr(cxrs [subnr], scm_tc7_cxr, NULL);
+    scm_c_define_subr (cxrs [subnr], scm_tc7_cxr, NULL);
 
+#ifndef SCM_MAGIC_SNARFER
 #include "libguile/pairs.x"
+#endif
 }