diff options
author | Marius Vollmer <mvo@zagadka.de> | 2004-09-22 17:37:01 +0000 |
---|---|---|
committer | Marius Vollmer <mvo@zagadka.de> | 2004-09-22 17:37:01 +0000 |
commit | 6fcc7d48e4940941e70ad820d74ea3880e6840d7 (patch) | |
tree | 2bc18edc2100597504bef98c1cd39c7445706538 /libguile/pairs.c | |
parent | 5dd82006b0ff97ce05c87cf615c544a25b2c4f6d (diff) | |
download | guile-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.
Diffstat (limited to 'libguile/pairs.c')
-rw-r--r-- | libguile/pairs.c | 39 |
1 files changed, 37 insertions, 2 deletions
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), |