-/* Copyright (C) 1995,1996, 2000 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
* 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"
/* {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;
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));
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
}