-/* Copyright (C) 1995,1996,2000,2001 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,2000,2001, 2004, 2005, 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
*
* 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/validate.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");
+ SCM message = scm_from_locale_string ("Non-pair accessed with SCM_C[AD]R: `~S'\n");
if (!running)
{
"@code{#f}.")
#define FUNC_NAME s_scm_pair_p
{
- return scm_from_bool (SCM_CONSP (x));
+ return scm_from_bool (scm_is_pair (x));
}
#undef FUNC_NAME
+SCM
+scm_car (SCM pair)
+{
+ if (!scm_is_pair (pair))
+ scm_wrong_type_arg_msg (NULL, 0, pair, "pair");
+ return SCM_CAR (pair);
+}
+
+SCM
+scm_cdr (SCM pair)
+{
+ if (!scm_is_pair (pair))
+ scm_wrong_type_arg_msg (NULL, 0, pair, "pair");
+ return SCM_CDR (pair);
+}
+
+SCM
+scm_i_chase_pairs (SCM tree, scm_t_uint32 pattern)
+{
+ do
+ {
+ if (!scm_is_pair (tree))
+ scm_wrong_type_arg_msg (NULL, 0, tree, "pair");
+ tree = (pattern & 1) ? SCM_CAR (tree) : SCM_CDR (tree);
+ pattern >>= 2;
+ }
+ while (pattern);
+ return tree;
+}
SCM_DEFINE (scm_set_car_x, "set-car!", 2, 0, 0,
(SCM pair, SCM value),