diff options
-rw-r--r-- | libguile/discouraged.h | 9 | ||||
-rw-r--r-- | libguile/pairs.c | 39 | ||||
-rw-r--r-- | libguile/pairs.h | 12 | ||||
-rw-r--r-- | libguile/tags.h | 7 |
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)) |