mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 14:00:21 +02:00
Code Activity

* discouraged.h, tags.h (SCM_CONSP, SCM_NCONSP): Moved to

Browse source 
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.
This commit is contained in:
Marius Vollmer 2004-09-22 17:37:01 +00:00
parent 5dd82006b0
commit 6fcc7d48e4
4 changed files with 56 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

9
libguile/discouraged.h
View file

@ -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 */

39
libguile/pairs.c
View file

@ -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),

12
libguile/pairs.h
View file

@ -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 */

7
libguile/tags.h
View file

@ -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))