summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMarius Vollmer <mvo@zagadka.de>2004-09-22 17:37:01 +0000
committerMarius Vollmer <mvo@zagadka.de>2004-09-22 17:37:01 +0000
commit6fcc7d48e4940941e70ad820d74ea3880e6840d7 (patch)
tree2bc18edc2100597504bef98c1cd39c7445706538
parent5dd82006b0ff97ce05c87cf615c544a25b2c4f6d (diff)
downloadguile-6fcc7d48e4940941e70ad820d74ea3880e6840d7.tar.gz
* discouraged.h, tags.h (SCM_CONSP, SCM_NCONSP): Moved to
discouraged.h. Replaced all uses with scm_is_pair. (SCM_I_CONSP): New name for SCM_CONSP. * pairs.h, pairs.c (scm_is_pair, scm_is_null, scm_car, scm_cdr, scm_i_chase_pairs, SCM_I_A_PAT, SCM_I_D_PAT, etc, scm_caar, scm_cadr, etc): New. (SCM_NULLP, SCM_NNULLP): Moved to discouraged.h. Replaced all uses with scm_is_null.
-rw-r--r--libguile/discouraged.h9
-rw-r--r--libguile/pairs.c39
-rw-r--r--libguile/pairs.h12
-rw-r--r--libguile/tags.h7
4 files changed, 56 insertions, 11 deletions
diff --git a/libguile/discouraged.h b/libguile/discouraged.h
index c036d9ad2..50aa8fb09 100644
--- a/libguile/discouraged.h
+++ b/libguile/discouraged.h
@@ -148,6 +148,15 @@ SCM_API SCM scm_allocate_string (size_t len);
#define SCM_SYMBOL_HASH scm_i_symbol_hash
#define SCM_SYMBOL_INTERNED_P(X) scm_i_symbol_is_interned
+/* Discouraged because they evaluated their arguments twice and/or
+ don't fit the naming scheme.
+*/
+
+#define SCM_CONSP(x) (scm_is_pair (x))
+#define SCM_NCONSP(x) (!SCM_CONSP (x))
+#define SCM_NULLP(x) (scm_is_null (x))
+#define SCM_NNULLP(x) (!scm_is_null (x))
+
void scm_i_init_discouraged (void);
#endif /* SCM_ENABLE_DISCOURAGED == 1 */
diff --git a/libguile/pairs.c b/libguile/pairs.c
index 52abd6c7c..cf2782a06 100644
--- a/libguile/pairs.c
+++ b/libguile/pairs.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,2000,2001 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,2000,2001, 2004 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
@@ -74,10 +74,45 @@ SCM_DEFINE (scm_pair_p, "pair?", 1, 0, 0,
"@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
+int
+scm_is_pair (SCM x)
+{
+ return SCM_I_CONSP (x);
+}
+
+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_bits 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),
diff --git a/libguile/pairs.h b/libguile/pairs.h
index 854444c90..5435282e7 100644
--- a/libguile/pairs.h
+++ b/libguile/pairs.h
@@ -3,7 +3,7 @@
#ifndef SCM_PAIRS_H
#define SCM_PAIRS_H
-/* Copyright (C) 1995,1996,2000,2001 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,2000,2001, 2004 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
@@ -28,13 +28,12 @@
#if (SCM_DEBUG_PAIR_ACCESSES == 1)
# define SCM_VALIDATE_PAIR(cell, expr) \
- ((!SCM_CONSP (cell) ? scm_error_pair_access (cell), 0 : 0), (expr))
+ ((!scm_is_pair (cell) ? scm_error_pair_access (cell), 0 : 0), (expr))
#else
# define SCM_VALIDATE_PAIR(cell, expr) (expr)
#endif
-#define SCM_NULLP(x) (scm_is_eq ((x), SCM_EOL))
-#define SCM_NNULLP(x) (!SCM_NULLP (x))
+#define scm_is_null(x) (scm_is_eq ((x), SCM_EOL))
#define SCM_CAR(x) (SCM_VALIDATE_PAIR (x, SCM_CELL_OBJECT_0 (x)))
#define SCM_CDR(x) (SCM_VALIDATE_PAIR (x, SCM_CELL_OBJECT_1 (x)))
@@ -78,6 +77,9 @@
#if (SCM_DEBUG_PAIR_ACCESSES == 1)
SCM_API void scm_error_pair_access (SCM);
#endif
+
+SCM_API int scm_is_pair (SCM x);
+
SCM_API SCM scm_cons (SCM x, SCM y);
SCM_API SCM scm_cons2 (SCM w, SCM x, SCM y);
SCM_API SCM scm_pair_p (SCM x);
@@ -86,8 +88,6 @@ SCM_API SCM scm_cdr (SCM x);
SCM_API SCM scm_set_car_x (SCM pair, SCM value);
SCM_API SCM scm_set_cdr_x (SCM pair, SCM value);
-SCM_API int scm_is_pair (SCM val);
-
#define SCM_I_D_PAT 0x02 /* 00000010 */
#define SCM_I_A_PAT 0x03 /* 00000011 */
#define SCM_I_DD_PAT 0x0a /* 00001010 */
diff --git a/libguile/tags.h b/libguile/tags.h
index 911054d98..0d340c4b8 100644
--- a/libguile/tags.h
+++ b/libguile/tags.h
@@ -388,9 +388,10 @@ typedef unsigned long scm_t_bits;
/* Checking if a SCM variable holds a pair (for historical reasons, in Guile
* also known as a cons-cell): This is done by first checking that the SCM
* variable holds a non-immediate, and second, by checking that tc1==0 holds
- * for the SCM_CELL_TYPE of the SCM variable. */
-#define SCM_CONSP(x) (!SCM_IMP (x) && ((1 & SCM_CELL_TYPE (x)) == 0))
-#define SCM_NCONSP(x) (!SCM_CONSP (x))
+ * for the SCM_CELL_TYPE of the SCM variable.
+*/
+
+#define SCM_I_CONSP(x) (!SCM_IMP (x) && ((1 & SCM_CELL_TYPE (x)) == 0))