diff options
| author | Marius Vollmer <mvo@zagadka.de> | 2004-09-22 17:41:37 +0000 |
|---|---|---|
| committer | Marius Vollmer <mvo@zagadka.de> | 2004-09-22 17:41:37 +0000 |
| commit | d2e53ed6f84df8c79f4bf5cf41d4f6d381bc065b (patch) | |
| tree | df14a633c6d8ac08ba098651a9164a0c991d8288 | |
| parent | a61f4e0c61695e17984b25b16fbf720b851b739c (diff) | |
*** empty log message ***
56 files changed, 392 insertions, 923 deletions
diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 2fb8eb276..724ebb4d5 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,7 +1,17 @@ -2004-09-22 Marius Vollmer <marius.vollmer@uni-dortmund.de> +2004-09-22 Marius Vollmer <mvo@zagadka.de> + + * 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 (scm_car, scm_cdr, scm_i_chase_pairs, SCM_I_A_PAT, - SCM_I_D_PAT, etc, scm_caar, scm_cadr, etc): New. + * 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. + + * eval.c (scm_eval, scm_apply, call_cxr_1): Use scm_i_chase_pairs + instead of explicit code. 2004-09-22 Marius Vollmer <mvo@zagadka.de> diff --git a/libguile/alist.c b/libguile/alist.c index 9a1f4d090..314c1f8e4 100644 --- a/libguile/alist.c +++ b/libguile/alist.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995, 96, 97, 98, 99, 2000, 2001 Free Software Foundation, Inc. +/* Copyright (C) 1995, 96, 97, 98, 99, 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 @@ -23,6 +23,7 @@ #include "libguile/lang.h" #include "libguile/validate.h" +#include "libguile/pairs.h" #include "libguile/alist.h" @@ -49,10 +50,10 @@ SCM_DEFINE (scm_sloppy_assq, "sloppy-assq", 2, 0, 0, "Recommended only for use in Guile internals.") #define FUNC_NAME s_scm_sloppy_assq { - for (; SCM_CONSP (alist); alist = SCM_CDR (alist)) + for (; scm_is_pair (alist); alist = SCM_CDR (alist)) { SCM tmp = SCM_CAR (alist); - if (SCM_CONSP (tmp) && scm_is_eq (SCM_CAR (tmp), key)) + if (scm_is_pair (tmp) && scm_is_eq (SCM_CAR (tmp), key)) return tmp; } return SCM_BOOL_F; @@ -67,10 +68,10 @@ SCM_DEFINE (scm_sloppy_assv, "sloppy-assv", 2, 0, 0, "Recommended only for use in Guile internals.") #define FUNC_NAME s_scm_sloppy_assv { - for (; SCM_CONSP (alist); alist = SCM_CDR (alist)) + for (; scm_is_pair (alist); alist = SCM_CDR (alist)) { SCM tmp = SCM_CAR (alist); - if (SCM_CONSP (tmp) + if (scm_is_pair (tmp) && scm_is_true (scm_eqv_p (SCM_CAR (tmp), key))) return tmp; } @@ -85,10 +86,10 @@ SCM_DEFINE (scm_sloppy_assoc, "sloppy-assoc", 2, 0, 0, "Recommended only for use in Guile internals.") #define FUNC_NAME s_scm_sloppy_assoc { - for (; SCM_CONSP (alist); alist = SCM_CDR (alist)) + for (; scm_is_pair (alist); alist = SCM_CDR (alist)) { SCM tmp = SCM_CAR (alist); - if (SCM_CONSP (tmp) + if (scm_is_pair (tmp) && scm_is_true (scm_equal_p (SCM_CAR (tmp), key))) return tmp; } @@ -113,10 +114,10 @@ SCM_DEFINE (scm_assq, "assq", 2, 0, 0, #define FUNC_NAME s_scm_assq { SCM ls = alist; - for (; SCM_CONSP (ls); ls = SCM_CDR (ls)) + for(; scm_is_pair (ls); ls = SCM_CDR (ls)) { SCM tmp = SCM_CAR (ls); - SCM_ASSERT_TYPE (SCM_CONSP (tmp), alist, SCM_ARG2, FUNC_NAME, + SCM_ASSERT_TYPE (scm_is_pair (tmp), alist, SCM_ARG2, FUNC_NAME, "association list"); if (scm_is_eq (SCM_CAR (tmp), key)) return tmp; @@ -134,10 +135,10 @@ SCM_DEFINE (scm_assv, "assv", 2, 0, 0, #define FUNC_NAME s_scm_assv { SCM ls = alist; - for(; SCM_CONSP (ls); ls = SCM_CDR (ls)) + for(; scm_is_pair (ls); ls = SCM_CDR (ls)) { SCM tmp = SCM_CAR (ls); - SCM_ASSERT_TYPE (SCM_CONSP (tmp), alist, SCM_ARG2, FUNC_NAME, + SCM_ASSERT_TYPE (scm_is_pair (tmp), alist, SCM_ARG2, FUNC_NAME, "association list"); if (scm_is_true (scm_eqv_p (SCM_CAR (tmp), key))) return tmp; @@ -155,10 +156,10 @@ SCM_DEFINE (scm_assoc, "assoc", 2, 0, 0, #define FUNC_NAME s_scm_assoc { SCM ls = alist; - for(; SCM_CONSP (ls); ls = SCM_CDR (ls)) + for(; scm_is_pair (ls); ls = SCM_CDR (ls)) { SCM tmp = SCM_CAR (ls); - SCM_ASSERT_TYPE (SCM_CONSP (tmp), alist, SCM_ARG2, FUNC_NAME, + SCM_ASSERT_TYPE (scm_is_pair (tmp), alist, SCM_ARG2, FUNC_NAME, "association list"); if (scm_is_true (scm_equal_p (SCM_CAR (tmp), key))) return tmp; @@ -201,7 +202,7 @@ SCM_DEFINE (scm_assq_ref, "assq-ref", 2, 0, 0, SCM handle; handle = scm_sloppy_assq (key, alist); - if (SCM_CONSP (handle)) + if (scm_is_pair (handle)) { return SCM_CDR (handle); } @@ -218,7 +219,7 @@ SCM_DEFINE (scm_assv_ref, "assv-ref", 2, 0, 0, SCM handle; handle = scm_sloppy_assv (key, alist); - if (SCM_CONSP (handle)) + if (scm_is_pair (handle)) { return SCM_CDR (handle); } @@ -235,7 +236,7 @@ SCM_DEFINE (scm_assoc_ref, "assoc-ref", 2, 0, 0, SCM handle; handle = scm_sloppy_assoc (key, alist); - if (SCM_CONSP (handle)) + if (scm_is_pair (handle)) { return SCM_CDR (handle); } @@ -264,7 +265,7 @@ SCM_DEFINE (scm_assq_set_x, "assq-set!", 3, 0, 0, SCM handle; handle = scm_sloppy_assq (key, alist); - if (SCM_CONSP (handle)) + if (scm_is_pair (handle)) { SCM_SETCDR (handle, val); return alist; @@ -282,7 +283,7 @@ SCM_DEFINE (scm_assv_set_x, "assv-set!", 3, 0, 0, SCM handle; handle = scm_sloppy_assv (key, alist); - if (SCM_CONSP (handle)) + if (scm_is_pair (handle)) { SCM_SETCDR (handle, val); return alist; @@ -300,7 +301,7 @@ SCM_DEFINE (scm_assoc_set_x, "assoc-set!", 3, 0, 0, SCM handle; handle = scm_sloppy_assoc (key, alist); - if (SCM_CONSP (handle)) + if (scm_is_pair (handle)) { SCM_SETCDR (handle, val); return alist; @@ -324,7 +325,7 @@ SCM_DEFINE (scm_assq_remove_x, "assq-remove!", 2, 0, 0, SCM handle; handle = scm_sloppy_assq (key, alist); - if (SCM_CONSP (handle)) + if (scm_is_pair (handle)) alist = scm_delq1_x (handle, alist); return alist; @@ -340,7 +341,7 @@ SCM_DEFINE (scm_assv_remove_x, "assv-remove!", 2, 0, 0, SCM handle; handle = scm_sloppy_assv (key, alist); - if (SCM_CONSP (handle)) + if (scm_is_pair (handle)) alist = scm_delq1_x (handle, alist); return alist; @@ -356,7 +357,7 @@ SCM_DEFINE (scm_assoc_remove_x, "assoc-remove!", 2, 0, 0, SCM handle; handle = scm_sloppy_assoc (key, alist); - if (SCM_CONSP (handle)) + if (scm_is_pair (handle)) alist = scm_delq1_x (handle, alist); return alist; diff --git a/libguile/async.c b/libguile/async.c index 333b8d0e1..35e8a5a66 100644 --- a/libguile/async.c +++ b/libguile/async.c @@ -149,7 +149,7 @@ scm_async_click () if (scm_root->block_asyncs == 0) { SCM asyncs; - while (!SCM_NULLP(asyncs = scm_root->active_asyncs)) + while (!scm_is_null(asyncs = scm_root->active_asyncs)) { scm_root->active_asyncs = SCM_EOL; do @@ -157,9 +157,9 @@ scm_async_click () scm_call_0 (SCM_CAR (asyncs)); asyncs = SCM_CDR (asyncs); } - while (!SCM_NULLP(asyncs)); + while (!scm_is_null(asyncs)); } - for (asyncs = scm_root->signal_asyncs; !SCM_NULLP(asyncs); + for (asyncs = scm_root->signal_asyncs; !scm_is_null(asyncs); asyncs = SCM_CDR (asyncs)) { if (scm_is_true (SCM_CAR (asyncs))) diff --git a/libguile/backtrace.c b/libguile/backtrace.c index 09430f5cc..f4af252b7 100644 --- a/libguile/backtrace.c +++ b/libguile/backtrace.c @@ -381,7 +381,7 @@ display_frame_expr (char *hdr, SCM exp, char *tlr, int indentation, SCM sport, S { pstate->length = print_params[i].length; ptob->seek (sport, 0, SEEK_SET); - if (SCM_CONSP (exp)) + if (scm_is_pair (exp)) { pstate->level = print_params[i].level - 1; scm_iprlist (hdr, exp, tlr[0], sport, pstate); @@ -607,14 +607,14 @@ display_frame (SCM frame, int nfield, int indentation, SCM sport, SCM port, scm_ /* Display a special form. */ { SCM source = SCM_FRAME_SOURCE (frame); - SCM copy = (SCM_CONSP (source) + SCM copy = (scm_is_pair (source) ? scm_source_property (source, scm_sym_copy) : SCM_BOOL_F); SCM umcopy = (SCM_MEMOIZEDP (source) ? scm_i_unmemoize_expr (source) : SCM_BOOL_F); display_frame_expr ("(", - SCM_CONSP (copy) ? copy : umcopy, + scm_is_pair (copy) ? copy : umcopy, ")", nfield + 1 + indentation, sport, diff --git a/libguile/coop-pthreads.c b/libguile/coop-pthreads.c index 57386d4ae..f99417002 100644 --- a/libguile/coop-pthreads.c +++ b/libguile/coop-pthreads.c @@ -46,7 +46,7 @@ static void enqueue (SCM q, SCM t) { SCM c = scm_cons (t, SCM_EOL); - if (SCM_NULLP (SCM_CAR (q))) + if (scm_is_null (SCM_CAR (q))) SCM_SETCAR (q, c); else SCM_SETCDR (SCM_CDR (q), c); @@ -57,12 +57,12 @@ static SCM dequeue (SCM q) { SCM c = SCM_CAR (q); - if (SCM_NULLP (c)) + if (scm_is_null (c)) return SCM_BOOL_F; else { SCM_SETCAR (q, SCM_CDR (c)); - if (SCM_NULLP (SCM_CAR (q))) + if (scm_is_null (SCM_CAR (q))) SCM_SETCDR (q, SCM_EOL); return SCM_CAR (c); } @@ -546,7 +546,7 @@ scm_call_with_new_thread (SCM argl) /* Check arguments. */ { register SCM args = argl; - if (!SCM_CONSP (args)) + if (!scm_is_pair (args)) SCM_WRONG_NUM_ARGS (); thunk = SCM_CAR (args); SCM_ASSERT (scm_is_true (scm_thunk_p (thunk)), @@ -554,14 +554,14 @@ scm_call_with_new_thread (SCM argl) SCM_ARG1, s_call_with_new_thread); args = SCM_CDR (args); - if (!SCM_CONSP (args)) + if (!scm_is_pair (args)) SCM_WRONG_NUM_ARGS (); handler = SCM_CAR (args); SCM_ASSERT (scm_is_true (scm_procedure_p (handler)), handler, SCM_ARG2, s_call_with_new_thread); - if (!SCM_NULLP (SCM_CDR (args))) + if (!scm_is_null (SCM_CDR (args))) SCM_WRONG_NUM_ARGS (); } @@ -738,7 +738,7 @@ scm_timed_wait_condition_variable (SCM cv, SCM mx, SCM t) s_wait_condition_variable); if (!SCM_UNBNDP (t)) { - if (SCM_CONSP (t)) + if (scm_is_pair (t)) { SCM_VALIDATE_UINT_COPY (3, SCM_CAR(t), waittime.tv_sec); SCM_VALIDATE_UINT_COPY (3, SCM_CDR(t), waittime.tv_nsec); @@ -858,7 +858,7 @@ void scm_threads_mark_stacks (void) { volatile SCM c; - for (c = all_threads; !SCM_NULLP (c); c = SCM_CDR (c)) + for (c = all_threads; !scm_is_null (c); c = SCM_CDR (c)) { scm_copt_thread *t = SCM_THREAD_DATA (SCM_CAR (c)); if (t->base == NULL) diff --git a/libguile/coop-threads.c b/libguile/coop-threads.c index cd50b45aa..e69de29bb 100644 --- a/libguile/coop-threads.c +++ b/libguile/coop-threads.c @@ -1,549 +0,0 @@ -/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002 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 - * License as published by the Free Software Foundation; either - * version 2.1 of the License, or (at your option) any later version. - * - * This library is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - * Lesser General Public License for more details. - * - * 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 - */ - - - - -#include "libguile/_scm.h" -#include "libguile/validate.h" -#include "libguile/coop-threads.h" -#include "libguile/root.h" - -/* A counter of the current number of threads */ -size_t scm_thread_count = 0; - -/* This is included rather than compiled separately in order - to simplify the configuration mechanism. */ -#include "libguile/coop.c" - -/* A count-down counter used to determine when to switch - contexts */ -size_t scm_switch_counter = SCM_THREAD_SWITCH_COUNT; - -coop_m scm_critical_section_mutex; - -static SCM all_threads; - -void -scm_threads_init (SCM_STACKITEM *i) -{ - coop_init(); - - scm_tc16_thread = scm_make_smob_type ("thread", 0); - scm_tc16_mutex = scm_make_smob_type ("mutex", sizeof (coop_m)); - scm_tc16_condvar = scm_make_smob_type ("condition-variable", - sizeof (coop_c)); - - scm_thread_count = 1; - -#ifndef GUILE_PTHREAD_COMPAT - coop_global_main.sto = i; -#endif - coop_global_main.base = i; - coop_global_curr = &coop_global_main; - coop_all_qput (&coop_global_allq, coop_global_curr); - - coop_mutex_init (&scm_critical_section_mutex); - - coop_global_main.data = 0; /* Initialized in init.c */ - - coop_global_main.handle = scm_cell (scm_tc16_thread, - (scm_t_bits) &coop_global_main); - - scm_gc_register_root (&all_threads); - all_threads = scm_cons (coop_global_main.handle, SCM_EOL); -} - -void -scm_threads_mark_stacks (void) -{ - coop_t *thread; - - for (thread = coop_global_allq.t.all_next; - thread != NULL; thread = thread->all_next) - { - if (thread == coop_global_curr) - { - /* Active thread */ - /* stack_len is long rather than sizet in order to guarantee - that &stack_len is long aligned */ -#if SCM_STACK_GROWS_UP - long stack_len = ((SCM_STACKITEM *) (&thread) - - (SCM_STACKITEM *) thread->base); - - /* Protect from the C stack. This must be the first marking - * done because it provides information about what objects - * are "in-use" by the C code. "in-use" objects are those - * for which the information about length and base address must - * remain usable. This requirement is stricter than a liveness - * requirement -- in particular, it constrains the implementation - * of scm_resizuve. - */ - SCM_FLUSH_REGISTER_WINDOWS; - /* This assumes that all registers are saved into the jmp_buf */ - setjmp (scm_save_regs_gc_mark); - scm_mark_locations ((SCM_STACKITEM *) scm_save_regs_gc_mark, - ((size_t) sizeof scm_save_regs_gc_mark - / sizeof (SCM_STACKITEM))); - - scm_mark_locations (((size_t) thread->base, - (sizet) stack_len)); -#else - long stack_len = ((SCM_STACKITEM *) thread->base - - (SCM_STACKITEM *) (&thread)); - - /* Protect from the C stack. This must be the first marking - * done because it provides information about what objects - * are "in-use" by the C code. "in-use" objects are those - * for which the information about length and base address must - * remain usable. This requirement is stricter than a liveness - * requirement -- in particular, it constrains the implementation - * of scm_resizuve. - */ - SCM_FLUSH_REGISTER_WINDOWS; - /* This assumes that all registers are saved into the jmp_buf */ - setjmp (scm_save_regs_gc_mark); - scm_mark_locations ((SCM_STACKITEM *) scm_save_regs_gc_mark, - ((size_t) sizeof scm_save_regs_gc_mark - / sizeof (SCM_STACKITEM))); - - scm_mark_locations ((SCM_STACKITEM *) &thread, - stack_len); -#endif - } - else - { - /* Suspended thread */ -#if SCM_STACK_GROWS_UP - long stack_len = ((SCM_STACKITEM *) (thread->sp) - - (SCM_STACKITEM *) thread->base); - - scm_mark_locations ((size_t)thread->base, - (sizet) stack_len); -#else - long stack_len = ((SCM_STACKITEM *) thread->base - - (SCM_STACKITEM *) (thread->sp)); - - /* Registers are already on the stack. No need to mark. */ - - scm_mark_locations ((SCM_STACKITEM *) (size_t)thread->sp, - stack_len); -#endif - } - - /* Mark this thread's root */ - scm_gc_mark (((scm_root_state *) thread->data) -> handle); - } -} - -/* NOTE: There are TWO mechanisms for starting a thread: The first one - is used when spawning a thread from Scheme, while the second one is - used from C. - - It might be argued that the first should be implemented in terms of - the second. The reason it isn't is that that would require an - extra unnecessary malloc (the thread_args structure). By providing - one pair of extra functions (c_launch_thread, scm_spawn_thread) the - Scheme threads are started more efficiently. */ - -/* This is the first thread spawning mechanism: threads from Scheme */ - -typedef struct scheme_launch_data { - SCM rootcont; - SCM body; - SCM handler; -} scheme_launch_data; - -static SCM -scheme_body_bootstrip (scheme_launch_data* data) -{ - /* First save the new root continuation */ - data->rootcont = scm_root->rootcont; - return scm_call_0 (data->body); -} - -static SCM -scheme_handler_bootstrip (scheme_launch_data* data, SCM tag, SCM throw_args) -{ - scm_root->rootcont = data->rootcont; - return scm_apply_1 (data->handler, tag, throw_args); -} - -static void -scheme_launch_thread (void *p) -{ - /* The thread object will be GC protected by being a member of the - list given as argument to launch_thread. It will be marked - during the conservative sweep of the stack. */ - register SCM argl = (SCM) p; - SCM thread = SCM_CAR (argl); - scheme_launch_data data; - data.rootcont = SCM_BOOL_F; - data.body = SCM_CADR (argl); - data.handler = SCM_CADDR (argl); - scm_internal_cwdr ((scm_t_catch_body) scheme_body_bootstrip, - &data, - (scm_t_catch_handler) scheme_handler_bootstrip, - &data, - (SCM_STACKITEM *) &thread); - SCM_SET_CELL_WORD_1 (thread, 0); - scm_thread_count--; - all_threads = scm_delq (thread, all_threads); - SCM_DEFER_INTS; -} - - -SCM -scm_call_with_new_thread (SCM argl) -#define FUNC_NAME s_call_with_new_thread -{ - SCM thread; - - /* Check arguments. */ - { - register SCM args = argl; - SCM thunk, handler; - if (!SCM_CONSP (args)) - SCM_WRONG_NUM_ARGS (); - thunk = SCM_CAR (args); - SCM_ASSERT (scm_is_true (scm_thunk_p (thunk)), - thunk, - SCM_ARG1, - s_call_with_new_thread); - args = SCM_CDR (args); - if (!SCM_CONSP (args)) - SCM_WRONG_NUM_ARGS (); - handler = SCM_CAR (args); - SCM_ASSERT (scm_is_true (scm_procedure_p (handler)), - handler, - SCM_ARG2, - s_call_with_new_thread); - if (!SCM_NULLP (SCM_CDR (args))) - SCM_WRONG_NUM_ARGS (); - } - - /* Make new thread. */ - { - coop_t *t; - SCM root, old_winds; - - /* Unwind wind chain. */ - old_winds = scm_dynwinds; - scm_dowinds (SCM_EOL, scm_ilength (scm_root->dynwinds)); - - /* Allocate thread locals. */ - root = scm_make_root (scm_root->handle); - /* Make thread. */ - thread = scm_cell (scm_tc16_thread, 0); - SCM_DEFER_INTS; - argl = scm_cons (thread, argl); - /* Note that we couldn't pass a pointer to argl as data since the - argl variable may not exist in memory when the thread starts. */ - t = coop_create (scheme_launch_thread, (void *) argl); - t->data = SCM_ROOT_STATE (root); - t->handle = thread; - SCM_SET_CELL_WORD_1 (thread, (scm_t_bits) t); - scm_thread_count++; - all_threads = scm_cons (thread, all_threads); - /* Note that the following statement also could cause coop_yield.*/ - SCM_ALLOW_INTS; - - /* We're now ready for the thread to begin. */ - coop_yield(); - - /* Return to old dynamic context. */ - scm_dowinds (old_winds, - scm_ilength (old_winds)); - } - - return thread; -} -#undef FUNC_NAME - - -/* This is the second thread spawning mechanism: threads from C */ - -typedef struct c_launch_data { - union { - SCM thread; - SCM rootcont; - } u; - scm_t_catch_body body; - void *body_data; - scm_t_catch_handler handler; - void *handler_data; -} c_launch_data; - -static SCM -c_body_bootstrip (c_launch_data* data) -{ - /* First save the new root continuation */ - data->u.rootcont = scm_root->rootcont; - return (data->body) (data->body_data); -} - -static SCM -c_handler_bootstrip (c_launch_data* data, SCM tag, SCM throw_args) -{ - scm_root->rootcont = data->u.rootcont; - return (data->handler) (data->handler_data, tag, throw_args); -} - -static void -c_launch_thread (void *p) -{ - register c_launch_data *data = (c_launch_data *) p; - /* The thread object will be GC protected by being on this stack */ - SCM thread = data->u.thread; - /* We must use the address of `thread', otherwise the compiler will - optimize it away. This is OK since the longest SCM_STACKITEM - also is a long. */ - scm_internal_cwdr ((scm_t_catch_body) c_body_bootstrip, - data, - (scm_t_catch_handler) c_handler_bootstrip, - data, - (SCM_STACKITEM *) &thread); - scm_thread_count--; - free ((char *) data); -} - -SCM -scm_spawn_thread (scm_t_catch_body body, void *body_data, - scm_t_catch_handler handler, void *handler_data) -{ - SCM thread; - coop_t *t; - SCM root, old_winds; - c_launch_data *data = (c_launch_data *) scm_malloc (sizeof (*data)); - - /* Unwind wind chain. */ - old_winds = scm_dynwinds; - scm_dowinds (SCM_EOL, scm_ilength (scm_root->dynwinds)); - - /* Allocate thread locals. */ - root = scm_make_root (scm_root->handle); - /* Make thread. */ - thread = scm_cell (scm_tc16_thread, 0); - SCM_DEFER_INTS; - - data->u.thread = thread; - data->body = body; - data->body_data = body_data; - data->handler = handler; - data->handler_data = handler_data; - - t = coop_create (c_launch_thread, (void *) data); - t->data = SCM_ROOT_STATE (root); - t->handle = thread; - SCM_SET_CELL_WORD_1 (thread, (scm_t_bits) t); - scm_thread_count++; - all_threads = scm_cons (thread, all_threads); - /* Note that the following statement also could cause coop_yield.*/ - SCM_ALLOW_INTS; - - /* We're now ready for the thread to begin. */ - coop_yield(); - - /* Return to old dynamic context. */ - scm_dowinds (old_winds, - scm_ilength (old_winds)); - - return thread; -} - -SCM -scm_current_thread (void) -{ - return coop_global_curr->handle; -} - -SCM -scm_all_threads (void) -{ - return all_threads; -} - -scm_root_state * -scm_i_thread_root (SCM thread) -{ - return (scm_root_state *)((coop_t *)SCM_THREAD_DATA (thread))->data; -} - -SCM -scm_join_thread (SCM thread) -#define FUNC_NAME s_join_thread -{ - coop_t *thread_data; - SCM_VALIDATE_THREAD (1, thread); - /* Dirk:FIXME:: SCM_THREAD_DATA is a handle for a thread. It may be that a - * certain thread implementation uses a value of 0 as a valid thread handle. - * With the following code, this thread would always be considered finished. - */ - /* Dirk:FIXME:: With preemptive threading, a thread may finish immediately - * after SCM_THREAD_DATA is read. Thus, it must be guaranteed that the - * handle remains valid until the thread-object is garbage collected, or - * a mutex has to be used for reading and modifying SCM_THREAD_DATA. - */ - thread_data = SCM_THREAD_DATA (thread); - if (thread_data) - /* The thread is still alive */ - coop_join (thread_data); - /* XXX - return real result. */ - return SCM_BOOL_T; -} -#undef FUNC_NAME - -int -scm_c_thread_exited_p (SCM thread) -#define FUNC_NAME s_scm_thread_exited_p -{ - SCM_VALIDATE_THREAD (1, thread); - return SCM_THREAD_DATA (thread) != NULL; -} -#undef FUNC_NAME - -SCM -scm_yield (void) -{ - /* Yield early */ - scm_switch_counter = SCM_THREAD_SWITCH_COUNT; - coop_yield(); - - return SCM_BOOL_T; -} - -SCM -scm_single_thread_p (void) -{ - return (coop_global_runq.tail == &coop_global_runq.t - ? SCM_BOOL_T - : SCM_BOOL_F); -} - -SCM -scm_make_mutex (void) -{ - SCM m = scm_make_smob (scm_tc16_mutex); - coop_mutex_init (SCM_MUTEX_DATA (m)); - return m; -} - -SCM -scm_lock_mutex (SCM m) -{ - SCM_ASSERT (SCM_MUTEXP (m), m, SCM_ARG1, s_lock_mutex); - coop_mutex_lock (SCM_MUTEX_DATA (m)); - return SCM_BOOL_T; -} - -SCM -scm_try_mutex (SCM m) -{ - SCM_ASSERT (SCM_MUTEXP (m), m, SCM_ARG1, s_lock_mutex); - return scm_from_bool (coop_mutex_trylock (SCM_MUTEX_DATA (m))); -} - -SCM -scm_unlock_mutex (SCM m) -{ - SCM_ASSERT (SCM_MUTEXP (m), m, SCM_ARG1, s_unlock_mutex); - coop_mutex_unlock(SCM_MUTEX_DATA (m)); - - /* Yield early */ - scm_switch_counter = SCM_THREAD_SWITCH_COUNT; - coop_yield(); - - return SCM_BOOL_T; -} - -SCM -scm_make_condition_variable (void) -{ - SCM c = scm_make_smob (scm_tc16_condvar); - coop_condition_variable_init (SCM_CONDVAR_DATA (c)); - return c; -} - -SCM -scm_timed_wait_condition_variable (SCM c, SCM m, SCM t) -#define FUNC_NAME s_wait_condition_variable -{ - coop_c *cv; - coop_m *mx; - scm_t_timespec waittime; - - SCM_ASSERT (SCM_CONDVARP (c), - c, - SCM_ARG1, - s_wait_condition_variable); - SCM_ASSERT (SCM_MUTEXP (m), - m, - SCM_ARG2, - s_wait_condition_variable); - - cv = SCM_CONDVAR_DATA (c); - mx = SCM_MUTEX_DATA (m); - - if (!SCM_UNBNDP (t)) - { - if (SCM_CONSP (t)) - { - SCM_VALIDATE_UINT_COPY (3, SCM_CAR(t), waittime.tv_sec); - SCM_VALIDATE_UINT_COPY (3, SCM_CDR(t), waittime.tv_nsec); - waittime.tv_nsec *= 1000; - } - else - { - SCM_VALIDATE_UINT_COPY (3, t, waittime.tv_sec); - waittime.tv_nsec = 0; - } - return scm_from_bool( - coop_condition_variable_timed_wait_mutex (cv, mx, &waittime)); - } - else - { - coop_condition_variable_wait_mutex (cv, mx); - return SCM_BOOL_T; - } -} -#undef FUNC_NAME - -SCM -scm_signal_condition_variable (SCM c) -{ - SCM_ASSERT (SCM_CONDVARP (c), - c, - SCM_ARG1, - s_signal_condition_variable); - coop_condition_variable_signal (SCM_CONDVAR_DATA (c)); - return SCM_BOOL_T; -} - -SCM -scm_broadcast_condition_variable (SCM c) -{ - SCM_ASSERT (SCM_CONDVARP (c), - c, - SCM_ARG1, - s_broadcast_condition_variable); - coop_condition_variable_broadcast (SCM_CONDVAR_DATA (c)); - return SCM_BOOL_T; -} - -/* - Local Variables: - c-file-style: "gnu" - End: -*/ diff --git a/libguile/debug.c b/libguile/debug.c index 0f4734e82..ca9d08520 100644 --- a/libguile/debug.c +++ b/libguile/debug.c @@ -422,18 +422,18 @@ SCM_REGISTER_PROC (s_reverse_lookup, "reverse-lookup", 2, 0, 0, scm_reverse_look SCM scm_reverse_lookup (SCM env, SCM data) { - while (SCM_CONSP (env) && SCM_CONSP (SCM_CAR (env))) + while (scm_is_pair (env) && scm_is_pair (SCM_CAR (env))) { SCM names = SCM_CAAR (env); SCM values = SCM_CDAR (env); - while (SCM_CONSP (names)) + while (scm_is_pair (names)) { if (scm_is_eq (SCM_CAR (values), data)) return SCM_CAR (names); names = SCM_CDR (names); values = SCM_CDR (values); } - if (!SCM_NULLP (names) && scm_is_eq (values, data)) + if (!scm_is_null (names) && scm_is_eq (values, data)) return names; env = SCM_CDR (env); } @@ -463,9 +463,9 @@ scm_m_start_stack (SCM exp, SCM env) #define FUNC_NAME s_start_stack { exp = SCM_CDR (exp); - if (!SCM_CONSP (exp) - || !SCM_CONSP (SCM_CDR (exp)) - || !SCM_NULLP (SCM_CDDR (exp))) + if (!scm_is_pair (exp) + || !scm_is_pair (SCM_CDR (exp)) + || !scm_is_null (SCM_CDDR (exp))) SCM_WRONG_NUM_ARGS (); return scm_start_stack (scm_eval_car (exp, env), SCM_CADR (exp), env); } diff --git a/libguile/deprecated.c b/libguile/deprecated.c index 7b629b9be..2a0320fd8 100644 --- a/libguile/deprecated.c +++ b/libguile/deprecated.c @@ -317,7 +317,7 @@ maybe_close_port (void *data, SCM port) { SCM except = (SCM)data; - while (!SCM_NULLP (except)) + while (!scm_is_null (except)) { SCM p = SCM_COERCE_OUTPORT (SCM_CAR (except)); if (scm_is_eq (p, port)) @@ -341,7 +341,7 @@ SCM_DEFINE (scm_close_all_ports_except, "close-all-ports-except", 0, 0, 1, SCM p; SCM_VALIDATE_REST_ARGUMENT (ports); - for (p = ports; !SCM_NULLP (p); p = SCM_CDR (p)) + for (p = ports; !scm_is_null (p); p = SCM_CDR (p)) SCM_VALIDATE_OPPORT (SCM_ARG1, SCM_COERCE_OUTPORT (SCM_CAR (p))); scm_c_port_for_each (maybe_close_port, ports); @@ -445,7 +445,7 @@ SCM_DEFINE (scm_sloppy_memq, "sloppy-memq", 2, 0, 0, scm_c_issue_deprecation_warning ("'sloppy-memq' is deprecated. Use 'memq' instead."); - for(; SCM_CONSP (lst); lst = SCM_CDR(lst)) + for(; scm_is_pair (lst); lst = SCM_CDR(lst)) { if (scm_is_eq (SCM_CAR (lst), x)) return lst; @@ -465,7 +465,7 @@ SCM_DEFINE (scm_sloppy_memv, "sloppy-memv", 2, 0, 0, scm_c_issue_deprecation_warning ("'sloppy-memv' is deprecated. Use 'memv' instead."); - for(; SCM_CONSP (lst); lst = SCM_CDR(lst)) + for(; scm_is_pair (lst); lst = SCM_CDR(lst)) { if (! scm_is_false (scm_eqv_p (SCM_CAR (lst), x))) return lst; @@ -485,7 +485,7 @@ SCM_DEFINE (scm_sloppy_member, "sloppy-member", 2, 0, 0, scm_c_issue_deprecation_warning ("'sloppy-member' is deprecated. Use 'member' instead."); - for(; SCM_CONSP (lst); lst = SCM_CDR(lst)) + for(; scm_is_pair (lst); lst = SCM_CDR(lst)) { if (! scm_is_false (scm_equal_p (SCM_CAR (lst), x))) return lst; diff --git a/libguile/deprecation.c b/libguile/deprecation.c index d33e6b5ae..daa02c06d 100644 --- a/libguile/deprecation.c +++ b/libguile/deprecation.c @@ -106,7 +106,7 @@ SCM_DEFINE(scm_issue_deprecation_warning, SCM nl = scm_from_locale_string ("\n"); SCM msgs_nl = SCM_EOL; char *c_msgs; - while (SCM_CONSP (msgs)) + while (scm_is_pair (msgs)) { if (msgs_nl != SCM_EOL) msgs_nl = scm_cons (nl, msgs_nl); diff --git a/libguile/dynwind.c b/libguile/dynwind.c index 299842912..01a02254f 100644 --- a/libguile/dynwind.c +++ b/libguile/dynwind.c @@ -164,7 +164,7 @@ scm_frame_end (void) encounter #<winder> entries on the way. */ - while (SCM_CONSP (scm_dynwinds)) + while (scm_is_pair (scm_dynwinds)) { SCM entry = SCM_CAR (scm_dynwinds); scm_dynwinds = SCM_CDR (scm_dynwinds); @@ -308,7 +308,7 @@ scm_i_dowinds (SCM to, long delta, void (*turn_func) (void *), void *data) /* key = #t | symbol | thunk | list of variables */ if (SCM_NIMP (wind_key)) { - if (SCM_CONSP (wind_key)) + if (scm_is_pair (wind_key)) { if (SCM_VARIABLEP (SCM_CAR (wind_key))) scm_swap_bindings (wind_key, SCM_CDR (wind_elt)); @@ -342,7 +342,7 @@ scm_i_dowinds (SCM to, long delta, void (*turn_func) (void *), void *data) wind_key = SCM_CAR (wind_elt); if (SCM_NIMP (wind_key)) { - if (SCM_CONSP (wind_key)) + if (scm_is_pair (wind_key)) { if (SCM_VARIABLEP (SCM_CAR (wind_key))) scm_swap_bindings (wind_key, SCM_CDR (wind_elt)); diff --git a/libguile/environments.c b/libguile/environments.c index bd90a43fe..dc2d5fee2 100644 --- a/libguile/environments.c +++ b/libguile/environments.c @@ -531,7 +531,7 @@ obarray_replace (SCM obarray, SCM symbol, SCM data) SCM slot; for (lsym = SCM_HASHTABLE_BUCKETS (obarray)[hash]; - !SCM_NULLP (lsym); + !scm_is_null (lsym); lsym = SCM_CDR (lsym)) { SCM old_entry = SCM_CAR (lsym); @@ -561,7 +561,7 @@ obarray_retrieve (SCM obarray, SCM sym) SCM lsym; for (lsym = SCM_HASHTABLE_BUCKETS (obarray)[hash]; - !SCM_NULLP (lsym); + !scm_is_null (lsym); lsym = SCM_CDR (lsym)) { SCM entry = SCM_CAR (lsym); @@ -584,7 +584,7 @@ obarray_remove (SCM obarray, SCM sym) SCM table_entry = SCM_HASHTABLE_BUCKETS (obarray)[hash]; SCM handle = scm_sloppy_assq (sym, table_entry); - if (SCM_CONSP (handle)) + if (scm_is_pair (handle)) { SCM new_table_entry = scm_delq1_x (handle, table_entry); SCM_SET_HASHTABLE_BUCKET (obarray, hash, new_table_entry); @@ -675,7 +675,7 @@ core_environments_unobserve (SCM env, SCM observer) ? CORE_ENVIRONMENT_WEAK_OBSERVERS (env) : CORE_ENVIRONMENT_OBSERVERS (env); - if (!SCM_NULLP (l)) + if (!scm_is_null (l)) { SCM rest = SCM_CDR (l); SCM first = handling_weaks @@ -694,7 +694,7 @@ core_environments_unobserve (SCM env, SCM observer) do { SCM rest = SCM_CDR (l); - if (!SCM_NULLP (rest)) + if (!scm_is_null (rest)) { SCM next = handling_weaks ? SCM_CDAR (l) @@ -708,7 +708,7 @@ core_environments_unobserve (SCM env, SCM observer) } l = rest; - } while (!SCM_NULLP (l)); + } while (!scm_is_null (l)); } } @@ -807,7 +807,7 @@ core_environments_broadcast (SCM env) ? CORE_ENVIRONMENT_WEAK_OBSERVERS (env) : CORE_ENVIRONMENT_OBSERVERS (env); - for (; !SCM_NULLP (observers); observers = SCM_CDR (observers)) + for (; !scm_is_null (observers); observers = SCM_CDR (observers)) { struct update_data data; SCM observer = handling_weaks @@ -827,7 +827,7 @@ core_environments_broadcast (SCM env) } } - if (!SCM_NULLP (errors)) + if (!scm_is_null (errors)) { /* Dirk:FIXME:: As soon as scm_misc_error is fixed to handle the name * parameter correctly it should not be necessary any more to also pass @@ -888,7 +888,7 @@ leaf_environment_fold (SCM env, scm_environment_folder proc, SCM data, SCM init) { SCM l; for (l = SCM_HASHTABLE_BUCKETS (obarray)[i]; - !SCM_NULLP (l); + !scm_is_null (l); l = SCM_CDR (l)) { SCM binding = SCM_CAR (l); @@ -1114,7 +1114,7 @@ eval_environment_lookup (SCM env, SCM sym, int for_write) SCM entry = SCM_CDR (binding); - if (SCM_CONSP (entry)) + if (scm_is_pair (entry)) { /* The entry in the obarray is a cached location. */ @@ -1133,7 +1133,7 @@ eval_environment_lookup (SCM env, SCM sym, int for_write) SCM source_env = CACHED_SOURCE_ENVIRONMENT (entry); SCM location = SCM_ENVIRONMENT_CELL (source_env, sym, 1); - if (SCM_CONSP (location)) + if (scm_is_pair (location)) { SET_CACHED_MUTABILITY (entry, MUTABLE); return location; @@ -1173,7 +1173,7 @@ eval_environment_lookup (SCM env, SCM sym, int for_write) if (!SCM_UNBNDP (location)) { - if (SCM_CONSP (location)) + if (scm_is_pair (location)) { SCM mutability = for_write ? MUTABLE : UNKNOWN; SCM entry = scm_cons2 (location, mutability, source_env); @@ -1203,7 +1203,7 @@ eval_environment_ref (SCM env, SCM sym) { SCM location = eval_environment_lookup (env, sym, 0); - if (SCM_CONSP (location)) + if (scm_is_pair (location)) return SCM_CDR (location); else if (!SCM_UNBNDP (location)) return SCM_ENVIRONMENT_REF (location, sym); @@ -1273,7 +1273,7 @@ eval_environment_set_x (SCM env, SCM sym, SCM val) { SCM location = eval_environment_lookup (env, sym, 1); - if (SCM_CONSP (location)) + if (scm_is_pair (location)) { SCM_SETCDR (location, val); return SCM_ENVIRONMENT_SUCCESS; @@ -1300,7 +1300,7 @@ eval_environment_cell (SCM env, SCM sym, int for_write) { SCM location = eval_environment_lookup (env, sym, for_write); - if (SCM_CONSP (location)) + if (scm_is_pair (location)) return location; else if (SCM_ENVIRONMENT_P (location)) return SCM_ENVIRONMENT_LOCATION_NO_CELL; @@ -1559,7 +1559,7 @@ import_environment_lookup (SCM env, SCM sym) SCM result = SCM_UNDEFINED; SCM l; - for (l = imports; !SCM_NULLP (l); l = SCM_CDR (l)) + for (l = imports; !scm_is_null (l); l = SCM_CDR (l)) { SCM imported = SCM_CAR (l); @@ -1567,14 +1567,14 @@ import_environment_lookup (SCM env, SCM sym) { if (SCM_UNBNDP (result)) result = imported; - else if (SCM_CONSP (result)) + else if (scm_is_pair (result)) result = scm_cons (imported, result); else result = scm_cons2 (imported, result, SCM_EOL); } } - if (SCM_CONSP (result)) + if (scm_is_pair (result)) return scm_reverse (result); else return result; @@ -1601,7 +1601,7 @@ import_environment_ref (SCM env, SCM sym) { return SCM_UNDEFINED; } - else if (SCM_CONSP (owner)) + else if (scm_is_pair (owner)) { SCM resolve = import_environment_conflict (env, sym, owner); @@ -1630,7 +1630,7 @@ import_environment_folder (SCM extended_data, SCM symbol, SCM value, SCM tail) scm_environment_folder proc = (scm_environment_folder) proc_as_ul; SCM data = SCM_CDDDR (extended_data); - if (SCM_CONSP (owner) && scm_is_eq (SCM_CAR (owner), imported_env)) + if (scm_is_pair (owner) && scm_is_eq (SCM_CAR (owner), imported_env)) owner = import_environment_conflict (import_env, symbol, owner); if (SCM_ENVIRONMENT_P (owner)) @@ -1648,7 +1648,7 @@ import_environment_fold (SCM env, scm_environment_folder proc, SCM data, SCM ini SCM result = init; SCM l; - for (l = IMPORT_ENVIRONMENT (env)->imports; !SCM_NULLP (l); l = SCM_CDR (l)) + for (l = IMPORT_ENVIRONMENT (env)->imports; !scm_is_null (l); l = SCM_CDR (l)) { SCM imported_env = SCM_CAR (l); SCM extended_data = scm_cons (env, scm_cons2 (imported_env, proc_as_nr, data)); @@ -1691,7 +1691,7 @@ import_environment_set_x (SCM env, SCM sym, SCM val) { return SCM_UNDEFINED; } - else if (SCM_CONSP (owner)) + else if (scm_is_pair (owner)) { SCM resolve = import_environment_conflict (env, sym, owner); @@ -1718,7 +1718,7 @@ import_environment_cell (SCM env, SCM sym, int for_write) { return SCM_UNDEFINED; } - else if (SCM_CONSP (owner)) + else if (scm_is_pair (owner)) { SCM resolve = import_environment_conflict (env, sym, owner); @@ -1881,20 +1881,20 @@ SCM_DEFINE (scm_import_environment_set_imports_x, "import-environment-set-import SCM l; SCM_ASSERT (SCM_IMPORT_ENVIRONMENT_P (env), env, SCM_ARG1, FUNC_NAME); - for (l = imports; SCM_CONSP (l); l = SCM_CDR (l)) + for (l = imports; scm_is_pair (l); l = SCM_CDR (l)) { SCM obj = SCM_CAR (l); SCM_ASSERT (SCM_ENVIRONMENT_P (obj), imports, SCM_ARG2, FUNC_NAME); } - SCM_ASSERT (SCM_NULLP (l), imports, SCM_ARG2, FUNC_NAME); + SCM_ASSERT (scm_is_null (l), imports, SCM_ARG2, FUNC_NAME); - for (l = body->import_observers; !SCM_NULLP (l); l = SCM_CDR (l)) + for (l = body->import_observers; !scm_is_null (l); l = SCM_CDR (l)) { SCM obs = SCM_CAR (l); SCM_ENVIRONMENT_UNOBSERVE (env, obs); } - for (l = imports; !SCM_NULLP (l); l = SCM_CDR (l)) + for (l = imports; !scm_is_null (l); l = SCM_CDR (l)) { SCM imp = SCM_CAR (l); SCM obs = SCM_ENVIRONMENT_OBSERVE (imp, import_environment_observer, env, 1); @@ -1962,7 +1962,7 @@ export_environment_fold (SCM env, scm_environment_folder proc, SCM data, SCM ini SCM result = init; SCM l; - for (l = body->signature; !SCM_NULLP (l); l = SCM_CDR (l)) + for (l = body->signature; !scm_is_null (l); l = SCM_CDR (l)) { SCM symbol = SCM_CAR (l); SCM value = SCM_ENVIRONMENT_REF (body->private, symbol); @@ -2235,7 +2235,7 @@ export_environment_parse_signature (SCM signature, const char* caller) SCM result = SCM_EOL; SCM l; - for (l = signature; SCM_CONSP (l); l = SCM_CDR (l)) + for (l = signature; scm_is_pair (l); l = SCM_CDR (l)) { SCM entry = SCM_CAR (l); @@ -2253,12 +2253,12 @@ export_environment_parse_signature (SCM signature, const char* caller) SCM mutability; SCM l2; - SCM_ASSERT (SCM_CONSP (entry), entry, SCM_ARGn, caller); + SCM_ASSERT (scm_is_pair (entry), entry, SCM_ARGn, caller); SCM_ASSERT (scm_is_symbol (SCM_CAR (entry)), entry, SCM_ARGn, caller); sym = SCM_CAR (entry); - for (l2 = SCM_CDR (entry); SCM_CONSP (l2); l2 = SCM_CDR (l2)) + for (l2 = SCM_CDR (entry); scm_is_pair (l2); l2 = SCM_CDR (l2)) { SCM attribute = SCM_CAR (l2); if (scm_is_eq (attribute, symbol_immutable_location)) @@ -2268,7 +2268,7 @@ export_environment_parse_signature (SCM signature, const char* caller) else SCM_ASSERT (0, entry, SCM_ARGn, caller); } - SCM_ASSERT (SCM_NULLP (l2), entry, SCM_ARGn, caller); + SCM_ASSERT (scm_is_null (l2), entry, SCM_ARGn, caller); SCM_ASSERT (!mutable || !immutable, entry, SCM_ARGn, caller); if (!mutable && !immutable) @@ -2279,7 +2279,7 @@ export_environment_parse_signature (SCM signature, const char* caller) result = scm_cons (new_entry, result); } } - SCM_ASSERT (SCM_NULLP (l), signature, SCM_ARGn, caller); + SCM_ASSERT (scm_is_null (l), signature, SCM_ARGn, caller); /* Dirk:FIXME:: Now we know that signature is syntactically correct. There * are, however, no checks for symbols entered twice with contradicting diff --git a/libguile/eq.c b/libguile/eq.c index befc10680..cd5f0d180 100644 --- a/libguile/eq.c +++ b/libguile/eq.c @@ -147,7 +147,7 @@ SCM_PRIMITIVE_GENERIC_1 (scm_equal_p, "equal?", scm_tc7_rpsubr, return SCM_BOOL_F; if (SCM_IMP (y)) return SCM_BOOL_F; - if (SCM_CONSP (x) && SCM_CONSP (y)) + if (scm_is_pair (x) && scm_is_pair (y)) { if (scm_is_false (scm_equal_p (SCM_CAR (x), SCM_CAR (y)))) return SCM_BOOL_F; diff --git a/libguile/evalext.c b/libguile/evalext.c index a18d965b6..6a2a1b14b 100644 --- a/libguile/evalext.c +++ b/libguile/evalext.c @@ -47,14 +47,14 @@ SCM_DEFINE (scm_defined_p, "defined?", 1, 1, 0, register SCM b; for (; SCM_NIMP (frames); frames = SCM_CDR (frames)) { - SCM_ASSERT (SCM_CONSP (frames), env, SCM_ARG2, FUNC_NAME); + SCM_ASSERT (scm_is_pair (frames), env, SCM_ARG2, FUNC_NAME); b = SCM_CAR (frames); if (scm_is_true (scm_procedure_p (b))) break; - SCM_ASSERT (SCM_CONSP (b), env, SCM_ARG2, FUNC_NAME); + SCM_ASSERT (scm_is_pair (b), env, SCM_ARG2, FUNC_NAME); for (b = SCM_CAR (b); SCM_NIMP (b); b = SCM_CDR (b)) { - if (!SCM_CONSP (b)) + if (!scm_is_pair (b)) { if (scm_is_eq (b, sym)) return SCM_BOOL_T; @@ -93,7 +93,7 @@ SCM_DEFINE (scm_self_evaluating_p, "self-evaluating?", 1, 0, 0, return SCM_BOOL_T; case scm_tc3_imm24: /* characters, booleans, other immediates */ - return scm_from_bool (!SCM_NULLP (obj)); + return scm_from_bool (!scm_is_null (obj)); case scm_tc3_cons: switch (SCM_TYP7 (obj)) { diff --git a/libguile/filesys.c b/libguile/filesys.c index 5b23988e3..f2f35aa1d 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -1225,7 +1225,7 @@ SCM_DEFINE (scm_select, "select", 3, 2, 0, /* if there's a port with a ready buffer, don't block, just check for ready file descriptors. */ - if (!SCM_NULLP (read_ports_ready) || !SCM_NULLP (write_ports_ready)) + if (!scm_is_null (read_ports_ready) || !scm_is_null (write_ports_ready)) { timeout.tv_sec = 0; timeout.tv_usec = 0; diff --git a/libguile/futures.c b/libguile/futures.c index 07cf6e6a3..0f6000a7a 100644 --- a/libguile/futures.c +++ b/libguile/futures.c @@ -55,7 +55,7 @@ static SCM count (SCM ls) { int n = 0; - while (!SCM_NULLP (ls)) + while (!scm_is_null (ls)) { ++n; ls = SCM_FUTURE_NEXT (ls); @@ -169,9 +169,9 @@ scm_i_make_future (SCM thunk) scm_mutex_lock (&future_admin_mutex); while (1) { - if (!SCM_NULLP (old)) + if (!scm_is_null (old)) UNLINK (old, future); - else if (!SCM_NULLP (young)) + else if (!scm_is_null (young)) UNLINK (young, future); else { @@ -244,7 +244,7 @@ SCM_DEFINE (scm_future_ref, "future-ref", 1, 0, 0, static void kill_futures (SCM victims) { - while (!SCM_NULLP (victims)) + while (!scm_is_null (victims)) { SCM future; UNLINK (victims, future); @@ -257,7 +257,7 @@ static void cleanup_undead () { SCM next = undead, *nextloc = &undead; - while (!SCM_NULLP (next)) + while (!scm_is_null (next)) { if (scm_mutex_trylock (SCM_FUTURE_MUTEX (next))) goto next; @@ -284,7 +284,7 @@ cleanup_undead () static void mark_futures (SCM futures) { - while (!SCM_NULLP (futures)) + while (!scm_is_null (futures)) { SCM_SET_GC_MARK (futures); futures = SCM_FUTURE_NEXT (futures); @@ -310,7 +310,7 @@ scan_futures (void *dummy1, void *dummy2, void *dummy3) next = futures; nextloc = &futures; - while (!SCM_NULLP (next)) + while (!scm_is_null (next)) { if (!SCM_GC_MARK_P (next)) goto free; @@ -319,7 +319,7 @@ scan_futures (void *dummy1, void *dummy2, void *dummy3) next = *nextloc; } goto exit; - while (!SCM_NULLP (next)) + while (!scm_is_null (next)) { if (SCM_GC_MARK_P (next)) { diff --git a/libguile/gc-mark.c b/libguile/gc-mark.c index 1aa036b7a..e4f838bf4 100644 --- a/libguile/gc-mark.c +++ b/libguile/gc-mark.c @@ -87,7 +87,7 @@ scm_mark_all (void) for (i = 0; i < SCM_HASHTABLE_N_BUCKETS (scm_gc_registered_roots); ++i) { SCM l = SCM_HASHTABLE_BUCKETS (scm_gc_registered_roots)[i]; - for (; !SCM_NULLP (l); l = SCM_CDR (l)) + for (; !scm_is_null (l); l = SCM_CDR (l)) { SCM *p = (SCM *) (scm_to_ulong (SCM_CAAR (l))); scm_gc_mark (*p); @@ -300,9 +300,9 @@ scm_gc_mark_dependencies (SCM p) /* mark everything on the alist except the keys or * values, according to weak_values and weak_keys. */ - while ( SCM_CONSP (alist) + while ( scm_is_pair (alist) && !SCM_GC_MARK_P (alist) - && SCM_CONSP (SCM_CAR (alist))) + && scm_is_pair (SCM_CAR (alist))) { SCM kvpair; SCM next_alist; diff --git a/libguile/gc.c b/libguile/gc.c index 5b3dfa471..80b96d667 100644 --- a/libguile/gc.c +++ b/libguile/gc.c @@ -512,9 +512,9 @@ scm_igc (const char *what) fprintf (stderr,"gc reason %s\n", what); fprintf (stderr, - SCM_NULLP (*SCM_FREELIST_LOC (scm_i_freelist)) + scm_is_null (*SCM_FREELIST_LOC (scm_i_freelist)) ? "*" - : (SCM_NULLP (*SCM_FREELIST_LOC (scm_i_freelist2)) ? "o" : "m")); + : (scm_is_null (*SCM_FREELIST_LOC (scm_i_freelist2)) ? "o" : "m")); #endif /* During the critical section, only the current thread may run. */ diff --git a/libguile/goops.c b/libguile/goops.c index 6a595f9d0..3f99321cc 100644 --- a/libguile/goops.c +++ b/libguile/goops.c @@ -159,14 +159,14 @@ static SCM scm_sys_goops_loaded (void); static SCM map (SCM (*proc) (SCM), SCM ls) { - if (SCM_NULLP (ls)) + if (scm_is_null (ls)) return ls; else { SCM res = scm_cons (proc (SCM_CAR (ls)), SCM_EOL); SCM h = res; ls = SCM_CDR (ls); - while (!SCM_NULLP (ls)) + while (!scm_is_null (ls)) { SCM_SETCDR (h, scm_cons (proc (SCM_CAR (ls)), SCM_EOL)); h = SCM_CDR (h); @@ -180,7 +180,7 @@ static SCM filter_cpl (SCM ls) { SCM res = SCM_EOL; - while (!SCM_NULLP (ls)) + while (!scm_is_null (ls)) { SCM el = SCM_CAR (ls); if (scm_is_false (scm_c_memq (el, res))) @@ -215,7 +215,7 @@ remove_duplicate_slots (SCM l, SCM res, SCM slots_already_seen) { SCM tmp; - if (SCM_NULLP (l)) + if (scm_is_null (l)) return res; tmp = SCM_CAAR (l); @@ -235,7 +235,7 @@ build_slots_list (SCM dslots, SCM cpl) { register SCM res = dslots; - for (cpl = SCM_CDR (cpl); !SCM_NULLP (cpl); cpl = SCM_CDR (cpl)) + for (cpl = SCM_CDR (cpl); !scm_is_null (cpl); cpl = SCM_CDR (cpl)) res = scm_append (scm_list_2 (SCM_SLOT (SCM_CAR (cpl), scm_si_direct_slots), res)); @@ -248,9 +248,9 @@ static SCM maplist (SCM ls) { SCM orig = ls; - while (!SCM_NULLP (ls)) + while (!scm_is_null (ls)) { - if (!SCM_CONSP (SCM_CAR (ls))) + if (!scm_is_pair (SCM_CAR (ls))) SCM_SETCAR (ls, scm_cons (SCM_CAR (ls), SCM_EOL)); ls = SCM_CDR (ls); } @@ -291,11 +291,11 @@ compute_getters_n_setters (SCM slots) SCM *cdrloc = &res; long i = 0; - for ( ; !SCM_NULLP (slots); slots = SCM_CDR (slots)) + for ( ; !scm_is_null (slots); slots = SCM_CDR (slots)) { SCM init = SCM_BOOL_F; SCM options = SCM_CDAR (slots); - if (!SCM_NULLP (options)) + if (!scm_is_null (options)) { init = scm_get_keyword (k_init_value, options, 0); if (init) @@ -392,13 +392,13 @@ SCM_DEFINE (scm_sys_initialize_object, "%initialize-object", 2, 0, 0, /* See for each slot how it must be initialized */ for (; - !SCM_NULLP (slots); + !scm_is_null (slots); get_n_set = SCM_CDR (get_n_set), slots = SCM_CDR (slots)) { SCM slot_name = SCM_CAR (slots); SCM slot_value = 0; - if (!SCM_NULLP (SCM_CDR (slot_name))) + if (!scm_is_null (SCM_CDR (slot_name))) { /* This slot admits (perhaps) to be initialized at creation time */ long n = scm_ilength (SCM_CDR (slot_name)); @@ -456,9 +456,9 @@ SCM_DEFINE (scm_sys_initialize_object, "%initialize-object", 2, 0, 0, */ #define SCM_GNS_INSTANCE_ALLOCATED_P(gns) \ (SCM_I_INUMP (SCM_CDDR (gns)) \ - || (SCM_CONSP (SCM_CDDR (gns)) \ - && SCM_CONSP (SCM_CDDDR (gns)) \ - && SCM_CONSP (SCM_CDDDDR (gns)))) + || (scm_is_pair (SCM_CDDR (gns)) \ + && scm_is_pair (SCM_CDDDR (gns)) \ + && scm_is_pair (SCM_CDDDDR (gns)))) #define SCM_GNS_INDEX(gns) \ (SCM_I_INUMP (SCM_CDDR (gns)) \ ? SCM_I_INUM (SCM_CDDR (gns)) \ @@ -497,7 +497,7 @@ SCM_DEFINE (scm_sys_prep_layout_x, "%prep-layout!", 1, 0, 0, layout = scm_i_make_string (n, &s); i = 0; - while (SCM_CONSP (getters_n_setters)) + while (scm_is_pair (getters_n_setters)) { if (SCM_GNS_INSTANCE_ALLOCATED_P (SCM_CAR (getters_n_setters))) { @@ -505,7 +505,7 @@ SCM_DEFINE (scm_sys_prep_layout_x, "%prep-layout!", 1, 0, 0, int len, index, size; char p, a; - if (i >= n || !SCM_CONSP (slots)) + if (i >= n || !scm_is_pair (slots)) goto inconsistent; /* extract slot type */ @@ -559,7 +559,7 @@ SCM_DEFINE (scm_sys_prep_layout_x, "%prep-layout!", 1, 0, 0, slots = SCM_CDR (slots); getters_n_setters = SCM_CDR (getters_n_setters); } - if (!SCM_NULLP (slots)) + if (!scm_is_null (slots)) { inconsistent: SCM_MISC_ERROR ("inconsistent getters-n-setters", SCM_EOL); @@ -579,9 +579,9 @@ SCM_DEFINE (scm_sys_inherit_magic_x, "%inherit-magic!", 2, 0, 0, SCM ls = dsupers; long flags = 0; SCM_VALIDATE_INSTANCE (1, class); - while (!SCM_NULLP (ls)) + while (!scm_is_null (ls)) { - SCM_ASSERT (SCM_CONSP (ls) + SCM_ASSERT (scm_is_pair (ls) && SCM_INSTANCEP (SCM_CAR (ls)), dsupers, SCM_ARG2, @@ -661,7 +661,7 @@ scm_basic_basic_make_class (SCM class, SCM name, SCM dsupers, SCM dslots) /* Add this class in the direct-subclasses slot of dsupers */ { SCM tmp; - for (tmp = dsupers; !SCM_NULLP (tmp); tmp = SCM_CDR (tmp)) + for (tmp = dsupers; !scm_is_null (tmp); tmp = SCM_CDR (tmp)) SCM_SET_SLOT (SCM_CAR (tmp), scm_si_direct_subclasses, scm_cons (z, SCM_SLOT (SCM_CAR (tmp), scm_si_direct_subclasses))); @@ -926,7 +926,7 @@ SCM fold_downward_gf_methods (SCM method_lists, SCM gf) { SCM gfs = scm_slot_ref (gf, sym_extended_by); method_lists = scm_cons (scm_slot_ref (gf, sym_methods), method_lists); - while (!SCM_NULLP (gfs)) + while (!scm_is_null (gfs)) { method_lists = fold_downward_gf_methods (method_lists, SCM_CAR (gfs)); gfs = SCM_CDR (gfs); @@ -940,7 +940,7 @@ SCM fold_upward_gf_methods (SCM method_lists, SCM gf) if (SCM_IS_A_P (gf, scm_class_extended_generic)) { SCM gfs = scm_slot_ref (gf, sym_extends); - while (!SCM_NULLP (gfs)) + while (!scm_is_null (gfs)) { SCM methods = scm_slot_ref (SCM_CAR (gfs), sym_methods); method_lists = fold_upward_gf_methods (scm_cons (methods, @@ -1110,7 +1110,7 @@ static SCM slot_definition_using_name (SCM class, SCM slot_name) { register SCM slots = SCM_SLOT (class, scm_si_getters_n_setters); - for (; !SCM_NULLP (slots); slots = SCM_CDR (slots)) + for (; !scm_is_null (slots); slots = SCM_CDR (slots)) if (SCM_CAAR (slots) == slot_name) return SCM_CAR (slots); return SCM_BOOL_F; @@ -1205,7 +1205,7 @@ test_slot_existence (SCM class SCM_UNUSED, SCM obj, SCM slot_name) { register SCM l; - for (l = SCM_ACCESSORS_OF (obj); !SCM_NULLP (l); l = SCM_CDR (l)) + for (l = SCM_ACCESSORS_OF (obj); !scm_is_null (l); l = SCM_CDR (l)) if (scm_is_eq (SCM_CAAR (l), slot_name)) return SCM_BOOL_T; @@ -1647,10 +1647,10 @@ SCM_DEFINE (scm_sys_invalidate_method_cache_x, "%invalidate-method-cache!", 1, 0 if (scm_is_true (used_by)) { SCM methods = SCM_SLOT (gf, scm_si_methods); - for (; SCM_CONSP (used_by); used_by = SCM_CDR (used_by)) + for (; scm_is_pair (used_by); used_by = SCM_CDR (used_by)) scm_sys_invalidate_method_cache_x (SCM_CAR (used_by)); clear_method_cache (gf); - for (; SCM_CONSP (methods); methods = SCM_CDR (methods)) + for (; scm_is_pair (methods); methods = SCM_CDR (methods)) SCM_SET_SLOT (SCM_CAR (methods), scm_si_code_table, SCM_EOL); } { @@ -1681,7 +1681,7 @@ SCM_DEFINE (scm_enable_primitive_generic_x, "enable-primitive-generic!", 0, 0, 1 #define FUNC_NAME s_scm_enable_primitive_generic_x { SCM_VALIDATE_REST_ARGUMENT (subrs); - while (!SCM_NULLP (subrs)) + while (!scm_is_null (subrs)) { SCM subr = SCM_CAR (subrs); SCM_ASSERT (scm_subr_p (subr) && SCM_SUBR_GENERIC (subr), @@ -1810,8 +1810,8 @@ more_specificp (SCM m1, SCM m2, SCM const *targs) * */ for (i=0, s1=SPEC_OF(m1), s2=SPEC_OF(m2); ; i++, s1=SCM_CDR(s1), s2=SCM_CDR(s2)) { - if (SCM_NULLP(s1)) return 1; - if (SCM_NULLP(s2)) return 0; + if (scm_is_null(s1)) return 1; + if (scm_is_null(s2)) return 0; if (SCM_CAR(s1) != SCM_CAR(s2)) { register SCM l, cs1 = SCM_CAR(s1), cs2 = SCM_CAR(s2); @@ -1940,29 +1940,29 @@ scm_compute_applicable_methods (SCM gf, SCM args, long len, int find_method_p) else types = p = buffer; - for ( ; !SCM_NULLP (args); args = SCM_CDR (args)) + for ( ; !scm_is_null (args); args = SCM_CDR (args)) *p++ = scm_class_of (SCM_CAR (args)); /* Build a list of all applicable methods */ - for (l = scm_generic_function_methods (gf); !SCM_NULLP (l); l = SCM_CDR (l)) + for (l = scm_generic_function_methods (gf); !scm_is_null (l); l = SCM_CDR (l)) { fl = SPEC_OF (SCM_CAR (l)); /* Only accept accessors which match exactly in first arg. */ if (SCM_ACCESSORP (SCM_CAR (l)) - && (SCM_NULLP (fl) || types[0] != SCM_CAR (fl))) + && (scm_is_null (fl) || types[0] != SCM_CAR (fl))) continue; for (i = 0; ; i++, fl = SCM_CDR (fl)) { if (SCM_INSTANCEP (fl) /* We have a dotted argument list */ - || (i >= len && SCM_NULLP (fl))) + || (i >= len && scm_is_null (fl))) { /* both list exhausted */ applicable = scm_cons (SCM_CAR (l), applicable); count += 1; break; } if (i >= len - || SCM_NULLP (fl) + || scm_is_null (fl) || !applicablep (types[i], SCM_CAR (fl))) break; } @@ -2166,7 +2166,7 @@ SCM_DEFINE (scm_find_method, "find-method", 0, 0, 1, gf = SCM_CAR(l); l = SCM_CDR(l); SCM_VALIDATE_GENERIC (1, gf); - if (SCM_NULLP (SCM_SLOT (gf, scm_si_methods))) + if (scm_is_null (SCM_SLOT (gf, scm_si_methods))) SCM_MISC_ERROR ("no methods for generic ~S", scm_list_1 (gf)); return scm_compute_applicable_methods (gf, l, len - 1, 1); @@ -2188,7 +2188,7 @@ SCM_DEFINE (scm_sys_method_more_specific_p, "%method-more-specific?", 3, 0, 0, /* Verify that all the arguments of targs are classes and place them in a vector*/ v = scm_c_make_vector (len, SCM_EOL); - for (i = 0, l = targs; !SCM_NULLP (l); i++, l = SCM_CDR (l)) { + for (i = 0, l = targs; !scm_is_null (l); i++, l = SCM_CDR (l)) { SCM_ASSERT (SCM_CLASSP (SCM_CAR (l)), targs, SCM_ARG3, FUNC_NAME); SCM_VECTOR_SET (v, i, SCM_CAR(l)); } @@ -2232,7 +2232,7 @@ make_stdcls (SCM *var, char *name, SCM meta, SCM super, SCM slots) *var = scm_permanent_object (scm_basic_make_class (meta, tmp, - SCM_CONSP (super) + scm_is_pair (super) ? super : scm_list_1 (super), slots)); @@ -2627,7 +2627,7 @@ scm_make_class (SCM meta, char *s_name, SCM supers, size_t size, { SCM name, class; name = scm_from_locale_symbol (s_name); - if (SCM_NULLP (supers)) + if (scm_is_null (supers)) supers = scm_list_1 (scm_class_foreign_object); class = scm_basic_basic_make_class (meta, name, supers, SCM_EOL); scm_sys_inherit_magic_x (class, supers); diff --git a/libguile/gsubr.c b/libguile/gsubr.c index 4f8faefa0..e93b4402d 100644 --- a/libguile/gsubr.c +++ b/libguile/gsubr.c @@ -197,7 +197,7 @@ scm_gsubr_apply (SCM args) #endif args = SCM_CDR (args); for (i = 0; i < SCM_GSUBR_REQ (typ); i++) { - if (SCM_NULLP (args)) + if (scm_is_null (args)) scm_wrong_num_args (SCM_SNAME (SCM_GSUBR_PROC (self))); v[i] = SCM_CAR(args); args = SCM_CDR(args); @@ -212,7 +212,7 @@ scm_gsubr_apply (SCM args) } if (SCM_GSUBR_REST(typ)) v[i] = args; - else if (!SCM_NULLP (args)) + else if (!scm_is_null (args)) scm_wrong_num_args (SCM_SNAME (SCM_GSUBR_PROC (self))); switch (n) { case 2: return (*fcn)(v[0], v[1]); diff --git a/libguile/guardians.c b/libguile/guardians.c index a28657aab..f36a98866 100644 --- a/libguile/guardians.c +++ b/libguile/guardians.c @@ -494,7 +494,7 @@ mark_and_zombify (t_guardian *g) /* Mark the cells of the live list (yes, the cells in the list, we don't care about objects pointed to by the list cars, since we know they are already marked). */ - for (pair = g->live.head; !SCM_NULLP (pair); pair = SCM_CDR (pair)) + for (pair = g->live.head; !scm_is_null (pair); pair = SCM_CDR (pair)) SCM_SET_GC_MARK (pair); } @@ -567,7 +567,7 @@ whine_about_self_centered_zombies (void *dummy1 SCM_UNUSED, void *dummy2 SCM_UNUSED, void *dummy3 SCM_UNUSED) { - if (!SCM_NULLP (self_centered_zombies)) + if (!scm_is_null (self_centered_zombies)) { SCM pair; @@ -575,7 +575,7 @@ whine_about_self_centered_zombies (void *dummy1 SCM_UNUSED, scm_cur_errp); scm_newline (scm_cur_errp); for (pair = self_centered_zombies; - !SCM_NULLP (pair); pair = SCM_CDR (pair)) + !scm_is_null (pair); pair = SCM_CDR (pair)) { scm_display (SCM_CAR (pair), scm_cur_errp); scm_newline (scm_cur_errp); diff --git a/libguile/hashtab.c b/libguile/hashtab.c index 754fc2198..f74526d5a 100644 --- a/libguile/hashtab.c +++ b/libguile/hashtab.c @@ -165,7 +165,7 @@ scm_i_rehash (SCM table, for (i = 0; i < old_size; ++i) { SCM ls = SCM_VELTS (buckets)[i], handle; - while (!SCM_NULLP (ls)) + while (!scm_is_null (ls)) { unsigned long h; handle = SCM_CAR (ls); @@ -215,7 +215,7 @@ scan_weak_hashtables (void *dummy1 SCM_UNUSED, { SCM *next = &weak_hashtables; SCM h = *next; - while (!SCM_NULLP (h)) + while (!scm_is_null (h)) { if (!SCM_GC_MARK_P (h)) *next = h = SCM_HASHTABLE_NEXT (h); @@ -230,7 +230,7 @@ scan_weak_hashtables (void *dummy1 SCM_UNUSED, { SCM *next_spine = (SCM *) &SCM_HASHTABLE_BUCKETS (h)[i]; for (alist = *next_spine; - !SCM_NULLP (alist); + !scm_is_null (alist); alist = SCM_CDR (alist)) if ((weak_car && UNMARKED_CELL_P (SCM_CAAR (alist))) || (weak_cdr && UNMARKED_CELL_P (SCM_CDAR (alist)))) @@ -266,7 +266,7 @@ rehash_after_gc (void *dummy1 SCM_UNUSED, void *dummy2 SCM_UNUSED, void *dummy3 SCM_UNUSED) { - if (!SCM_NULLP (to_rehash)) + if (!scm_is_null (to_rehash)) { SCM first = to_rehash, last, h; /* important to clear to_rehash here so that we don't get stuck @@ -282,7 +282,7 @@ rehash_after_gc (void *dummy1 SCM_UNUSED, "rehash_after_gc"); last = h; h = SCM_HASHTABLE_NEXT (h); - } while (!SCM_NULLP (h)); + } while (!scm_is_null (h)); /* move tables back to weak_hashtables */ SCM_SET_HASHTABLE_NEXT (last, weak_hashtables); weak_hashtables = first; @@ -487,7 +487,7 @@ scm_hash_fn_ref (SCM table, SCM obj, SCM dflt, unsigned long (*hash_fn)(), SCM (*assoc_fn)(), void * closure) { SCM it = scm_hash_fn_get_handle (table, obj, hash_fn, assoc_fn, closure); - if (SCM_CONSP (it)) + if (scm_is_pair (it)) return SCM_CDR (it); else return dflt; @@ -912,12 +912,12 @@ scm_internal_hash_fold (SCM (*fn) (), void *closure, SCM init, SCM table) for (i = 0; i < n; ++i) { SCM ls = SCM_VELTS (buckets)[i], handle; - while (!SCM_NULLP (ls)) + while (!scm_is_null (ls)) { - if (!SCM_CONSP (ls)) + if (!scm_is_pair (ls)) scm_wrong_type_arg (s_scm_hash_fold, SCM_ARG3, buckets); handle = SCM_CAR (ls); - if (!SCM_CONSP (handle)) + if (!scm_is_pair (handle)) scm_wrong_type_arg (s_scm_hash_fold, SCM_ARG3, buckets); result = fn (closure, SCM_CAR (handle), SCM_CDR (handle), result); ls = SCM_CDR (ls); @@ -950,12 +950,12 @@ scm_internal_hash_for_each_handle (SCM (*fn) (), void *closure, SCM table) for (i = 0; i < n; ++i) { SCM ls = SCM_VELTS (buckets)[i], handle; - while (!SCM_NULLP (ls)) + while (!scm_is_null (ls)) { - if (!SCM_CONSP (ls)) + if (!scm_is_pair (ls)) scm_wrong_type_arg (s_scm_hash_for_each, SCM_ARG3, buckets); handle = SCM_CAR (ls); - if (!SCM_CONSP (handle)) + if (!scm_is_pair (handle)) scm_wrong_type_arg (s_scm_hash_for_each, SCM_ARG3, buckets); fn (closure, handle); ls = SCM_CDR (ls); diff --git a/libguile/hooks.c b/libguile/hooks.c index 1c316ef69..0e7749e7e 100644 --- a/libguile/hooks.c +++ b/libguile/hooks.c @@ -183,7 +183,7 @@ SCM_DEFINE (scm_hook_empty_p, "hook-empty?", 1, 0, 0, #define FUNC_NAME s_scm_hook_empty_p { SCM_VALIDATE_HOOK (1, hook); - return scm_from_bool (SCM_NULLP (SCM_HOOK_PROCEDURES (hook))); + return scm_from_bool (scm_is_null (SCM_HOOK_PROCEDURES (hook))); } #undef FUNC_NAME diff --git a/libguile/inline.h b/libguile/inline.h index 34d09a4a8..19cd2ba54 100644 --- a/libguile/inline.h +++ b/libguile/inline.h @@ -3,7 +3,7 @@ #ifndef SCM_INLINE_H #define SCM_INLINE_H -/* Copyright (C) 2001, 2002, 2003 Free Software Foundation, Inc. +/* Copyright (C) 2001, 2002, 2003, 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 @@ -75,7 +75,7 @@ scm_cell (scm_t_bits car, scm_t_bits cdr) */ SCM *freelist = SCM_FREELIST_LOC (scm_i_freelist); - if (SCM_NULLP (*freelist)) + if (scm_is_null (*freelist)) z = scm_gc_for_newcell (&scm_i_master_freelist, freelist); else { @@ -164,7 +164,7 @@ scm_double_cell (scm_t_bits car, scm_t_bits cbr, SCM z; SCM *freelist = SCM_FREELIST_LOC (scm_i_freelist2); - if (SCM_NULLP (*freelist)) + if (scm_is_null (*freelist)) z = scm_gc_for_newcell (&scm_i_master_freelist2, freelist); else { diff --git a/libguile/lang.h b/libguile/lang.h index bb2ce6235..7d3c9ad1b 100644 --- a/libguile/lang.h +++ b/libguile/lang.h @@ -3,7 +3,7 @@ #ifndef SCM_LANG_H #define SCM_LANG_H -/* Copyright (C) 1998 Free Software Foundation, Inc. +/* Copyright (C) 1998, 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 @@ -38,7 +38,7 @@ SCM_API void scm_init_lang (void); #endif /* ! SCM_ENABLE_ELISP */ -#define SCM_NULL_OR_NIL_P(x) (SCM_NULLP (x) || SCM_NILP (x)) +#define SCM_NULL_OR_NIL_P(x) (scm_is_null (x) || SCM_NILP (x)) #endif /* SCM_LANG_H */ diff --git a/libguile/list.c b/libguile/list.c index 26b774be1..9fffa228d 100644 --- a/libguile/list.c +++ b/libguile/list.c @@ -120,10 +120,10 @@ SCM_DEFINE (scm_cons_star, "cons*", 1, 0, 1, #define FUNC_NAME s_scm_cons_star { SCM_VALIDATE_REST_ARGUMENT (rest); - if (!SCM_NULLP (rest)) + if (!scm_is_null (rest)) { SCM prev = arg = scm_cons (arg, rest); - while (!SCM_NULLP (SCM_CDR (rest))) + while (!scm_is_null (SCM_CDR (rest))) { prev = rest; rest = SCM_CDR (rest); @@ -171,11 +171,11 @@ scm_ilength(SCM sx) do { if (SCM_NULL_OR_NIL_P(hare)) return i; - if (!SCM_CONSP (hare)) return -1; + if (!scm_is_pair (hare)) return -1; hare = SCM_CDR(hare); i++; if (SCM_NULL_OR_NIL_P(hare)) return i; - if (!SCM_CONSP (hare)) return -1; + if (!scm_is_pair (hare)) return -1; hare = SCM_CDR(hare); i++; /* For every two steps the hare takes, the tortoise takes one. */ @@ -224,7 +224,7 @@ SCM_DEFINE (scm_append, "append", 0, 0, 1, #define FUNC_NAME s_scm_append { SCM_VALIDATE_REST_ARGUMENT (args); - if (SCM_NULLP (args)) { + if (scm_is_null (args)) { return SCM_EOL; } else { SCM res = SCM_EOL; @@ -232,8 +232,8 @@ SCM_DEFINE (scm_append, "append", 0, 0, 1, SCM arg = SCM_CAR (args); int argnum = 1; args = SCM_CDR (args); - while (!SCM_NULLP (args)) { - while (SCM_CONSP (arg)) { + while (!scm_is_null (args)) { + while (scm_is_pair (arg)) { *lloc = scm_cons (SCM_CAR (arg), SCM_EOL); lloc = SCM_CDRLOC (*lloc); arg = SCM_CDR (arg); @@ -262,7 +262,7 @@ SCM_DEFINE (scm_append_x, "append!", 0, 0, 1, SCM ret, *loc; SCM_VALIDATE_REST_ARGUMENT (lists); - if (SCM_NULLP (lists)) + if (scm_is_null (lists)) return SCM_EOL; loc = &ret; @@ -272,7 +272,7 @@ SCM_DEFINE (scm_append_x, "append!", 0, 0, 1, *loc = arg; lists = SCM_CDR (lists); - if (SCM_NULLP (lists)) + if (scm_is_null (lists)) return ret; if (!SCM_NULL_OR_NIL_P (arg)) @@ -300,10 +300,10 @@ SCM_DEFINE (scm_last_pair, "last-pair", 1, 0, 0, SCM_VALIDATE_CONS (SCM_ARG1, lst); do { SCM ahead = SCM_CDR(hare); - if (!SCM_CONSP (ahead)) return hare; + if (!scm_is_pair (ahead)) return hare; hare = ahead; ahead = SCM_CDR(hare); - if (!SCM_CONSP (ahead)) return hare; + if (!scm_is_pair (ahead)) return hare; hare = ahead; tortoise = SCM_CDR(tortoise); } @@ -327,11 +327,11 @@ SCM_DEFINE (scm_reverse, "reverse", 1, 0, 0, do { if (SCM_NULL_OR_NIL_P(hare)) return result; - SCM_ASSERT(SCM_CONSP(hare), lst, 1, FUNC_NAME); + SCM_ASSERT(scm_is_pair(hare), lst, 1, FUNC_NAME); result = scm_cons (SCM_CAR (hare), result); hare = SCM_CDR (hare); if (SCM_NULL_OR_NIL_P(hare)) return result; - SCM_ASSERT(SCM_CONSP(hare), lst, 1, FUNC_NAME); + SCM_ASSERT(scm_is_pair(hare), lst, 1, FUNC_NAME); result = scm_cons (SCM_CAR (hare), result); hare = SCM_CDR (hare); tortoise = SCM_CDR (tortoise); @@ -384,7 +384,7 @@ SCM_DEFINE (scm_list_ref, "list-ref", 2, 0, 0, SCM lst = list; unsigned long int i; i = scm_to_ulong (k); - while (SCM_CONSP (lst)) { + while (scm_is_pair (lst)) { if (i == 0) return SCM_CAR (lst); else { @@ -407,7 +407,7 @@ SCM_DEFINE (scm_list_set_x, "list-set!", 3, 0, 0, { SCM lst = list; unsigned long int i = scm_to_ulong (k); - while (SCM_CONSP (lst)) { + while (scm_is_pair (lst)) { if (i == 0) { SCM_SETCAR (lst, val); return val; @@ -453,7 +453,7 @@ SCM_DEFINE (scm_list_cdr_set_x, "list-cdr-set!", 3, 0, 0, { SCM lst = list; size_t i = scm_to_size_t (k); - while (SCM_CONSP (lst)) { + while (scm_is_pair (lst)) { if (i == 0) { SCM_SETCDR (lst, val); return val; @@ -502,7 +502,7 @@ SCM_DEFINE (scm_list_head, "list-head", 2, 0, 0, SCM scm_i_finite_list_copy (SCM list) { - if (!SCM_CONSP (list)) + if (!scm_is_pair (list)) { return list; } @@ -511,7 +511,7 @@ scm_i_finite_list_copy (SCM list) SCM tail; const SCM result = tail = scm_list_1 (SCM_CAR (list)); list = SCM_CDR (list); - while (SCM_CONSP (list)) + while (scm_is_pair (list)) { const SCM new_tail = scm_list_1 (SCM_CAR (list)); SCM_SETCDR (tail, new_tail); @@ -540,7 +540,7 @@ SCM_DEFINE (scm_list_copy, "list-copy", 1, 0, 0, fill_here = &newlst; from_here = lst; - while (SCM_CONSP (from_here)) + while (scm_is_pair (from_here)) { SCM c; c = scm_cons (SCM_CAR (from_here), SCM_CDR (from_here)); @@ -650,7 +650,7 @@ SCM_DEFINE (scm_delq_x, "delq!", 2, 0, 0, SCM *prev; for (prev = &lst, walk = lst; - SCM_CONSP (walk); + scm_is_pair (walk); walk = SCM_CDR (walk)) { if (scm_is_eq (SCM_CAR (walk), item)) @@ -674,7 +674,7 @@ SCM_DEFINE (scm_delv_x, "delv!", 2, 0, 0, SCM *prev; for (prev = &lst, walk = lst; - SCM_CONSP (walk); + scm_is_pair (walk); walk = SCM_CDR (walk)) { if (! scm_is_false (scm_eqv_p (SCM_CAR (walk), item))) @@ -699,7 +699,7 @@ SCM_DEFINE (scm_delete_x, "delete!", 2, 0, 0, SCM *prev; for (prev = &lst, walk = lst; - SCM_CONSP (walk); + scm_is_pair (walk); walk = SCM_CDR (walk)) { if (! scm_is_false (scm_equal_p (SCM_CAR (walk), item))) @@ -767,7 +767,7 @@ SCM_DEFINE (scm_delq1_x, "delq1!", 2, 0, 0, SCM *prev; for (prev = &lst, walk = lst; - SCM_CONSP (walk); + scm_is_pair (walk); walk = SCM_CDR (walk)) { if (scm_is_eq (SCM_CAR (walk), item)) @@ -795,7 +795,7 @@ SCM_DEFINE (scm_delv1_x, "delv1!", 2, 0, 0, SCM *prev; for (prev = &lst, walk = lst; - SCM_CONSP (walk); + scm_is_pair (walk); walk = SCM_CDR (walk)) { if (! scm_is_false (scm_eqv_p (SCM_CAR (walk), item))) @@ -823,7 +823,7 @@ SCM_DEFINE (scm_delete1_x, "delete1!", 2, 0, 0, SCM *prev; for (prev = &lst, walk = lst; - SCM_CONSP (walk); + scm_is_pair (walk); walk = SCM_CDR (walk)) { if (! scm_is_false (scm_equal_p (SCM_CAR (walk), item))) @@ -859,7 +859,7 @@ SCM_DEFINE (scm_filter, "filter", 2, 0, 0, SCM_VALIDATE_LIST (2, list); for (prev = &res, walk = list; - SCM_CONSP (walk); + scm_is_pair (walk); walk = SCM_CDR (walk)) { if (scm_is_true (call (pred, SCM_CAR (walk)))) @@ -885,7 +885,7 @@ SCM_DEFINE (scm_filter_x, "filter!", 2, 0, 0, SCM_VALIDATE_LIST (2, list); for (prev = &list, walk = list; - SCM_CONSP (walk); + scm_is_pair (walk); walk = SCM_CDR (walk)) { if (scm_is_true (call (pred, SCM_CAR (walk)))) diff --git a/libguile/load.c b/libguile/load.c index 337426921..0c0077336 100644 --- a/libguile/load.c +++ b/libguile/load.c @@ -368,7 +368,7 @@ SCM_DEFINE (scm_search_path, "search-path", 2, 1, 0, /* This simplifies the loop below a bit. */ - if (SCM_NULLP (extensions)) + if (scm_is_null (extensions)) extensions = scm_listofnullstr; buf.buf_len = 512; @@ -377,7 +377,7 @@ SCM_DEFINE (scm_search_path, "search-path", 2, 1, 0, /* Try every path element. */ - for (; SCM_CONSP (path); path = SCM_CDR (path)) + for (; scm_is_pair (path); path = SCM_CDR (path)) { SCM dir = SCM_CAR (path); SCM exts; @@ -399,7 +399,7 @@ SCM_DEFINE (scm_search_path, "search-path", 2, 1, 0, sans_ext_len = buf.ptr - buf.buf; /* Try every extension. */ - for (exts = extensions; SCM_CONSP (exts); exts = SCM_CDR (exts)) + for (exts = extensions; scm_is_pair (exts); exts = SCM_CDR (exts)) { SCM ext = SCM_CAR (exts); struct stat mode; diff --git a/libguile/modules.c b/libguile/modules.c index 5049a186c..9bc0428c5 100644 --- a/libguile/modules.c +++ b/libguile/modules.c @@ -217,10 +217,10 @@ scm_top_level_env (SCM thunk) SCM scm_env_top_level (SCM env) { - while (SCM_CONSP (env)) + while (scm_is_pair (env)) { SCM car_env = SCM_CAR (env); - if (!SCM_CONSP (car_env) && scm_is_true (scm_procedure_p (car_env))) + if (!scm_is_pair (car_env) && scm_is_true (scm_procedure_p (car_env))) return car_env; env = SCM_CDR (env); } @@ -297,7 +297,7 @@ module_variable (SCM module, SCM sym) { /* 3. Search the use list */ SCM uses = SCM_MODULE_USES (module); - while (SCM_CONSP (uses)) + while (scm_is_pair (uses)) { b = module_variable (SCM_CAR (uses), sym); if (SCM_BOUND_THING_P (b)) @@ -399,7 +399,7 @@ SCM_DEFINE (scm_module_import_interface, "module-import-interface", 2, 0, 0, SCM_VALIDATE_MODULE (SCM_ARG1, module); /* Search the use list */ uses = SCM_MODULE_USES (module); - while (SCM_CONSP (uses)) + while (scm_is_pair (uses)) { SCM _interface = SCM_CAR (uses); /* 1. Check module obarray */ @@ -578,7 +578,7 @@ scm_module_reverse_lookup (SCM module, SCM variable) for (i = 0; i < n; ++i) { SCM ls = SCM_HASHTABLE_BUCKETS (obarray)[i], handle; - while (!SCM_NULLP (ls)) + while (!scm_is_null (ls)) { handle = SCM_CAR (ls); if (SCM_CDR (handle) == variable) @@ -591,7 +591,7 @@ scm_module_reverse_lookup (SCM module, SCM variable) */ { SCM uses = SCM_MODULE_USES (module); - while (SCM_CONSP (uses)) + while (scm_is_pair (uses)) { SCM sym = scm_module_reverse_lookup (SCM_CAR (uses), variable); if (scm_is_true (sym)) diff --git a/libguile/null-threads.c b/libguile/null-threads.c index a4affd96b..7f2eb8b43 100644 --- a/libguile/null-threads.c +++ b/libguile/null-threads.c @@ -245,7 +245,7 @@ scm_timed_wait_condition_variable (SCM c, SCM m, SCM t) s_wait_condition_variable); if (!SCM_UNBNDP (t)) { - if (SCM_CONSP (t)) + if (scm_is_pair (t)) { SCM_VALIDATE_UINT_COPY (3, SCM_CAR(t), waittime.tv_sec); SCM_VALIDATE_UINT_COPY (3, SCM_CDR(t), waittime.tv_usec); diff --git a/libguile/objects.c b/libguile/objects.c index 449976a1d..6b925f7a9 100644 --- a/libguile/objects.c +++ b/libguile/objects.c @@ -73,7 +73,7 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0, return scm_class_char; else if (scm_is_bool (x)) return scm_class_boolean; - else if (SCM_NULLP (x)) + else if (scm_is_null (x)) return scm_class_null; else return scm_class_unknown; @@ -178,7 +178,7 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0, } } default: - if (SCM_CONSP (x)) + if (scm_is_pair (x)) return scm_class_pair; else return scm_class_unknown; @@ -256,14 +256,14 @@ scm_mcache_lookup_cmethod (SCM cache, SCM args) methods = SCM_CADR (z); i = 0; ls = args; - if (!SCM_NULLP (ls)) + if (!scm_is_null (ls)) do { i += SCM_STRUCT_DATA (scm_class_of (SCM_CAR (ls))) [scm_si_hashsets + hashset]; ls = SCM_CDR (ls); } - while (j-- && !SCM_NULLP (ls)); + while (j-- && !scm_is_null (ls)); i &= mask; end = i; } @@ -274,7 +274,7 @@ scm_mcache_lookup_cmethod (SCM cache, SCM args) long j = n; z = SCM_VELTS (methods)[i]; ls = args; /* list of arguments */ - if (!SCM_NULLP (ls)) + if (!scm_is_null (ls)) do { /* More arguments than specifiers => CLASS != ENV */ @@ -283,9 +283,9 @@ scm_mcache_lookup_cmethod (SCM cache, SCM args) ls = SCM_CDR (ls); z = SCM_CDR (z); } - while (j-- && !SCM_NULLP (ls)); + while (j-- && !scm_is_null (ls)); /* Fewer arguments than specifiers => CAR != ENV */ - if (SCM_NULLP (SCM_CAR (z)) || SCM_CONSP (SCM_CAR (z))) + if (scm_is_null (SCM_CAR (z)) || scm_is_pair (SCM_CAR (z))) return z; next_method: i = (i + 1) & mask; diff --git a/libguile/options.c b/libguile/options.c index 34e0bef99..96b4b1c25 100644 --- a/libguile/options.c +++ b/libguile/options.c @@ -187,12 +187,12 @@ change_option_setting (SCM args, scm_t_option options[], unsigned int n, const c break; case SCM_OPTION_INTEGER: args = SCM_CDR (args); - SCM_ASSERT (SCM_CONSP (args), args, SCM_ARG1, s); + SCM_ASSERT (scm_is_pair (args), args, SCM_ARG1, s); flags[i] = scm_to_size_t (SCM_CAR (args)); break; case SCM_OPTION_SCM: args = SCM_CDR (args); - SCM_ASSERT (SCM_CONSP (args), args, SCM_ARG1, s); + SCM_ASSERT (scm_is_pair (args), args, SCM_ARG1, s); flags[i] = SCM_UNPACK (SCM_CAR (args)); break; } @@ -229,7 +229,7 @@ scm_options (SCM args, scm_t_option options[], unsigned int n, const char *s) { if (SCM_UNBNDP (args)) return get_option_setting (options, n); - else if (!SCM_NULL_OR_NIL_P (args) && !SCM_CONSP (args)) + else if (!SCM_NULL_OR_NIL_P (args) && !scm_is_pair (args)) /* Dirk:FIXME:: This criterion should be improved. IMO it is better to * demand that args is #t if documentation should be shown than to say * that every argument except a list will print out documentation. */ diff --git a/libguile/print.c b/libguile/print.c index cfae921bd..5a0eaadd4 100644 --- a/libguile/print.c +++ b/libguile/print.c @@ -140,7 +140,7 @@ SCM_DEFINE (scm_current_pstate, "current-pstate", 0, 0, 0, "included in @code{--enable-guile-debug} builds.") #define FUNC_NAME s_scm_current_pstate { - if (!SCM_NULLP (print_state_pool)) + if (!scm_is_null (print_state_pool)) return SCM_CAR (print_state_pool); else return SCM_BOOL_F; @@ -170,7 +170,7 @@ scm_make_print_state () /* First try to allocate a print state from the pool */ scm_i_plugin_mutex_lock (&print_state_mutex); - if (!SCM_NULLP (print_state_pool)) + if (!scm_is_null (print_state_pool)) { answer = SCM_CAR (print_state_pool); print_state_pool = SCM_CDR (print_state_pool); @@ -239,11 +239,11 @@ print_circref (SCM port, scm_print_state *pstate, SCM ref) register long i; long self = pstate->top - 1; i = pstate->top - 1; - if (SCM_CONSP (pstate->ref_stack[i])) + if (scm_is_pair (pstate->ref_stack[i])) { while (i > 0) { - if (!SCM_CONSP (pstate->ref_stack[i - 1]) + if (!scm_is_pair (pstate->ref_stack[i - 1]) || !scm_is_eq (SCM_CDR (pstate->ref_stack[i - 1]), pstate->ref_stack[i])) break; @@ -685,7 +685,7 @@ scm_prin1 (SCM exp, SCM port, int writingp) { /* First try to allocate a print state from the pool */ scm_i_plugin_mutex_lock (&print_state_mutex); - if (!SCM_NULLP (print_state_pool)) + if (!scm_is_null (print_state_pool)) { handle = print_state_pool; print_state_pool = SCM_CDR (print_state_pool); @@ -763,12 +763,12 @@ scm_iprlist (char *hdr, SCM exp, int tlr, SCM port, scm_print_state *pstate) O(depth * N) instead of O(N^2). */ hare = SCM_CDR (exp); tortoise = exp; - while (SCM_CONSP (hare)) + while (scm_is_pair (hare)) { if (scm_is_eq (hare, tortoise)) goto fancy_printing; hare = SCM_CDR (hare); - if (!SCM_CONSP (hare)) + if (!scm_is_pair (hare)) break; hare = SCM_CDR (hare); tortoise = SCM_CDR (tortoise); @@ -776,7 +776,7 @@ scm_iprlist (char *hdr, SCM exp, int tlr, SCM port, scm_print_state *pstate) /* No cdr cycles intrinsic to this list */ scm_iprin1 (SCM_CAR (exp), port, pstate); - for (exp = SCM_CDR (exp); SCM_CONSP (exp); exp = SCM_CDR (exp)) + for (exp = SCM_CDR (exp); scm_is_pair (exp); exp = SCM_CDR (exp)) { register long i; @@ -805,7 +805,7 @@ fancy_printing: scm_iprin1 (SCM_CAR (exp), port, pstate); exp = SCM_CDR (exp); --n; - for (; SCM_CONSP (exp); exp = SCM_CDR (exp)) + for (; scm_is_pair (exp); exp = SCM_CDR (exp)) { register unsigned long i; @@ -974,7 +974,7 @@ SCM_DEFINE (scm_simple_format, "simple-format", 2, 0, 1, } - if (!SCM_CONSP (args)) + if (!scm_is_pair (args)) SCM_MISC_ERROR ("FORMAT: Missing argument for ~~~A", scm_list_1 (SCM_MAKE_CHAR (*p))); diff --git a/libguile/procprop.c b/libguile/procprop.c index 41db72535..3a341c574 100644 --- a/libguile/procprop.c +++ b/libguile/procprop.c @@ -105,14 +105,14 @@ scm_i_procedure_arity (SCM proc) goto loop; case scm_tcs_closures: proc = SCM_CLOSURE_FORMALS (proc); - if (SCM_NULLP (proc)) + if (scm_is_null (proc)) break; - while (SCM_CONSP (proc)) + while (scm_is_pair (proc)) { ++a; proc = SCM_CDR (proc); } - if (!SCM_NULLP (proc)) + if (!scm_is_null (proc)) r = 1; break; case scm_tcs_struct: diff --git a/libguile/procs.c b/libguile/procs.c index 4a233dde6..82e848058 100644 --- a/libguile/procs.c +++ b/libguile/procs.c @@ -204,7 +204,7 @@ SCM_DEFINE (scm_thunk_p, "thunk?", 1, 0, 0, switch (SCM_TYP7 (obj)) { case scm_tcs_closures: - return scm_from_bool (!SCM_CONSP (SCM_CLOSURE_FORMALS (obj))); + return scm_from_bool (!scm_is_pair (SCM_CLOSURE_FORMALS (obj))); case scm_tc7_subr_0: case scm_tc7_subr_1o: case scm_tc7_lsubr: @@ -255,7 +255,7 @@ SCM_DEFINE (scm_procedure_documentation, "procedure-documentation", 1, 0, 0, { case scm_tcs_closures: code = SCM_CLOSURE_BODY (proc); - if (SCM_NULLP (SCM_CDR (code))) + if (scm_is_null (SCM_CDR (code))) return SCM_BOOL_F; code = SCM_CAR (code); if (scm_is_string (code)) diff --git a/libguile/procs.h b/libguile/procs.h index d9621a8e4..550bb725f 100644 --- a/libguile/procs.h +++ b/libguile/procs.h @@ -77,7 +77,7 @@ typedef struct + scm_tc3_closure)) #define SCM_ENV(x) SCM_CELL_OBJECT_1 (x) #define SCM_SETENV(x, e) SCM_SET_CELL_OBJECT_1 ((x), (e)) -#define SCM_TOP_LEVEL(ENV) (SCM_NULLP (ENV) || (scm_is_true (scm_procedure_p (SCM_CAR (ENV))))) +#define SCM_TOP_LEVEL(ENV) (scm_is_null (ENV) || (scm_is_true (scm_procedure_p (SCM_CAR (ENV))))) /* Procedure-with-setter diff --git a/libguile/ramap.c b/libguile/ramap.c index fc88a824e..1caa74491 100644 --- a/libguile/ramap.c +++ b/libguile/ramap.c @@ -988,7 +988,7 @@ scm_ra_sum (SCM ra0, SCM ras) unsigned long i0 = SCM_ARRAY_BASE (ra0); long inc0 = SCM_ARRAY_DIMS (ra0)->inc; ra0 = SCM_ARRAY_V (ra0); - if (!SCM_NULLP(ras)) + if (!scm_is_null(ras)) { SCM ra1 = SCM_CAR (ras); unsigned long i1 = SCM_ARRAY_BASE (ra1); @@ -1027,7 +1027,7 @@ scm_ra_difference (SCM ra0, SCM ras) unsigned long i0 = SCM_ARRAY_BASE (ra0); long inc0 = SCM_ARRAY_DIMS (ra0)->inc; ra0 = SCM_ARRAY_V (ra0); - if (SCM_NULLP (ras)) + if (scm_is_null (ras)) { switch (SCM_TYP7 (ra0)) { @@ -1083,7 +1083,7 @@ scm_ra_product (SCM ra0, SCM ras) unsigned long i0 = SCM_ARRAY_BASE (ra0); long inc0 = SCM_ARRAY_DIMS (ra0)->inc; ra0 = SCM_ARRAY_V (ra0); - if (!SCM_NULLP (ras)) + if (!scm_is_null (ras)) { SCM ra1 = SCM_CAR (ras); unsigned long i1 = SCM_ARRAY_BASE (ra1); @@ -1134,7 +1134,7 @@ scm_ra_divide (SCM ra0, SCM ras) unsigned long i0 = SCM_ARRAY_BASE (ra0); long inc0 = SCM_ARRAY_DIMS (ra0)->inc; ra0 = SCM_ARRAY_V (ra0); - if (SCM_NULLP (ras)) + if (scm_is_null (ras)) { switch (SCM_TYP7 (ra0)) { @@ -1220,7 +1220,7 @@ ramap (SCM ra0, SCM proc, SCM ras) long n = SCM_ARRAY_DIMS (ra0)->ubnd; long base = SCM_ARRAY_BASE (ra0) - i * inc; ra0 = SCM_ARRAY_V (ra0); - if (SCM_NULLP (ras)) + if (scm_is_null (ras)) for (; i <= n; i++) scm_array_set_x (ra0, scm_call_0 (proc), scm_from_long (i * inc + base)); else @@ -1232,7 +1232,7 @@ ramap (SCM ra0, SCM proc, SCM ras) long inc1 = SCM_ARRAY_DIMS (ra1)->inc; ra1 = SCM_ARRAY_V (ra1); ras = SCM_CDR (ras); - if (SCM_NULLP(ras)) + if (scm_is_null(ras)) ras = scm_nullvect; else { @@ -1430,7 +1430,7 @@ ramap_2o (SCM ra0, SCM proc, SCM ras) ra0 = SCM_ARRAY_V (ra0); ra1 = SCM_ARRAY_V (ra1); ras = SCM_CDR (ras); - if (SCM_NULLP (ras)) + if (scm_is_null (ras)) { if (scm_tc7_vector == SCM_TYP7 (ra0) || scm_tc7_wvect == SCM_TYP7 (ra0)) @@ -1474,7 +1474,7 @@ ramap_a (SCM ra0, SCM proc, SCM ras) unsigned long i0 = SCM_ARRAY_BASE (ra0); long inc0 = SCM_ARRAY_DIMS (ra0)->inc; ra0 = SCM_ARRAY_V (ra0); - if (SCM_NULLP (ras)) + if (scm_is_null (ras)) for (; n-- > 0; i0 += inc0) scm_array_set_x (ra0, SCM_SUBRF (proc) (RVREF (ra0, i0, e0), SCM_UNDEFINED), scm_from_ulong (i0)); else @@ -1532,14 +1532,14 @@ SCM_DEFINE (scm_array_map_x, "array-map!", 2, 0, 1, for (p = ra_rpsubrs; p->name; p++) if (scm_is_eq (proc, p->sproc)) { - while (!SCM_NULLP (lra) && !SCM_NULLP (SCM_CDR (lra))) + while (!scm_is_null (lra) && !scm_is_null (SCM_CDR (lra))) { scm_ramapc (p->vproc, SCM_UNDEFINED, ra0, lra, FUNC_NAME); lra = SCM_CDR (lra); } return SCM_UNSPECIFIED; } - while (!SCM_NULLP (lra) && !SCM_NULLP (SCM_CDR (lra))) + while (!scm_is_null (lra) && !scm_is_null (SCM_CDR (lra))) { scm_ramapc (ramap_rp, proc, ra0, lra, FUNC_NAME); lra = SCM_CDR (lra); @@ -1547,7 +1547,7 @@ SCM_DEFINE (scm_array_map_x, "array-map!", 2, 0, 1, return SCM_UNSPECIFIED; } case scm_tc7_asubr: - if (SCM_NULLP (lra)) + if (scm_is_null (lra)) { SCM prot, fill = SCM_SUBRF (proc) (SCM_UNDEFINED, SCM_UNDEFINED); if (SCM_I_INUMP(fill)) @@ -1572,7 +1572,7 @@ SCM_DEFINE (scm_array_map_x, "array-map!", 2, 0, 1, if (!scm_is_eq (ra0, ra1) || (SCM_ARRAYP(ra0) && !SCM_ARRAY_CONTP(ra0))) goto gencase; - for (tail = SCM_CDR (lra); !SCM_NULLP (tail); tail = SCM_CDR (tail)) + for (tail = SCM_CDR (lra); !scm_is_null (tail); tail = SCM_CDR (tail)) { ra1 = SCM_CAR (tail); if (scm_is_eq (v0, ra1) @@ -1613,7 +1613,7 @@ rafe (SCM ra0, SCM proc, SCM ras) long inc0 = SCM_ARRAY_DIMS (ra0)->inc; long n = SCM_ARRAY_DIMS (ra0)->ubnd; ra0 = SCM_ARRAY_V (ra0); - if (SCM_NULLP (ras)) + if (scm_is_null (ras)) for (; i <= n; i++, i0 += inc0) scm_call_1 (proc, scm_cvref (ra0, i0, SCM_UNDEFINED)); else @@ -1625,7 +1625,7 @@ rafe (SCM ra0, SCM proc, SCM ras) long inc1 = SCM_ARRAY_DIMS (ra1)->inc; ra1 = SCM_ARRAY_V (ra1); ras = SCM_CDR (ras); - if (SCM_NULLP(ras)) + if (scm_is_null(ras)) ras = scm_nullvect; else { diff --git a/libguile/read.c b/libguile/read.c index fa3f958bf..199825081 100644 --- a/libguile/read.c +++ b/libguile/read.c @@ -280,7 +280,7 @@ scm_i_casei_streq (const char *s1, const char *s2, size_t len2) static SCM recsexpr (SCM obj, long line, int column, SCM filename) { - if (!SCM_CONSP(obj)) { + if (!scm_is_pair(obj)) { return obj; } else { SCM tmp = obj, copy; @@ -293,7 +293,7 @@ recsexpr (SCM obj, long line, int column, SCM filename) { copy = scm_cons (recsexpr (SCM_CAR (obj), line, column, filename), SCM_UNDEFINED); - while ((tmp = SCM_CDR (tmp)) && SCM_CONSP (tmp)) + while ((tmp = SCM_CDR (tmp)) && scm_is_pair (tmp)) { SCM_SETCDR (copy, scm_cons (recsexpr (SCM_CAR (tmp), line, @@ -307,7 +307,7 @@ recsexpr (SCM obj, long line, int column, SCM filename) else { recsexpr (SCM_CAR (obj), line, column, filename); - while ((tmp = SCM_CDR (tmp)) && SCM_CONSP (tmp)) + while ((tmp = SCM_CDR (tmp)) && scm_is_pair (tmp)) recsexpr (SCM_CAR (tmp), line, column, filename); copy = SCM_UNDEFINED; } @@ -358,7 +358,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy) if (SCM_ELISP_VECTORS_P) { p = scm_i_lreadparen (tok_buf, port, s_vector, copy, ']'); - return SCM_NULLP (p) ? scm_nullvect : scm_vector (p); + return scm_is_null (p) ? scm_nullvect : scm_vector (p); } goto read_token; #endif @@ -422,7 +422,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy) { case '(': p = scm_i_lreadparen (tok_buf, port, s_vector, copy, ')'); - return SCM_NULLP (p) ? scm_nullvect : scm_vector (p); + return scm_is_null (p) ? scm_nullvect : scm_vector (p); case 't': case 'T': @@ -807,7 +807,7 @@ scm_lreadrecparen (SCM *tok_buf, SCM port, char *name, SCM *copy) /* Build the head of the list structure. */ ans = tl = scm_cons (tmp, SCM_EOL); if (SCM_COPY_SOURCE_P) - ans2 = tl2 = scm_cons (SCM_CONSP (tmp) + ans2 = tl2 = scm_cons (scm_is_pair (tmp) ? *copy : tmp, SCM_EOL); @@ -820,7 +820,7 @@ scm_lreadrecparen (SCM *tok_buf, SCM port, char *name, SCM *copy) { SCM_SETCDR (tl, tmp = scm_lreadr (tok_buf, port, copy)); if (SCM_COPY_SOURCE_P) - SCM_SETCDR (tl2, scm_cons (SCM_CONSP (tmp) + SCM_SETCDR (tl2, scm_cons (scm_is_pair (tmp) ? *copy : tmp, SCM_EOL)); @@ -835,7 +835,7 @@ scm_lreadrecparen (SCM *tok_buf, SCM port, char *name, SCM *copy) if (SCM_COPY_SOURCE_P) { - SCM new_tail2 = scm_cons (SCM_CONSP (tmp) ? *copy : tmp, SCM_EOL); + SCM new_tail2 = scm_cons (scm_is_pair (tmp) ? *copy : tmp, SCM_EOL); SCM_SETCDR (tl2, new_tail2); tl2 = new_tail2; } @@ -881,7 +881,7 @@ SCM_DEFINE (scm_read_hash_extend, "read-hash-extend", 2, 0, 0, prev = SCM_BOOL_F; while (1) { - if (SCM_NULLP (this)) + if (scm_is_null (this)) { /* not found, so add it to the beginning. */ if (scm_is_true (proc)) @@ -928,7 +928,7 @@ scm_get_hash_procedure (int c) while (1) { - if (SCM_NULLP (rest)) + if (scm_is_null (rest)) return SCM_BOOL_F; if (SCM_CHAR (SCM_CAAR (rest)) == c) diff --git a/libguile/regex-posix.c b/libguile/regex-posix.c index 754f28904..1ffbb35b6 100644 --- a/libguile/regex-posix.c +++ b/libguile/regex-posix.c @@ -162,7 +162,7 @@ SCM_DEFINE (scm_make_regexp, "make-regexp", 1, 0, 1, turn off REG_EXTENDED flag (on by default). */ cflags = REG_EXTENDED; flag = flags; - while (!SCM_NULLP (flag)) + while (!scm_is_null (flag)) { if (scm_to_int (SCM_CAR (flag)) == REG_BASIC) cflags &= ~REG_EXTENDED; diff --git a/libguile/scmsigs.c b/libguile/scmsigs.c index 1b9aa0724..d57deabab 100644 --- a/libguile/scmsigs.c +++ b/libguile/scmsigs.c @@ -104,7 +104,7 @@ take_signal (int signum) SCM handler = SCM_VECTOR_REF(signal_cell_handlers, signum); SCM thread = SCM_VECTOR_REF(signal_handler_threads, signum); scm_root_state *root = scm_i_thread_root (thread); - if (SCM_CONSP (cell)) + if (scm_is_pair (cell)) { SCM_SETCAR (cell, handler); root->pending_asyncs = 1; @@ -148,7 +148,7 @@ scm_delq_spine_x (SCM cell, SCM list) while (!scm_is_eq (cell, s)) { - if (SCM_NULLP (s)) + if (scm_is_null (s)) return list; prev = s; s = SCM_CDR (s); diff --git a/libguile/script.c b/libguile/script.c index 9a1f439b7..b2629b3f1 100644 --- a/libguile/script.c +++ b/libguile/script.c @@ -453,7 +453,7 @@ scm_compile_shell_switches (int argc, char **argv) /* If we specified the -ds option, do_script points to the cdr of an expression like (load #f); we replace the car (i.e., the #f) with the script name. */ - if (!SCM_NULLP (do_script)) + if (!scm_is_null (do_script)) { SCM_SETCAR (do_script, scm_from_locale_string (argv[i])); do_script = SCM_EOL; @@ -526,7 +526,7 @@ scm_compile_shell_switches (int argc, char **argv) { /* We put a dummy "load" expression, and let the -s put the filename in. */ - if (!SCM_NULLP (do_script)) + if (!scm_is_null (do_script)) scm_shell_usage (1, "the -ds switch may only be specified once"); do_script = scm_cons (SCM_BOOL_F, SCM_EOL); tail = scm_cons (scm_cons (sym_load, do_script), @@ -615,7 +615,7 @@ scm_compile_shell_switches (int argc, char **argv) } /* Check to make sure the -ds got a -s. */ - if (!SCM_NULLP (do_script)) + if (!scm_is_null (do_script)) scm_shell_usage (1, "the `-ds' switch requires the use of `-s' as well"); /* Make any remaining arguments available to the @@ -626,7 +626,7 @@ scm_compile_shell_switches (int argc, char **argv) scm_c_define ("use-emacs-interface", scm_from_bool (use_emacs_interface)); /* Handle the `-e' switch, if it was specified. */ - if (!SCM_NULLP (entry_point)) + if (!scm_is_null (entry_point)) tail = scm_cons (scm_cons2 (entry_point, scm_cons (sym_command_line, SCM_EOL), SCM_EOL), @@ -650,7 +650,7 @@ scm_compile_shell_switches (int argc, char **argv) /* add the user-specified load path here, so it won't be in effect during the loading of the user's customization file. */ - if(!SCM_NULLP(user_load_path)) + if(!scm_is_null(user_load_path)) { tail = scm_append_x( scm_cons2(user_load_path, tail, SCM_EOL) ); } diff --git a/libguile/simpos.c b/libguile/simpos.c index d0a5a28f1..e7e9d9c2c 100644 --- a/libguile/simpos.c +++ b/libguile/simpos.c @@ -114,10 +114,10 @@ SCM_DEFINE (scm_system_star, "system*", 0, 0, 1, "Example: (system* \"echo\" \"foo\" \"bar\")") #define FUNC_NAME s_scm_system_star { - if (SCM_NULLP (args)) + if (scm_is_null (args)) SCM_WRONG_NUM_ARGS (); - if (SCM_CONSP (args)) + if (scm_is_pair (args)) { SCM oldint; SCM oldquit; diff --git a/libguile/smob.c b/libguile/smob.c index 5ef386ba0..ed601b865 100644 --- a/libguile/smob.c +++ b/libguile/smob.c @@ -242,7 +242,7 @@ scm_smob_apply_2_error (SCM smob, SCM a1 SCM_UNUSED, SCM a2 SCM_UNUSED) static SCM scm_smob_apply_3_030 (SCM smob, SCM a1, SCM a2, SCM rst) { - if (!SCM_NULLP (SCM_CDR (rst))) + if (!scm_is_null (SCM_CDR (rst))) scm_wrong_num_args (smob); return SCM_SMOB_APPLY3 (smob, a1, a2, SCM_CAR (rst)); } diff --git a/libguile/socket.c b/libguile/socket.c index cab3b6512..6c4b6531a 100644 --- a/libguile/socket.c +++ b/libguile/socket.c @@ -620,7 +620,7 @@ SCM_DEFINE (scm_setsockopt, "setsockopt", 4, 0, 0, struct linger ling; long lv; - SCM_ASSERT (SCM_CONSP (value), value, SCM_ARG4, FUNC_NAME); + SCM_ASSERT (scm_is_pair (value), value, SCM_ARG4, FUNC_NAME); lv = SCM_NUM2LONG (4, SCM_CAR (value)); ling.l_onoff = (int) lv; SCM_ASSERT_RANGE (SCM_ARG4, value, ling.l_onoff == lv); @@ -633,7 +633,7 @@ SCM_DEFINE (scm_setsockopt, "setsockopt", 4, 0, 0, int ling; long lv; - SCM_ASSERT (SCM_CONSP (value), value, SCM_ARG4, FUNC_NAME); + SCM_ASSERT (scm_is_pair (value), value, SCM_ARG4, FUNC_NAME); /* timeout is ignored, but may as well validate it. */ lv = SCM_NUM2LONG (4, SCM_CDR (value)); ling = (int) lv; @@ -755,11 +755,11 @@ scm_fill_sockaddr (int fam, SCM address, SCM *args, int which_arg, SCM_VALIDATE_CONS (which_arg + 1, *args); port = scm_to_int (SCM_CAR (*args)); *args = SCM_CDR (*args); - if (SCM_CONSP (*args)) + if (scm_is_pair (*args)) { SCM_VALIDATE_ULONG_COPY (which_arg + 2, SCM_CAR (*args), flowinfo); *args = SCM_CDR (*args); - if (SCM_CONSP (*args)) + if (scm_is_pair (*args)) { SCM_VALIDATE_ULONG_COPY (which_arg + 3, SCM_CAR (*args), scope_id); @@ -1299,7 +1299,7 @@ SCM_DEFINE (scm_sendto, "sendto", 4, 0, 1, fd = SCM_FPORT_FDES (sock); soka = scm_fill_sockaddr (scm_to_int (fam), address, &args_and_flags, 4, FUNC_NAME, &size); - if (SCM_NULLP (args_and_flags)) + if (scm_is_null (args_and_flags)) flg = 0; else { diff --git a/libguile/sort.c b/libguile/sort.c index 35aea629f..d5adb9525 100644 --- a/libguile/sort.c +++ b/libguile/sort.c @@ -329,7 +329,7 @@ SCM_DEFINE (scm_sorted_p, "sorted?", 2, 0, 0, if (SCM_NULL_OR_NIL_P (items)) return SCM_BOOL_T; - if (SCM_CONSP (items)) + if (scm_is_pair (items)) { len = scm_ilength (items); /* also checks that it's a pure list */ SCM_ASSERT_RANGE (1, items, len >= 0); @@ -581,7 +581,7 @@ SCM_DEFINE (scm_sort_x, "sort!", 2, 0, 0, if (SCM_NULL_OR_NIL_P (items)) return items; - if (SCM_CONSP (items)) + if (scm_is_pair (items)) { const scm_t_trampoline_2 cmp = compare_function (less, 2, FUNC_NAME); SCM_VALIDATE_LIST_COPYLEN (1, items, len); @@ -612,7 +612,7 @@ SCM_DEFINE (scm_sort, "sort", 2, 0, 0, if (SCM_NULL_OR_NIL_P (items)) return items; - if (SCM_CONSP (items)) + if (scm_is_pair (items)) { const scm_t_trampoline_2 cmp = compare_function (less, 2, FUNC_NAME); long len; @@ -723,7 +723,7 @@ SCM_DEFINE (scm_stable_sort_x, "stable-sort!", 2, 0, 0, if (SCM_NULL_OR_NIL_P (items)) return items; - if (SCM_CONSP (items)) + if (scm_is_pair (items)) { SCM_VALIDATE_LIST_COPYLEN (1, items, len); return scm_merge_list_step (&items, cmp, less, len); @@ -761,7 +761,7 @@ SCM_DEFINE (scm_stable_sort, "stable-sort", 2, 0, 0, if (SCM_NULL_OR_NIL_P (items)) return items; - if (SCM_CONSP (items)) + if (scm_is_pair (items)) { long len; /* list/vector length */ diff --git a/libguile/srcprop.c b/libguile/srcprop.c index f48df9f51..9851b747b 100644 --- a/libguile/srcprop.c +++ b/libguile/srcprop.c @@ -156,7 +156,7 @@ SCM_DEFINE (scm_source_properties, "source-properties", 1, 0, 0, SCM_VALIDATE_NIM (1, obj); if (SCM_MEMOIZEDP (obj)) obj = SCM_MEMOIZED_EXP (obj); - else if (!SCM_CONSP (obj)) + else if (!scm_is_pair (obj)) SCM_WRONG_TYPE_ARG (1, obj); p = scm_hashq_ref (scm_source_whash, obj, SCM_EOL); if (SRCPROPSP (p)) @@ -179,7 +179,7 @@ SCM_DEFINE (scm_set_source_properties_x, "set-source-properties!", 2, 0, 0, SCM_VALIDATE_NIM (1, obj); if (SCM_MEMOIZEDP (obj)) obj = SCM_MEMOIZED_EXP (obj); - else if (!SCM_CONSP (obj)) + else if (!scm_is_pair (obj)) SCM_WRONG_TYPE_ARG(1, obj); handle = scm_hashq_create_handle_x (scm_source_whash, obj, plist); SCM_SETCDR (handle, plist); @@ -197,7 +197,7 @@ SCM_DEFINE (scm_source_property, "source-property", 2, 0, 0, SCM_VALIDATE_NIM (1, obj); if (SCM_MEMOIZEDP (obj)) obj = SCM_MEMOIZED_EXP (obj); - else if (!SCM_CONSP (obj)) + else if (!scm_is_pair (obj)) SCM_WRONG_TYPE_ARG (1, obj); p = scm_hashq_ref (scm_source_whash, obj, SCM_EOL); if (!SRCPROPSP (p)) @@ -229,7 +229,7 @@ SCM_DEFINE (scm_set_source_property_x, "set-source-property!", 3, 0, 0, SCM_VALIDATE_NIM (1, obj); if (SCM_MEMOIZEDP (obj)) obj = SCM_MEMOIZED_EXP (obj); - else if (!SCM_CONSP (obj)) + else if (!scm_is_pair (obj)) SCM_WRONG_TYPE_ARG (1, obj); h = scm_whash_get_handle (scm_source_whash, obj); if (SCM_WHASHFOUNDP (h)) diff --git a/libguile/srfi-13.c b/libguile/srfi-13.c index e31a80349..169bbc94b 100644 --- a/libguile/srfi-13.c +++ b/libguile/srfi-13.c @@ -291,7 +291,7 @@ SCM_DEFINE (scm_reverse_list_to_string, "reverse-list->string", 1, 0, 0, { data += i; - while (i > 0 && SCM_CONSP (chrs)) + while (i > 0 && scm_is_pair (chrs)) { SCM elt = SCM_CAR (chrs); @@ -391,7 +391,7 @@ SCM_DEFINE (scm_string_join, "string-join", 1, 2, 0, switch (gram) { case GRAM_INFIX: - if (!SCM_NULLP (ls)) + if (!scm_is_null (ls)) len = (strings > 0) ? ((strings - 1) * del_len) : 0; break; case GRAM_STRICT_INFIX: @@ -406,7 +406,7 @@ SCM_DEFINE (scm_string_join, "string-join", 1, 2, 0, } tmp = ls; - while (SCM_CONSP (tmp)) + while (scm_is_pair (tmp)) { len += scm_c_string_length (SCM_CAR (tmp)); tmp = SCM_CDR (tmp); @@ -419,16 +419,16 @@ SCM_DEFINE (scm_string_join, "string-join", 1, 2, 0, { case GRAM_INFIX: case GRAM_STRICT_INFIX: - while (SCM_CONSP (tmp)) + while (scm_is_pair (tmp)) { append_string (&p, &len, SCM_CAR (tmp)); - if (!SCM_NULLP (SCM_CDR (tmp)) && del_len > 0) + if (!scm_is_null (SCM_CDR (tmp)) && del_len > 0) append_string (&p, &len, delimiter); tmp = SCM_CDR (tmp); } break; case GRAM_SUFFIX: - while (SCM_CONSP (tmp)) + while (scm_is_pair (tmp)) { append_string (&p, &len, SCM_CAR (tmp)); if (del_len > 0) @@ -437,7 +437,7 @@ SCM_DEFINE (scm_string_join, "string-join", 1, 2, 0, } break; case GRAM_PREFIX: - while (SCM_CONSP (tmp)) + while (scm_is_pair (tmp)) { if (del_len > 0) append_string (&p, &len, delimiter); diff --git a/libguile/srfi-14.c b/libguile/srfi-14.c index c2a6a9a0c..eaf9e07f1 100644 --- a/libguile/srfi-14.c +++ b/libguile/srfi-14.c @@ -100,7 +100,7 @@ SCM_DEFINE (scm_char_set_eq, "char-set=", 0, 0, 1, SCM_VALIDATE_REST_ARGUMENT (char_sets); - while (!SCM_NULLP (char_sets)) + while (!scm_is_null (char_sets)) { SCM csi = SCM_CAR (char_sets); long *csi_data; @@ -130,7 +130,7 @@ SCM_DEFINE (scm_char_set_leq, "char-set<=", 0, 0, 1, SCM_VALIDATE_REST_ARGUMENT (char_sets); - while (!SCM_NULLP (char_sets)) + while (!scm_is_null (char_sets)) { SCM csi = SCM_CAR (char_sets); long *csi_data; @@ -441,7 +441,7 @@ SCM_DEFINE (scm_char_set, "char-set", 0, 0, 1, SCM_VALIDATE_REST_ARGUMENT (rest); cs = make_char_set (FUNC_NAME); p = (long *) SCM_SMOB_DATA (cs); - while (!SCM_NULLP (rest)) + while (!scm_is_null (rest)) { int c; @@ -474,7 +474,7 @@ SCM_DEFINE (scm_list_to_char_set, "list->char-set", 1, 1, 0, cs = scm_char_set_copy (base_cs); } p = (long *) SCM_SMOB_DATA (cs); - while (!SCM_NULLP (list)) + while (!scm_is_null (list)) { SCM chr = SCM_CAR (list); int c; @@ -501,7 +501,7 @@ SCM_DEFINE (scm_list_to_char_set_x, "list->char-set!", 2, 0, 0, SCM_VALIDATE_LIST (1, list); SCM_VALIDATE_SMOB (2, base_cs, charset); p = (long *) SCM_SMOB_DATA (base_cs); - while (!SCM_NULLP (list)) + while (!scm_is_null (list)) { SCM chr = SCM_CAR (list); int c; @@ -908,7 +908,7 @@ SCM_DEFINE (scm_char_set_adjoin, "char-set-adjoin", 1, 0, 1, cs = scm_char_set_copy (cs); p = (long *) SCM_SMOB_DATA (cs); - while (!SCM_NULLP (rest)) + while (!scm_is_null (rest)) { SCM chr = SCM_CAR (rest); int c; @@ -936,7 +936,7 @@ SCM_DEFINE (scm_char_set_delete, "char-set-delete", 1, 0, 1, cs = scm_char_set_copy (cs); p = (long *) SCM_SMOB_DATA (cs); - while (!SCM_NULLP (rest)) + while (!scm_is_null (rest)) { SCM chr = SCM_CAR (rest); int c; @@ -963,7 +963,7 @@ SCM_DEFINE (scm_char_set_adjoin_x, "char-set-adjoin!", 1, 0, 1, SCM_VALIDATE_REST_ARGUMENT (rest); p = (long *) SCM_SMOB_DATA (cs); - while (!SCM_NULLP (rest)) + while (!scm_is_null (rest)) { SCM chr = SCM_CAR (rest); int c; @@ -990,7 +990,7 @@ SCM_DEFINE (scm_char_set_delete_x, "char-set-delete!", 1, 0, 1, SCM_VALIDATE_REST_ARGUMENT (rest); p = (long *) SCM_SMOB_DATA (cs); - while (!SCM_NULLP (rest)) + while (!scm_is_null (rest)) { SCM chr = SCM_CAR (rest); int c; @@ -1039,7 +1039,7 @@ SCM_DEFINE (scm_char_set_union, "char-set-union", 0, 0, 1, res = make_char_set (FUNC_NAME); p = (long *) SCM_SMOB_DATA (res); - while (!SCM_NULLP (rest)) + while (!scm_is_null (rest)) { int k; SCM cs = SCM_CAR (rest); @@ -1064,7 +1064,7 @@ SCM_DEFINE (scm_char_set_intersection, "char-set-intersection", 0, 0, 1, SCM_VALIDATE_REST_ARGUMENT (rest); - if (SCM_NULLP (rest)) + if (scm_is_null (rest)) res = make_char_set (FUNC_NAME); else { @@ -1075,7 +1075,7 @@ SCM_DEFINE (scm_char_set_intersection, "char-set-intersection", 0, 0, 1, p = (long *) SCM_SMOB_DATA (res); rest = SCM_CDR (rest); - while (SCM_CONSP (rest)) + while (scm_is_pair (rest)) { int k; SCM cs = SCM_CAR (rest); @@ -1109,7 +1109,7 @@ SCM_DEFINE (scm_char_set_difference, "char-set-difference", 1, 0, 1, res = scm_char_set_copy (cs1); p = (long *) SCM_SMOB_DATA (res); - while (!SCM_NULLP (rest)) + while (!scm_is_null (rest)) { int k; SCM cs = SCM_CAR (rest); @@ -1134,7 +1134,7 @@ SCM_DEFINE (scm_char_set_xor, "char-set-xor", 0, 0, 1, SCM_VALIDATE_REST_ARGUMENT (rest); - if (SCM_NULLP (rest)) + if (scm_is_null (rest)) res = make_char_set (FUNC_NAME); else { @@ -1145,7 +1145,7 @@ SCM_DEFINE (scm_char_set_xor, "char-set-xor", 0, 0, 1, p = (long *) SCM_SMOB_DATA (res); rest = SCM_CDR (rest); - while (SCM_CONSP (rest)) + while (scm_is_pair (rest)) { SCM cs = SCM_CAR (rest); long *cs_data; @@ -1182,7 +1182,7 @@ SCM_DEFINE (scm_char_set_diff_plus_intersection, "char-set-diff+intersection", 1 res2 = make_char_set (FUNC_NAME); p = (long *) SCM_SMOB_DATA (res1); q = (long *) SCM_SMOB_DATA (res2); - while (!SCM_NULLP (rest)) + while (!scm_is_null (rest)) { int k; SCM cs = SCM_CAR (rest); @@ -1233,7 +1233,7 @@ SCM_DEFINE (scm_char_set_union_x, "char-set-union!", 1, 0, 1, SCM_VALIDATE_REST_ARGUMENT (rest); p = (long *) SCM_SMOB_DATA (cs1); - while (!SCM_NULLP (rest)) + while (!scm_is_null (rest)) { int k; SCM cs = SCM_CAR (rest); @@ -1261,7 +1261,7 @@ SCM_DEFINE (scm_char_set_intersection_x, "char-set-intersection!", 1, 0, 1, SCM_VALIDATE_REST_ARGUMENT (rest); p = (long *) SCM_SMOB_DATA (cs1); - while (!SCM_NULLP (rest)) + while (!scm_is_null (rest)) { int k; SCM cs = SCM_CAR (rest); @@ -1289,7 +1289,7 @@ SCM_DEFINE (scm_char_set_difference_x, "char-set-difference!", 1, 0, 1, SCM_VALIDATE_REST_ARGUMENT (rest); p = (long *) SCM_SMOB_DATA (cs1); - while (!SCM_NULLP (rest)) + while (!scm_is_null (rest)) { int k; SCM cs = SCM_CAR (rest); @@ -1326,7 +1326,7 @@ SCM_DEFINE (scm_char_set_xor_x, "char-set-xor!", 1, 0, 1, SCM_VALIDATE_REST_ARGUMENT (rest); p = (long *) SCM_SMOB_DATA (cs1); - while (!SCM_NULLP (rest)) + while (!scm_is_null (rest)) { int k; SCM cs = SCM_CAR (rest); @@ -1373,7 +1373,7 @@ SCM_DEFINE (scm_char_set_diff_plus_intersection_x, "char-set-diff+intersection!" p[k] &= ~q[k]; q[k] = t & q[k]; } - while (!SCM_NULLP (rest)) + while (!scm_is_null (rest)) { SCM cs = SCM_CAR (rest); long *r; diff --git a/libguile/stacks.c b/libguile/stacks.c index c6c316fad..d23d1fdf8 100644 --- a/libguile/stacks.c +++ b/libguile/stacks.c @@ -468,11 +468,11 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1, /* Narrow the stack according to the arguments given to scm_make_stack. */ SCM_VALIDATE_REST_ARGUMENT (args); - while (n > 0 && !SCM_NULLP (args)) + while (n > 0 && !scm_is_null (args)) { inner_cut = SCM_CAR (args); args = SCM_CDR (args); - if (SCM_NULLP (args)) + if (scm_is_null (args)) { outer_cut = SCM_INUM0; } diff --git a/libguile/stacks.h b/libguile/stacks.h index 568587c4c..b6270eaca 100644 --- a/libguile/stacks.h +++ b/libguile/stacks.h @@ -3,7 +3,7 @@ #ifndef SCM_STACKS_H #define SCM_STACKS_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 @@ -52,7 +52,7 @@ SCM_API SCM scm_stack_type; #define SCM_STACK_LENGTH(stack) (SCM_STACK (stack) -> length) #define SCM_FRAMEP(obj) \ - (SCM_CONSP (obj) && SCM_STACKP (SCM_CAR (obj)) \ + (scm_is_pair (obj) && SCM_STACKP (SCM_CAR (obj)) \ && scm_is_unsigned_integer (SCM_CDR (obj), \ 0, SCM_STACK_LENGTH (SCM_CAR (obj))-1)) diff --git a/libguile/strings.c b/libguile/strings.c index b819bd24f..6a69124ad 100644 --- a/libguile/strings.c +++ b/libguile/strings.c @@ -552,7 +552,7 @@ SCM_DEFINE (scm_string, "string", 0, 0, 1, } result = scm_i_make_string (len, &data); - while (len > 0 && SCM_CONSP (chrs)) + while (len > 0 && scm_is_pair (chrs)) { SCM elt = SCM_CAR (chrs); @@ -563,7 +563,7 @@ SCM_DEFINE (scm_string, "string", 0, 0, 1, } if (len > 0) scm_misc_error (NULL, "list changed while constructing string", SCM_EOL); - if (!SCM_NULLP (chrs)) + if (!scm_is_null (chrs)) scm_wrong_type_arg_msg (NULL, 0, chrs, "proper list"); return result; @@ -780,14 +780,14 @@ SCM_DEFINE (scm_string_append, "string-append", 0, 0, 1, char *data; SCM_VALIDATE_REST_ARGUMENT (args); - for (l = args; !SCM_NULLP (l); l = SCM_CDR (l)) + for (l = args; !scm_is_null (l); l = SCM_CDR (l)) { s = SCM_CAR (l); SCM_VALIDATE_STRING (SCM_ARGn, s); i += scm_i_string_length (s); } res = scm_i_make_string (i, &data); - for (l = args; !SCM_NULLP (l); l = SCM_CDR (l)) + for (l = args; !scm_is_null (l); l = SCM_CDR (l)) { size_t len; s = SCM_CAR (l); @@ -941,7 +941,7 @@ scm_i_allocate_string_pointers (SCM list) /* The list might be have been modified in another thread, so we check LIST before each access. */ - for (i = 0; i < len && SCM_CONSP (list); i++) + for (i = 0; i < len && scm_is_pair (list); i++) { result[i] = scm_to_locale_string (SCM_CAR (list)); list = SCM_CDR (list); diff --git a/libguile/struct.c b/libguile/struct.c index 8be254e73..16bea0157 100644 --- a/libguile/struct.c +++ b/libguile/struct.c @@ -172,7 +172,7 @@ scm_struct_init (SCM handle, SCM layout, scm_t_bits * mem, int tail_elts, SCM in #endif case 'u': - if ((prot != 'r' && prot != 'w') || SCM_NULLP (inits)) + if ((prot != 'r' && prot != 'w') || scm_is_null (inits)) *mem = 0; else { @@ -182,7 +182,7 @@ scm_struct_init (SCM handle, SCM layout, scm_t_bits * mem, int tail_elts, SCM in break; case 'p': - if ((prot != 'r' && prot != 'w') || SCM_NULLP (inits)) + if ((prot != 'r' && prot != 'w') || scm_is_null (inits)) *mem = SCM_UNPACK (SCM_BOOL_F); else { @@ -357,7 +357,7 @@ scm_free_structs (void *dummy1 SCM_UNUSED, { /* Mark vtables in GC chain. GC mark set means delay freeing. */ SCM chain = newchain; - while (!SCM_NULLP (chain)) + while (!scm_is_null (chain)) { SCM vtable = SCM_STRUCT_VTABLE (chain); if (SCM_STRUCT_GC_CHAIN (vtable) != 0 && vtable != chain) @@ -367,7 +367,7 @@ scm_free_structs (void *dummy1 SCM_UNUSED, /* Free unmarked structs. */ chain = newchain; newchain = SCM_EOL; - while (!SCM_NULLP (chain)) + while (!scm_is_null (chain)) { SCM obj = chain; chain = SCM_STRUCT_GC_CHAIN (chain); @@ -390,7 +390,7 @@ scm_free_structs (void *dummy1 SCM_UNUSED, } } } - while (!SCM_NULLP (newchain)); + while (!scm_is_null (newchain)); return 0; } diff --git a/libguile/symbols.c b/libguile/symbols.c index e8171eb3a..b265e5ce4 100644 --- a/libguile/symbols.c +++ b/libguile/symbols.c @@ -99,7 +99,7 @@ scm_i_mem2symbol (SCM str) SCM l; for (l = SCM_HASHTABLE_BUCKETS (symbols) [hash]; - !SCM_NULLP (l); + !scm_is_null (l); l = SCM_CDR (l)) { SCM sym = SCM_CAAR (l); diff --git a/libguile/threads.c b/libguile/threads.c index 6a7845784..297fce5cc 100644 --- a/libguile/threads.c +++ b/libguile/threads.c @@ -54,7 +54,7 @@ static SCM enqueue (SCM q, SCM t) { SCM c = scm_cons (t, SCM_EOL); - if (SCM_NULLP (SCM_CDR (q))) + if (scm_is_null (SCM_CDR (q))) SCM_SETCDR (q, c); else SCM_SETCDR (SCM_CAR (q), c); @@ -66,7 +66,7 @@ static void remqueue (SCM q, SCM c) { SCM p, prev = q; - for (p = SCM_CDR (q); !SCM_NULLP (p); p = SCM_CDR (p)) + for (p = SCM_CDR (q); !scm_is_null (p); p = SCM_CDR (p)) { if (scm_is_eq (p, c)) { @@ -84,12 +84,12 @@ static SCM dequeue (SCM q) { SCM c = SCM_CDR (q); - if (SCM_NULLP (c)) + if (scm_is_null (c)) return SCM_BOOL_F; else { SCM_SETCDR (q, SCM_CDR (c)); - if (SCM_NULLP (SCM_CDR (q))) + if (scm_is_null (SCM_CDR (q))) SCM_SETCAR (q, SCM_EOL); return SCM_CAR (c); } @@ -841,7 +841,7 @@ SCM_DEFINE (scm_timed_wait_condition_variable, "wait-condition-variable", 2, 1, if (!SCM_UNBNDP (t)) { - if (SCM_CONSP (t)) + if (scm_is_pair (t)) { SCM_VALIDATE_UINT_COPY (3, SCM_CAR (t), waittime.tv_sec); SCM_VALIDATE_UINT_COPY (3, SCM_CDR (t), waittime.tv_nsec); @@ -938,7 +938,7 @@ scm_threads_mark_stacks (void) { volatile SCM c; - for (c = all_threads; !SCM_NULLP (c); c = SCM_CDR (c)) + for (c = all_threads; !scm_is_null (c); c = SCM_CDR (c)) { scm_thread *t = SCM_THREAD_DATA (SCM_CAR (c)); if (!THREAD_INITIALIZED_P (t)) @@ -1164,7 +1164,7 @@ scm_i_thread_put_to_sleep () threads = all_threads; /* Signal all threads to go to sleep */ scm_i_thread_go_to_sleep = 1; - for (; !SCM_NULLP (threads); threads = SCM_CDR (threads)) + for (; !scm_is_null (threads); threads = SCM_CDR (threads)) { scm_thread *t = SCM_THREAD_DATA (SCM_CAR (threads)); scm_i_plugin_mutex_lock (&t->heap_mutex); @@ -1178,7 +1178,7 @@ scm_i_thread_invalidate_freelists () { /* Don't need to lock thread_admin_mutex here since we are single threaded */ SCM threads = all_threads; - for (; !SCM_NULLP (threads); threads = SCM_CDR (threads)) + for (; !scm_is_null (threads); threads = SCM_CDR (threads)) if (SCM_CAR (threads) != cur_thread) { scm_thread *t = SCM_THREAD_DATA (SCM_CAR (threads)); @@ -1194,7 +1194,7 @@ scm_i_thread_wake_up () SCM threads; threads = all_threads; scm_i_plugin_cond_broadcast (&wake_up_cond); - for (; !SCM_NULLP (threads); threads = SCM_CDR (threads)) + for (; !scm_is_null (threads); threads = SCM_CDR (threads)) { scm_thread *t = SCM_THREAD_DATA (SCM_CAR (threads)); scm_i_plugin_mutex_unlock (&t->heap_mutex); diff --git a/libguile/throw.c b/libguile/throw.c index 8c8380c3c..6b8447fb6 100644 --- a/libguile/throw.c +++ b/libguile/throw.c @@ -577,10 +577,10 @@ scm_ithrow (SCM key, SCM args, int noreturn SCM_UNUSED) /* Search the wind list for an appropriate catch. "Waiter, please bring us the wind list." */ - for (winds = scm_dynwinds; SCM_CONSP (winds); winds = SCM_CDR (winds)) + for (winds = scm_dynwinds; scm_is_pair (winds); winds = SCM_CDR (winds)) { dynpair = SCM_CAR (winds); - if (SCM_CONSP (dynpair)) + if (scm_is_pair (dynpair)) { SCM this_key = SCM_CAR (dynpair); @@ -592,14 +592,14 @@ scm_ithrow (SCM key, SCM args, int noreturn SCM_UNUSED) /* If we didn't find anything, print a message and abort the process right here. If you don't want this, establish a catch-all around any code that might throw up. */ - if (SCM_NULLP (winds)) + if (scm_is_null (winds)) { scm_handle_by_message (NULL, key, args); abort (); } /* If the wind list is malformed, bail. */ - if (!SCM_CONSP (winds)) + if (!scm_is_pair (winds)) abort (); jmpbuf = SCM_CDR (dynpair); diff --git a/libguile/unif.c b/libguile/unif.c index 8c4d55089..8dd5b3389 100644 --- a/libguile/unif.c +++ b/libguile/unif.c @@ -310,7 +310,7 @@ SCM_DEFINE (scm_array_p, "array?", 1, 1, 0, break; case scm_tc7_vector: case scm_tc7_wvect: - protp = SCM_NULLP(prot); + protp = scm_is_null(prot); break; default: /* no default */ @@ -466,7 +466,7 @@ scm_aind (SCM ra, SCM args, const char *what) scm_error_num_args_subr (what); return pos + (scm_to_long (args) - s->lbnd) * (s->inc); } - while (k && SCM_CONSP (args)) + while (k && scm_is_pair (args)) { ind = SCM_CAR (args); args = SCM_CDR (args); @@ -479,7 +479,7 @@ scm_aind (SCM ra, SCM args, const char *what) k--; s++; } - if (k != 0 || !SCM_NULLP (args)) + if (k != 0 || !scm_is_null (args)) scm_error_num_args_subr (what); return pos; @@ -517,7 +517,7 @@ scm_shap2ra (SCM args, const char *what) ra = scm_make_ra (ndim); SCM_ARRAY_BASE (ra) = 0; s = SCM_ARRAY_DIMS (ra); - for (; !SCM_NULLP (args); s++, args = SCM_CDR (args)) + for (; !scm_is_null (args); s++, args = SCM_CDR (args)) { spec = SCM_CAR (args); if (scm_is_integer (spec)) @@ -530,13 +530,13 @@ scm_shap2ra (SCM args, const char *what) } else { - if (!SCM_CONSP (spec) || !scm_is_integer (SCM_CAR (spec))) + if (!scm_is_pair (spec) || !scm_is_integer (SCM_CAR (spec))) scm_misc_error (what, s_bad_spec, SCM_EOL); s->lbnd = scm_to_long (SCM_CAR (spec)); sp = SCM_CDR (spec); - if (!SCM_CONSP (sp) + if (!scm_is_pair (sp) || !scm_is_integer (SCM_CAR (sp)) - || !SCM_NULLP (SCM_CDR (sp))) + || !scm_is_null (SCM_CDR (sp))) scm_misc_error (what, s_bad_spec, SCM_EOL); s->ubnd = scm_to_long (SCM_CAR (sp)); s->inc = 1; @@ -571,7 +571,7 @@ SCM_DEFINE (scm_dimensions_to_uniform_array, "dimensions->uniform-array", 2, 1, return answer; } - SCM_ASSERT (SCM_NULLP (dims) || SCM_CONSP (dims), + SCM_ASSERT (scm_is_null (dims) || scm_is_pair (dims), dims, SCM_ARG1, FUNC_NAME); ra = scm_shap2ra (dims, FUNC_NAME); SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra); @@ -797,7 +797,7 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1, #if SCM_SIZEOF_LONG_LONG != 0 case scm_tc7_llvect: #endif - if (SCM_NULLP (args) || !SCM_NULLP (SCM_CDR (args))) + if (scm_is_null (args) || !scm_is_null (SCM_CDR (args))) SCM_WRONG_NUM_ARGS (); SCM_VALIDATE_INT_COPY (SCM_ARG2, SCM_CAR (args), i); SCM_ASSERT_RANGE (SCM_ARG2, SCM_CAR (args), i == 0); @@ -885,7 +885,7 @@ SCM_DEFINE (scm_enclose_array, "enclose-array", 1, 0, 1, int ndim, j, k, ninr, noutr; SCM_VALIDATE_REST_ARGUMENT (axes); - if (SCM_NULLP (axes)) + if (scm_is_null (axes)) axes = scm_cons ((SCM_ARRAYP (ra) ? scm_from_size_t (SCM_ARRAY_NDIM (ra) - 1) : SCM_INUM0), SCM_EOL); ninr = scm_ilength (axes); if (ninr < 0) @@ -993,7 +993,7 @@ tail: pos = SCM_ARRAY_BASE (v); if (!k) { - SCM_ASRTGO (SCM_NULLP (ind), wna); + SCM_ASRTGO (scm_is_null (ind), wna); ind = SCM_INUM0; } else @@ -1033,7 +1033,7 @@ tail: case scm_tc7_wvect: { unsigned long length = scm_to_ulong (scm_uniform_vector_length (v)); - SCM_ASRTGO (SCM_NULLP (args) && scm_is_integer (ind), wna); + SCM_ASRTGO (scm_is_null (args) && scm_is_integer (ind), wna); return scm_from_bool(pos >= 0 && pos < length); } } @@ -1055,7 +1055,7 @@ SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0, if (SCM_IMP (v)) { - SCM_ASRTGO (SCM_NULLP (args), badarg); + SCM_ASRTGO (scm_is_null (args), badarg); return v; } else if (SCM_ARRAYP (v)) @@ -1068,9 +1068,9 @@ SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0, unsigned long int length; if (SCM_NIMP (args)) { - SCM_ASSERT (SCM_CONSP (args), args, SCM_ARG2, FUNC_NAME); + SCM_ASSERT (scm_is_pair (args), args, SCM_ARG2, FUNC_NAME); pos = scm_to_long (SCM_CAR (args)); - SCM_ASRTGO (SCM_NULLP (SCM_CDR (args)), wna); + SCM_ASRTGO (scm_is_null (SCM_CDR (args)), wna); } else { @@ -1082,7 +1082,7 @@ SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0, switch SCM_TYP7 (v) { default: - if (SCM_NULLP (args)) + if (scm_is_null (args)) return v; badarg: SCM_WRONG_TYPE_ARG (1, v); @@ -1239,9 +1239,9 @@ SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1, else { unsigned long int length; - if (SCM_CONSP (args)) + if (scm_is_pair (args)) { - SCM_ASRTGO (SCM_NULLP (SCM_CDR (args)), wna); + SCM_ASRTGO (scm_is_null (SCM_CDR (args)), wna); pos = scm_to_long (SCM_CAR (args)); } else @@ -2221,7 +2221,7 @@ SCM_DEFINE (scm_list_to_uniform_array, "list->uniform-array", 3, 0, 0, } ra = scm_dimensions_to_uniform_array (scm_reverse (shp), prot, SCM_UNDEFINED); - if (SCM_NULLP (shp)) + if (scm_is_null (shp)) { SCM_ASRTGO (1 == scm_ilength (lst), badlst); scm_array_set_x (ra, SCM_CAR (lst), SCM_EOL); @@ -2249,31 +2249,31 @@ l2ra (SCM lst, SCM ra, unsigned long base, unsigned long k) register long n = (1 + SCM_ARRAY_DIMS (ra)[k].ubnd - SCM_ARRAY_DIMS (ra)[k].lbnd); int ok = 1; if (n <= 0) - return (SCM_NULLP (lst)); + return (scm_is_null (lst)); if (k < SCM_ARRAY_NDIM (ra) - 1) { while (n--) { - if (!SCM_CONSP (lst)) + if (!scm_is_pair (lst)) return 0; ok = ok && l2ra (SCM_CAR (lst), ra, base, k + 1); base += inc; lst = SCM_CDR (lst); } - if (!SCM_NULLP (lst)) + if (!scm_is_null (lst)) return 0; } else { while (n--) { - if (!SCM_CONSP (lst)) + if (!scm_is_pair (lst)) return 0; scm_array_set_x (SCM_ARRAY_V (ra), SCM_CAR (lst), scm_from_ulong (base)); base += inc; lst = SCM_CDR (lst); } - if (!SCM_NULLP (lst)) + if (!scm_is_null (lst)) return 0; } return ok; diff --git a/libguile/validate.h b/libguile/validate.h index 5fd016dcb..531a487cf 100644 --- a/libguile/validate.h +++ b/libguile/validate.h @@ -115,11 +115,15 @@ SCM_ASSERT_TYPE (SCM_ ## pred (var), var, pos, FUNC_NAME, #pred); \ } while (0) -#define SCM_MAKE_VALIDATE_MSG(pos, var, pred, msg) \ +#define SCM_I_MAKE_VALIDATE_MSG2(pos, var, pred, msg) \ do { \ - SCM_ASSERT_TYPE (SCM_ ## pred (var), var, pos, FUNC_NAME, msg); \ + SCM_ASSERT_TYPE (pred (var), var, pos, FUNC_NAME, msg); \ } while (0) +#define SCM_MAKE_VALIDATE_MSG(pos, var, pred, msg) \ + SCM_I_MAKE_VALIDATE_MSG2 (pos, var, SCM_ ## pred, msg) + + #define SCM_VALIDATE_REST_ARGUMENT(x) \ @@ -214,11 +218,14 @@ } \ } while (0) -#define SCM_VALIDATE_NULL(pos, scm) SCM_MAKE_VALIDATE_MSG (pos, scm, NULLP, "null") +#define SCM_VALIDATE_NULL(pos, scm) \ + SCM_I_MAKE_VALIDATE_MSG2 (pos, scm, scm_is_null, "empty list") -#define SCM_VALIDATE_NULL_OR_NIL(pos, scm) SCM_MAKE_VALIDATE_MSG (pos, scm, NULL_OR_NIL_P, "null") +#define SCM_VALIDATE_NULL_OR_NIL(pos, scm) \ + SCM_MAKE_VALIDATE_MSG (pos, scm, NULL_OR_NIL_P, "empty list") -#define SCM_VALIDATE_CONS(pos, scm) SCM_MAKE_VALIDATE_MSG (pos, scm, CONSP, "pair") +#define SCM_VALIDATE_CONS(pos, scm) \ + SCM_I_MAKE_VALIDATE_MSG2 (pos, scm, scm_is_pair, "pair") #define SCM_VALIDATE_LIST(pos, lst) \ do { \ @@ -244,15 +251,15 @@ #define SCM_VALIDATE_ALISTCELL(pos, alist) \ do { \ - SCM_ASSERT (SCM_CONSP (alist) && SCM_CONSP (SCM_CAR (alist)), \ + SCM_ASSERT (scm_is_pair (alist) && scm_is_pair (SCM_CAR (alist)), \ alist, pos, FUNC_NAME); \ } while (0) #define SCM_VALIDATE_ALISTCELL_COPYSCM(pos, alist, cvar) \ do { \ - SCM_ASSERT (SCM_CONSP (alist), alist, pos, FUNC_NAME); \ + SCM_ASSERT (scm_is_pair (alist), alist, pos, FUNC_NAME); \ cvar = SCM_CAR (alist); \ - SCM_ASSERT (SCM_CONSP (cvar), alist, pos, FUNC_NAME); \ + SCM_ASSERT (scm_is_pair (cvar), alist, pos, FUNC_NAME); \ } while (0) #define SCM_VALIDATE_OPORT_VALUE(pos, port) \ @@ -291,7 +298,7 @@ #define SCM_VALIDATE_NULLORCONS(pos, env) \ do { \ - SCM_ASSERT (SCM_NULLP (env) || SCM_CONSP (env), env, pos, FUNC_NAME); \ + SCM_ASSERT (scm_is_null (env) || scm_is_pair (env), env, pos, FUNC_NAME); \ } while (0) #define SCM_VALIDATE_HOOK(pos, a) SCM_MAKE_VALIDATE_MSG (pos, a, HOOKP, "hook") diff --git a/libguile/weaks.c b/libguile/weaks.c index 2b0eba6eb..250a4cf7d 100644 --- a/libguile/weaks.c +++ b/libguile/weaks.c @@ -264,7 +264,7 @@ scm_mark_weak_vector_spines (void *dummy1 SCM_UNUSED, { SCM w; - for (w = scm_weak_vectors; !SCM_NULLP (w); w = SCM_WVECT_GC_CHAIN (w)) + for (w = scm_weak_vectors; !scm_is_null (w); w = SCM_WVECT_GC_CHAIN (w)) { if (SCM_IS_WHVEC_ANY (w)) { @@ -281,9 +281,9 @@ scm_mark_weak_vector_spines (void *dummy1 SCM_UNUSED, SCM alist; alist = ptr[j]; - while ( SCM_CONSP (alist) + while ( scm_is_pair (alist) && !SCM_GC_MARK_P (alist) - && SCM_CONSP (SCM_CAR (alist))) + && scm_is_pair (SCM_CAR (alist))) { SCM_SET_GC_MARK (alist); SCM_SET_GC_MARK (SCM_CAR (alist)); @@ -304,7 +304,7 @@ scm_scan_weak_vectors (void *dummy1 SCM_UNUSED, void *dummy3 SCM_UNUSED) { SCM *ptr, w; - for (w = scm_weak_vectors; !SCM_NULLP (w); w = SCM_WVECT_GC_CHAIN (w)) + for (w = scm_weak_vectors; !scm_is_null (w); w = SCM_WVECT_GC_CHAIN (w)) { if (!SCM_IS_WHVEC_ANY (w)) { @@ -336,8 +336,8 @@ scm_scan_weak_vectors (void *dummy1 SCM_UNUSED, fixup = ptr + j; alist = *fixup; - while (SCM_CONSP (alist) - && SCM_CONSP (SCM_CAR (alist))) + while (scm_is_pair (alist) + && scm_is_pair (SCM_CAR (alist))) { SCM key; SCM value; |