mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 11:50:28 +02:00
Code Activity

* coop-threads.c: Remove K&R function headers.

Browse source 
* scm_validate.h: Added SCM_VALIDATE_THREAD.

* *.c: Remove SCM_NIMP(X) when it is an extraneous pre-test given
that SCM_FOOP macros all now include SCM_NIMP in their expansion.
This simplifies lots of code, making it far more readable.
This commit is contained in:
Greg J. Badros 1999-12-16 20:48:05 +00:00
parent 9c24ff3e6c
commit 0c95b57d77
50 changed files with 324 additions and 384 deletions
Download patch file Download diff file Expand all files Collapse all files

28
libguile/alist.c
View file

@ -82,10 +82,10 @@ Recommended only for use in Guile internals.")
#define FUNC_NAME s_scm_sloppy_assq #define FUNC_NAME s_scm_sloppy_assq
{ {
for (; SCM_NIMP (alist) && SCM_CONSP (alist); alist = SCM_CDR (alist)) for (; SCM_CONSP (alist); alist = SCM_CDR (alist))
{ {
SCM tmp = SCM_CAR(alist); SCM tmp = SCM_CAR(alist);
if (SCM_NIMP (tmp) && SCM_CONSP (tmp) && (SCM_CAR (tmp)==x)) if (SCM_CONSP (tmp) && (SCM_CAR (tmp)==x))
return tmp; return tmp;
} }
return SCM_BOOL_F; return SCM_BOOL_F;
@ -100,7 +100,7 @@ GUILE_PROC (scm_sloppy_assv, "sloppy-assv", 2, 0, 0,
Recommended only for use in Guile internals.") Recommended only for use in Guile internals.")
#define FUNC_NAME s_scm_sloppy_assv #define FUNC_NAME s_scm_sloppy_assv
{ {
for (; SCM_NIMP (alist) && SCM_CONSP (alist); alist = SCM_CDR (alist)) for (; SCM_CONSP (alist); alist = SCM_CDR (alist))
{ {
SCM tmp = SCM_CAR(alist); SCM tmp = SCM_CAR(alist);
if (SCM_NIMP (tmp) if (SCM_NIMP (tmp)
@ -119,7 +119,7 @@ GUILE_PROC (scm_sloppy_assoc, "sloppy-assoc", 2, 0, 0,
Recommended only for use in Guile internals.") Recommended only for use in Guile internals.")
#define FUNC_NAME s_scm_sloppy_assoc #define FUNC_NAME s_scm_sloppy_assoc
{ {
for (; SCM_NIMP (alist) && SCM_CONSP (alist); alist = SCM_CDR (alist)) for (; SCM_CONSP (alist); alist = SCM_CDR (alist))
{ {
SCM tmp = SCM_CAR(alist); SCM tmp = SCM_CAR(alist);
if (SCM_NIMP (tmp) if (SCM_NIMP (tmp)
@ -167,7 +167,7 @@ GUILE_PROC(scm_assv, "assv", 2, 0, 0,
for(;SCM_NIMP(alist);alist = SCM_CDR(alist)) { for(;SCM_NIMP(alist);alist = SCM_CDR(alist)) {
SCM_ASRTGO(SCM_CONSP(alist), badlst); SCM_ASRTGO(SCM_CONSP(alist), badlst);
tmp = SCM_CAR(alist); tmp = SCM_CAR(alist);
SCM_ASRTGO(SCM_NIMP(tmp) && SCM_CONSP(tmp), badlst); SCM_ASRTGO(SCM_CONSP(tmp), badlst);
if SCM_NFALSEP(scm_eqv_p(SCM_CAR(tmp), x)) return tmp; if SCM_NFALSEP(scm_eqv_p(SCM_CAR(tmp), x)) return tmp;
} }
# ifndef SCM_RECKLESS # ifndef SCM_RECKLESS
@ -216,7 +216,7 @@ where @var{associator} is one of @code{assq}, @code{assv} or @code{assoc}.")
SCM handle; SCM handle;
handle = scm_sloppy_assq (key, alist); handle = scm_sloppy_assq (key, alist);
if (SCM_NIMP (handle) && SCM_CONSP (handle)) if (SCM_CONSP (handle))
{ {
return SCM_CDR (handle); return SCM_CDR (handle);
} }
@ -233,7 +233,7 @@ GUILE_PROC (scm_assv_ref, "assv-ref", 2, 0, 0,
SCM handle; SCM handle;
handle = scm_sloppy_assv (key, alist); handle = scm_sloppy_assv (key, alist);
if (SCM_NIMP (handle) && SCM_CONSP (handle)) if (SCM_CONSP (handle))
{ {
return SCM_CDR (handle); return SCM_CDR (handle);
} }
@ -250,7 +250,7 @@ GUILE_PROC (scm_assoc_ref, "assoc-ref", 2, 0, 0,
SCM handle; SCM handle;
handle = scm_sloppy_assoc (key, alist); handle = scm_sloppy_assoc (key, alist);
if (SCM_NIMP (handle) && SCM_CONSP (handle)) if (SCM_CONSP (handle))
{ {
return SCM_CDR (handle); return SCM_CDR (handle);
} }
@ -280,7 +280,7 @@ association list.")
SCM handle; SCM handle;
handle = scm_sloppy_assq (key, alist); handle = scm_sloppy_assq (key, alist);
if (SCM_NIMP (handle) && SCM_CONSP (handle)) if (SCM_CONSP (handle))
{ {
SCM_SETCDR (handle, val); SCM_SETCDR (handle, val);
return alist; return alist;
@ -298,7 +298,7 @@ GUILE_PROC (scm_assv_set_x, "assv-set!", 3, 0, 0,
SCM handle; SCM handle;
handle = scm_sloppy_assv (key, alist); handle = scm_sloppy_assv (key, alist);
if (SCM_NIMP (handle) && SCM_CONSP (handle)) if (SCM_CONSP (handle))
{ {
SCM_SETCDR (handle, val); SCM_SETCDR (handle, val);
return alist; return alist;
@ -316,7 +316,7 @@ GUILE_PROC (scm_assoc_set_x, "assoc-set!", 3, 0, 0,
SCM handle; SCM handle;
handle = scm_sloppy_assoc (key, alist); handle = scm_sloppy_assoc (key, alist);
if (SCM_NIMP (handle) && SCM_CONSP (handle)) if (SCM_CONSP (handle))
{ {
SCM_SETCDR (handle, val); SCM_SETCDR (handle, val);
return alist; return alist;
@ -340,7 +340,7 @@ the resulting alist.")
SCM handle; SCM handle;
handle = scm_sloppy_assq (key, alist); handle = scm_sloppy_assq (key, alist);
if (SCM_NIMP (handle) && SCM_CONSP (handle)) if (SCM_CONSP (handle))
{ {
return scm_delq_x (handle, alist); return scm_delq_x (handle, alist);
} }
@ -358,7 +358,7 @@ GUILE_PROC (scm_assv_remove_x, "assv-remove!", 2, 0, 0,
SCM handle; SCM handle;
handle = scm_sloppy_assv (key, alist); handle = scm_sloppy_assv (key, alist);
if (SCM_NIMP (handle) && SCM_CONSP (handle)) if (SCM_CONSP (handle))
{ {
return scm_delv_x (handle, alist); return scm_delv_x (handle, alist);
} }
@ -376,7 +376,7 @@ GUILE_PROC (scm_assoc_remove_x, "assoc-remove!", 2, 0, 0,
SCM handle; SCM handle;
handle = scm_sloppy_assoc (key, alist); handle = scm_sloppy_assoc (key, alist);
if (SCM_NIMP (handle) && SCM_CONSP (handle)) if (SCM_CONSP (handle))
{ {
return scm_delete_x (handle, alist); return scm_delete_x (handle, alist);
} }

2
libguile/async.c
View file

@ -348,7 +348,7 @@ GUILE_PROC(scm_run_asyncs, "run-asyncs", 1, 0, 0,
struct scm_async * it; struct scm_async * it;
SCM_VALIDATE_NIMCONS(1,list_of_a); SCM_VALIDATE_NIMCONS(1,list_of_a);
a = SCM_CAR (list_of_a); a = SCM_CAR (list_of_a);
SCM_ASSERT (SCM_NIMP (a) && SCM_ASYNCP (a), a, SCM_ARG1, FUNC_NAME); SCM_ASSERT (SCM_ASYNCP (a), a, SCM_ARG1, FUNC_NAME);
it = SCM_ASYNC (a); it = SCM_ASYNC (a);
scm_mask_ints = 1; scm_mask_ints = 1;
if (it->got_it) if (it->got_it)

36
libguile/backtrace.c
View file

@ -64,6 +64,7 @@
#include "throw.h" #include "throw.h"
#include "fluids.h" #include "fluids.h"
#include "scm_validate.h"
#include "backtrace.h" #include "backtrace.h"
/* {Error reporting and backtraces} /* {Error reporting and backtraces}
@ -84,10 +85,10 @@ SCM scm_the_last_stack_fluid;
static void static void
display_header (SCM source, SCM port) display_header (SCM source, SCM port)
{ {
SCM fname = (SCM_NIMP (source) && SCM_MEMOIZEDP (source) SCM fname = (SCM_MEMOIZEDP (source)
? scm_source_property (source, scm_sym_filename) ? scm_source_property (source, scm_sym_filename)
: SCM_BOOL_F); : SCM_BOOL_F);
if (SCM_NIMP (fname) && SCM_STRINGP (fname)) if (SCM_STRINGP (fname))
{ {
scm_prin1 (fname, port, 0); scm_prin1 (fname, port, 0);
scm_putc (':', port); scm_putc (':', port);
@ -154,7 +155,7 @@ display_expression (SCM frame,SCM pname,SCM source,SCM port)
pstate->fancyp = 1; pstate->fancyp = 1;
pstate->level = 2; pstate->level = 2;
pstate->length = 3; pstate->length = 3;
if (SCM_NIMP (pname) && SCM_ROSTRINGP (pname)) if (SCM_ROSTRINGP (pname))
{ {
if (SCM_NIMP (frame) if (SCM_NIMP (frame)
&& SCM_FRAMEP (frame) && SCM_FRAMEP (frame)
@ -163,7 +164,7 @@ display_expression (SCM frame,SCM pname,SCM source,SCM port)
else else
scm_puts ("In procedure ", port); scm_puts ("In procedure ", port);
scm_iprin1 (pname, port, pstate); scm_iprin1 (pname, port, pstate);
if (SCM_NIMP (source) && SCM_MEMOIZEDP (source)) if (SCM_MEMOIZEDP (source))
{ {
scm_puts (" in expression ", port); scm_puts (" in expression ", port);
pstate->writingp = 1; pstate->writingp = 1;
@ -205,17 +206,16 @@ display_error_body (struct display_error_args *a)
current_frame = scm_stack_ref (a->stack, SCM_INUM0); current_frame = scm_stack_ref (a->stack, SCM_INUM0);
source = SCM_FRAME_SOURCE (current_frame); source = SCM_FRAME_SOURCE (current_frame);
prev_frame = SCM_FRAME_PREV (current_frame); prev_frame = SCM_FRAME_PREV (current_frame);
if (!(SCM_NIMP (source) && SCM_MEMOIZEDP (source)) if (!SCM_MEMOIZEDP (source)
&& prev_frame != SCM_BOOL_F) && prev_frame != SCM_BOOL_F)
source = SCM_FRAME_SOURCE (prev_frame); source = SCM_FRAME_SOURCE (prev_frame);
if (SCM_FRAME_PROC_P (current_frame) if (SCM_FRAME_PROC_P (current_frame)
&& scm_procedure_p (SCM_FRAME_PROC (current_frame)) == SCM_BOOL_T) && scm_procedure_p (SCM_FRAME_PROC (current_frame)) == SCM_BOOL_T)
pname = scm_procedure_name (SCM_FRAME_PROC (current_frame)); pname = scm_procedure_name (SCM_FRAME_PROC (current_frame));
} }
if (!(SCM_NIMP (pname) && SCM_ROSTRINGP (pname))) if (!SCM_ROSTRINGP (pname))
pname = a->subr; pname = a->subr;
if ((SCM_NIMP (pname) && SCM_ROSTRINGP (pname)) if (SCM_ROSTRINGP (pname) || SCM_MEMOIZEDP (source))
|| (SCM_NIMP (source) && SCM_MEMOIZEDP (source)))
{ {
display_header (source, a->port); display_header (source, a->port);
display_expression (current_frame, pname, source, a->port); display_expression (current_frame, pname, source, a->port);
@ -338,7 +338,7 @@ display_frame_expr (char *hdr,SCM exp,char *tlr,int indentation,SCM sport,SCM po
{ {
pstate->length = print_params[i].length; pstate->length = print_params[i].length;
ptob->seek (sport, 0, SEEK_SET); ptob->seek (sport, 0, SEEK_SET);
if (SCM_NIMP (exp) && SCM_CONSP (exp)) if (SCM_CONSP (exp))
{ {
pstate->level = print_params[i].level - 1; pstate->level = print_params[i].level - 1;
scm_iprlist (hdr, exp, tlr[0], sport, pstate); scm_iprlist (hdr, exp, tlr[0], sport, pstate);
@ -392,17 +392,15 @@ GUILE_PROC(scm_display_application, "display-application", 1, 2, 0,
"") "")
#define FUNC_NAME s_scm_display_application #define FUNC_NAME s_scm_display_application
{ {
SCM_ASSERT (SCM_NIMP (frame) && SCM_FRAMEP (frame), SCM_VALIDATE_FRAME(1,frame);
frame, SCM_ARG1, s_display_application);
if (SCM_UNBNDP (port)) if (SCM_UNBNDP (port))
port = scm_cur_outp; port = scm_cur_outp;
else else
SCM_ASSERT (SCM_NIMP (port) && SCM_OPOUTPORTP (port), SCM_VALIDATE_OPOUTPORT(2,port);
port, SCM_ARG2, s_display_application);
if (SCM_UNBNDP (indent)) if (SCM_UNBNDP (indent))
indent = SCM_INUM0; indent = SCM_INUM0;
else else
SCM_ASSERT (SCM_INUMP (indent), indent, SCM_ARG3, s_display_application); SCM_VALIDATE_INT(3,indent);
if (SCM_FRAME_PROC_P (frame)) if (SCM_FRAME_PROC_P (frame))
/* Display an application. */ /* Display an application. */
@ -466,14 +464,14 @@ display_frame (SCM frame,int nfield,int indentation,SCM sport,SCM port,scm_print
/* Display a special form. */ /* Display a special form. */
{ {
SCM source = SCM_FRAME_SOURCE (frame); SCM source = SCM_FRAME_SOURCE (frame);
SCM copy = (SCM_NIMP (source) && SCM_CONSP (source) SCM copy = (SCM_CONSP (source)
? scm_source_property (source, scm_sym_copy) ? scm_source_property (source, scm_sym_copy)
: SCM_BOOL_F); : SCM_BOOL_F);
SCM umcopy = (SCM_NIMP (source) && SCM_MEMOIZEDP (source) SCM umcopy = (SCM_MEMOIZEDP (source)
? scm_unmemoize (source) ? scm_unmemoize (source)
: SCM_BOOL_F); : SCM_BOOL_F);
display_frame_expr ("(", display_frame_expr ("(",
SCM_NIMP (copy) && SCM_CONSP (copy) ? copy : umcopy, SCM_CONSP (copy) ? copy : umcopy,
")", ")",
nfield + 1 + indentation, nfield + 1 + indentation,
sport, sport,
@ -509,11 +507,11 @@ display_backtrace_body(struct display_backtrace_args *a)
a->port = SCM_COERCE_OUTPORT (a->port); a->port = SCM_COERCE_OUTPORT (a->port);
/* Argument checking and extraction. */ /* Argument checking and extraction. */
SCM_ASSERT (SCM_NIMP (a->stack) && SCM_STACKP (a->stack), SCM_ASSERT (SCM_STACKP (a->stack),
a->stack, a->stack,
SCM_ARG1, SCM_ARG1,
s_display_backtrace); s_display_backtrace);
SCM_ASSERT (SCM_NIMP (a->port) && SCM_OPOUTPORTP (a->port), SCM_ASSERT (SCM_OPOUTPORTP (a->port),
a->port, a->port,
SCM_ARG2, SCM_ARG2,
s_display_backtrace); s_display_backtrace);

89
libguile/coop-threads.c
View file

@ -38,8 +38,13 @@
* If you write modifications of your own for GUILE, it is your choice * If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications. * whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice. */ * If you do not wish that, delete this exception notice. */
/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
#include "scm_validate.h"
#include "coop-threads.h" #include "coop-threads.h"
/* A counter of the current number of threads */ /* A counter of the current number of threads */
@ -55,14 +60,8 @@ size_t scm_switch_counter = SCM_THREAD_SWITCH_COUNT;
coop_m scm_critical_section_mutex; coop_m scm_critical_section_mutex;
#ifdef __STDC__
void void
scm_threads_init (SCM_STACKITEM *i) scm_threads_init (SCM_STACKITEM *i)
#else
void
scm_threads_init (i)
SCM_STACKITEM *i;
#endif
{ {
coop_init(); coop_init();
@ -78,13 +77,8 @@ scm_threads_init (i)
coop_global_main.data = 0; /* Initialized in init.c */ coop_global_main.data = 0; /* Initialized in init.c */
} }
#ifdef __STDC__
void void
scm_threads_mark_stacks () scm_threads_mark_stacks (void)
#else
void
scm_threads_mark_stacks ()
#endif
{ {
coop_t *thread; coop_t *thread;
@ -377,27 +371,18 @@ scm_spawn_thread (scm_catch_body_t body, void *body_data,
return thread; return thread;
} }
#ifdef __STDC__
SCM SCM
scm_join_thread (SCM t) scm_join_thread (SCM t)
#else #define FUNC_NAME s_join_thread
SCM
scm_join_thread (t)
SCM t;
#endif
{ {
SCM_ASSERT (SCM_NIMP (t) && SCM_THREADP (t), t, SCM_ARG1, s_join_thread); SCM_VALIDATE_THREAD(1,t);
coop_join (SCM_THREAD_DATA (t)); coop_join (SCM_THREAD_DATA (t));
return SCM_BOOL_T; return SCM_BOOL_T;
} }
#undef FUNC_NAME
#ifdef __STDC__
SCM SCM
scm_yield () scm_yield (void)
#else
SCM
scm_yield ()
#endif
{ {
/* Yield early */ /* Yield early */
scm_switch_counter = SCM_THREAD_SWITCH_COUNT; scm_switch_counter = SCM_THREAD_SWITCH_COUNT;
@ -406,26 +391,16 @@ scm_yield ()
return SCM_BOOL_T; return SCM_BOOL_T;
} }
#ifdef __STDC__
SCM SCM
scm_single_thread_p () scm_single_thread_p (void)
#else
SCM
scm_single_thread_p ()
#endif
{ {
return (coop_global_runq.tail == &coop_global_runq.t return (coop_global_runq.tail == &coop_global_runq.t
? SCM_BOOL_T ? SCM_BOOL_T
: SCM_BOOL_F); : SCM_BOOL_F);
} }
#ifdef __STDC__
SCM SCM
scm_make_mutex () scm_make_mutex (void)
#else
SCM
scm_make_mutex ()
#endif
{ {
SCM m; SCM m;
coop_m *data = (coop_m *) scm_must_malloc (sizeof (coop_m), "mutex"); coop_m *data = (coop_m *) scm_must_malloc (sizeof (coop_m), "mutex");
@ -435,30 +410,18 @@ scm_make_mutex ()
return m; return m;
} }
#ifdef __STDC__
SCM SCM
scm_lock_mutex (SCM m) scm_lock_mutex (SCM m)
#else
SCM
scm_lock_mutex (m)
SCM m;
#endif
{ {
SCM_ASSERT (SCM_NIMP (m) && SCM_MUTEXP (m), m, SCM_ARG1, s_lock_mutex); SCM_ASSERT (SCM_NIMP (m) && SCM_MUTEXP (m), m, SCM_ARG1, s_lock_mutex);
coop_mutex_lock (SCM_MUTEX_DATA (m)); coop_mutex_lock (SCM_MUTEX_DATA (m));
return SCM_BOOL_T; return SCM_BOOL_T;
} }
#ifdef __STDC__
SCM SCM
scm_unlock_mutex (SCM m) scm_unlock_mutex (SCM m)
#else
SCM
scm_unlock_mutex (m)
SCM m;
#endif
{ {
SCM_ASSERT (SCM_NIMP (m) && SCM_MUTEXP (m), m, SCM_ARG1, s_unlock_mutex); SCM_ASSERT (SCM_MUTEXP (m), m, SCM_ARG1, s_unlock_mutex);
coop_mutex_unlock(SCM_MUTEX_DATA (m)); coop_mutex_unlock(SCM_MUTEX_DATA (m));
/* Yield early */ /* Yield early */
@ -468,13 +431,8 @@ scm_unlock_mutex (m)
return SCM_BOOL_T; return SCM_BOOL_T;
} }
#ifdef __STDC__
SCM SCM
scm_make_condition_variable () scm_make_condition_variable (void)
#else
SCM
scm_make_condition_variable ()
#endif
{ {
SCM c; SCM c;
coop_c *data = (coop_c *) scm_must_malloc (sizeof (coop_c), "condvar"); coop_c *data = (coop_c *) scm_must_malloc (sizeof (coop_c), "condvar");
@ -483,21 +441,14 @@ scm_make_condition_variable ()
return c; return c;
} }
#ifdef __STDC__
SCM SCM
scm_wait_condition_variable (SCM c, SCM m) scm_wait_condition_variable (SCM c, SCM m)
#else
SCM
scm_wait_condition_variable (c, m)
SCM c;
SCM m;
#endif
{ {
SCM_ASSERT (SCM_NIMP (c) && SCM_CONDVARP (c), SCM_ASSERT (SCM_CONDVARP (c),
c, c,
SCM_ARG1, SCM_ARG1,
s_wait_condition_variable); s_wait_condition_variable);
SCM_ASSERT (SCM_NIMP (m) && SCM_MUTEXP (m), SCM_ASSERT (SCM_MUTEXP (m),
m, m,
SCM_ARG2, SCM_ARG2,
s_wait_condition_variable); s_wait_condition_variable);
@ -506,16 +457,10 @@ scm_wait_condition_variable (c, m)
return SCM_BOOL_T; return SCM_BOOL_T;
} }
#ifdef __STDC__
SCM SCM
scm_signal_condition_variable (SCM c) scm_signal_condition_variable (SCM c)
#else
SCM
scm_signal_condition_variable (c)
SCM c;
#endif
{ {
SCM_ASSERT (SCM_NIMP (c) && SCM_CONDVARP (c), SCM_ASSERT (SCM_CONDVARP (c),
c, c,
SCM_ARG1, SCM_ARG1,
s_signal_condition_variable); s_signal_condition_variable);

14
libguile/debug.c
View file

@ -166,7 +166,7 @@ GUILE_PROC (scm_memoized_p, "memoized?", 1, 0, 0,
"") "")
#define FUNC_NAME s_scm_memoized_p #define FUNC_NAME s_scm_memoized_p
{ {
return SCM_BOOL(SCM_NIMP (obj) && SCM_MEMOIZEDP (obj)); return SCM_BOOL(SCM_MEMOIZEDP (obj));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -256,7 +256,7 @@ GUILE_PROC (scm_make_gloc, "make-gloc", 1, 1, 0,
#define FUNC_NAME s_scm_make_gloc #define FUNC_NAME s_scm_make_gloc
{ {
#if 1 /* Unsafe */ #if 1 /* Unsafe */
if (SCM_NIMP (var) && SCM_CONSP (var)) if (SCM_CONSP (var))
var = scm_cons (SCM_BOOL_F, var); var = scm_cons (SCM_BOOL_F, var);
else else
#endif #endif
@ -308,7 +308,7 @@ GUILE_PROC (scm_memcons, "memcons", 2, 1, 0,
"") "")
#define FUNC_NAME s_scm_memcons #define FUNC_NAME s_scm_memcons
{ {
if (SCM_NIMP (car) && SCM_MEMOIZEDP (car)) if (SCM_MEMOIZEDP (car))
{ {
/*fixme* environments may be two different but equal top-level envs */ /*fixme* environments may be two different but equal top-level envs */
if (!SCM_UNBNDP (env) && SCM_MEMOIZED_ENV (car) != env) if (!SCM_UNBNDP (env) && SCM_MEMOIZED_ENV (car) != env)
@ -318,7 +318,7 @@ GUILE_PROC (scm_memcons, "memcons", 2, 1, 0,
env = SCM_MEMOIZED_ENV (car); env = SCM_MEMOIZED_ENV (car);
car = SCM_MEMOIZED_EXP (car); car = SCM_MEMOIZED_EXP (car);
} }
if (SCM_NIMP (cdr) && SCM_MEMOIZEDP (cdr)) if (SCM_MEMOIZEDP (cdr))
{ {
if (!SCM_UNBNDP (env) && SCM_MEMOIZED_ENV (cdr) != env) if (!SCM_UNBNDP (env) && SCM_MEMOIZED_ENV (cdr) != env)
SCM_MISC_ERROR ("environment mismatch arg2 <-> arg3", SCM_MISC_ERROR ("environment mismatch arg2 <-> arg3",
@ -500,11 +500,11 @@ SCM
scm_reverse_lookup (SCM env, SCM data) scm_reverse_lookup (SCM env, SCM data)
{ {
SCM names, values; SCM names, values;
while (SCM_NIMP (env) && SCM_CONSP (SCM_CAR (env))) while (SCM_CONSP (SCM_CAR (env)))
{ {
names = SCM_CAAR (env); names = SCM_CAAR (env);
values = SCM_CDAR (env); values = SCM_CDAR (env);
while (SCM_NIMP (names) && SCM_CONSP (names)) while (SCM_CONSP (names))
{ {
if (SCM_CAR (values) == data) if (SCM_CAR (values) == data)
return SCM_CAR (names); return SCM_CAR (names);
@ -572,7 +572,7 @@ GUILE_PROC (scm_debug_object_p, "debug-object?", 1, 0, 0,
"") "")
#define FUNC_NAME s_scm_debug_object_p #define FUNC_NAME s_scm_debug_object_p
{ {
return SCM_BOOL(SCM_NIMP (obj) && SCM_DEBUGOBJP (obj)); return SCM_BOOL(SCM_DEBUGOBJP (obj));
} }
#undef FUNC_NAME #undef FUNC_NAME

12
libguile/dynl.c
View file

@ -92,7 +92,7 @@ scm_make_argv_from_stringlist (SCM args,int *argcp,const char *subr,int argn)
char *dst, *src; char *dst, *src;
SCM str = SCM_CAR (args); SCM str = SCM_CAR (args);
SCM_ASSERT (SCM_NIMP (str) && SCM_ROSTRINGP (str), str, argn, subr); SCM_ASSERT (SCM_ROSTRINGP (str), str, argn, subr);
len = 1 + SCM_ROLENGTH (str); len = 1 + SCM_ROLENGTH (str);
dst = (char *) scm_must_malloc ((long)len, subr); dst = (char *) scm_must_malloc ((long)len, subr);
src = SCM_ROCHARS (str); src = SCM_ROCHARS (str);
@ -122,7 +122,7 @@ scm_must_free_argv(char **argv)
static SCM static SCM
scm_coerce_rostring (SCM rostr,const char *subr,int argn) scm_coerce_rostring (SCM rostr,const char *subr,int argn)
{ {
SCM_ASSERT (SCM_NIMP (rostr) && SCM_ROSTRINGP (rostr), rostr, argn, subr); SCM_ASSERT (SCM_ROSTRINGP (rostr), rostr, argn, subr);
if (SCM_SUBSTRP (rostr)) if (SCM_SUBSTRP (rostr))
rostr = scm_makfromstr (SCM_ROCHARS (rostr), SCM_ROLENGTH (rostr), 0); rostr = scm_makfromstr (SCM_ROCHARS (rostr), SCM_ROLENGTH (rostr), 0);
return rostr; return rostr;
@ -332,14 +332,14 @@ as the @var{lib} argument to the following functions.")
fname = scm_coerce_rostring (fname, FUNC_NAME, SCM_ARG1); fname = scm_coerce_rostring (fname, FUNC_NAME, SCM_ARG1);
/* collect flags */ /* collect flags */
while (SCM_NIMP (rest) && SCM_CONSP (rest)) while (SCM_CONSP (rest))
{ {
SCM kw, val; SCM kw, val;
kw = SCM_CAR (rest); kw = SCM_CAR (rest);
rest = SCM_CDR (rest); rest = SCM_CDR (rest);
if (!(SCM_NIMP (rest) && SCM_CONSP (rest))) if (!SCM_CONSP (rest))
scm_misc_error (FUNC_NAME, "keyword without value", SCM_EOL); scm_misc_error (FUNC_NAME, "keyword without value", SCM_EOL);
val = SCM_CAR (rest); val = SCM_CAR (rest);
@ -474,7 +474,7 @@ Interrupts are deferred while the C function is executing (with
{ {
void (*fptr)(); void (*fptr)();
if (SCM_NIMP (func) && SCM_ROSTRINGP (func)) if (SCM_ROSTRINGP (func))
func = scm_dynamic_func (func, dobj); func = scm_dynamic_func (func, dobj);
fptr = (void (*)()) scm_num2ulong (func, (char *)SCM_ARG1, FUNC_NAME); fptr = (void (*)()) scm_num2ulong (func, (char *)SCM_ARG1, FUNC_NAME);
SCM_DEFER_INTS; SCM_DEFER_INTS;
@ -517,7 +517,7 @@ and returned from the call to @code{dynamic-args-call}.
int result, argc; int result, argc;
char **argv; char **argv;
if (SCM_NIMP (func) && SCM_ROSTRINGP (func)) if (SCM_ROSTRINGP (func))
func = scm_dynamic_func (func, dobj); func = scm_dynamic_func (func, dobj);
fptr = (int (*)(int, char **)) scm_num2ulong (func, (char *)SCM_ARG1, fptr = (int (*)(int, char **)) scm_num2ulong (func, (char *)SCM_ARG1,

31
libguile/eval.c
View file

@ -694,7 +694,7 @@ scm_m_lambda (SCM xorig, SCM env)
else else
goto memlambda; goto memlambda;
} }
if (!(SCM_NIMP (SCM_CAR (proc)) && SCM_SYMBOLP (SCM_CAR (proc)))) if (!SCM_SYMBOLP (SCM_CAR (proc)))
goto badforms; goto badforms;
proc = SCM_CDR (proc); proc = SCM_CDR (proc);
} }
@ -725,8 +725,7 @@ scm_m_letstar (SCM xorig, SCM env)
{ {
arg1 = SCM_CAR (proc); arg1 = SCM_CAR (proc);
SCM_ASSYNT (2 == scm_ilength (arg1), xorig, scm_s_bindings, s_letstar); SCM_ASSYNT (2 == scm_ilength (arg1), xorig, scm_s_bindings, s_letstar);
SCM_ASSYNT (SCM_NIMP (SCM_CAR (arg1)) && SCM_SYMBOLP (SCM_CAR (arg1)), SCM_ASSYNT (SCM_SYMBOLP (SCM_CAR (arg1)), xorig, scm_s_variable, s_letstar);
xorig, scm_s_variable, s_letstar);
*varloc = scm_cons2 (SCM_CAR (arg1), SCM_CAR (SCM_CDR (arg1)), SCM_EOL); *varloc = scm_cons2 (SCM_CAR (arg1), SCM_CAR (SCM_CDR (arg1)), SCM_EOL);
varloc = SCM_CDRLOC (SCM_CDR (*varloc)); varloc = SCM_CDRLOC (SCM_CDR (*varloc));
proc = SCM_CDR (proc); proc = SCM_CDR (proc);
@ -769,8 +768,7 @@ scm_m_do (SCM xorig, SCM env)
arg1 = SCM_CAR (proc); arg1 = SCM_CAR (proc);
len = scm_ilength (arg1); len = scm_ilength (arg1);
SCM_ASSYNT (2 == len || 3 == len, xorig, scm_s_bindings, "do"); SCM_ASSYNT (2 == len || 3 == len, xorig, scm_s_bindings, "do");
SCM_ASSYNT (SCM_NIMP (SCM_CAR (arg1)) && SCM_SYMBOLP (SCM_CAR (arg1)), SCM_ASSYNT (SCM_SYMBOLP (SCM_CAR (arg1)), xorig, scm_s_variable, "do");
xorig, scm_s_variable, "do");
/* vars reversed here, inits and steps reversed at evaluation */ /* vars reversed here, inits and steps reversed at evaluation */
vars = scm_cons (SCM_CAR (arg1), vars); /* variable */ vars = scm_cons (SCM_CAR (arg1), vars); /* variable */
arg1 = SCM_CDR (arg1); arg1 = SCM_CDR (arg1);
@ -838,7 +836,7 @@ iqq (SCM form,SCM env,int depth)
--depth; --depth;
label: label:
form = SCM_CDR (form); form = SCM_CDR (form);
SCM_ASSERT (SCM_NIMP (form) && SCM_ECONSP (form) && SCM_NULLP (SCM_CDR (form)), SCM_ASSERT (SCM_ECONSP (form) && SCM_NULLP (SCM_CDR (form)),
form, SCM_ARG1, s_quasiquote); form, SCM_ARG1, s_quasiquote);
if (0 == depth) if (0 == depth)
return evalcar (form, env); return evalcar (form, env);
@ -878,12 +876,12 @@ scm_m_define (SCM x, SCM env)
SCM_ASSYNT (scm_ilength (x) >= 2, arg1, scm_s_expression, s_define); SCM_ASSYNT (scm_ilength (x) >= 2, arg1, scm_s_expression, s_define);
proc = SCM_CAR (x); proc = SCM_CAR (x);
x = SCM_CDR (x); x = SCM_CDR (x);
while (SCM_NIMP (proc) && SCM_CONSP (proc)) while (SCM_CONSP (proc))
{ /* nested define syntax */ { /* nested define syntax */
x = scm_cons (scm_cons2 (scm_sym_lambda, SCM_CDR (proc), x), SCM_EOL); x = scm_cons (scm_cons2 (scm_sym_lambda, SCM_CDR (proc), x), SCM_EOL);
proc = SCM_CAR (proc); proc = SCM_CAR (proc);
} }
SCM_ASSYNT (SCM_NIMP (proc) && SCM_SYMBOLP (proc), SCM_ASSYNT (SCM_SYMBOLP (proc),
arg1, scm_s_variable, s_define); arg1, scm_s_variable, s_define);
SCM_ASSYNT (1 == scm_ilength (x), arg1, scm_s_expression, s_define); SCM_ASSYNT (1 == scm_ilength (x), arg1, scm_s_expression, s_define);
if (SCM_TOP_LEVEL (env)) if (SCM_TOP_LEVEL (env))
@ -944,7 +942,7 @@ scm_m_letrec1 (SCM op, SCM imm, SCM xorig, SCM env)
/* vars scm_list reversed here, inits reversed at evaluation */ /* vars scm_list reversed here, inits reversed at evaluation */
arg1 = SCM_CAR (proc); arg1 = SCM_CAR (proc);
ASRTSYNTAX (2 == scm_ilength (arg1), scm_s_bindings); ASRTSYNTAX (2 == scm_ilength (arg1), scm_s_bindings);
ASRTSYNTAX (SCM_NIMP (SCM_CAR (arg1)) && SCM_SYMBOLP (SCM_CAR (arg1)), ASRTSYNTAX (SCM_SYMBOLP (SCM_CAR (arg1)),
scm_s_variable); scm_s_variable);
vars = scm_cons (SCM_CAR (arg1), vars); vars = scm_cons (SCM_CAR (arg1), vars);
*initloc = scm_cons (SCM_CAR (SCM_CDR (arg1)), SCM_EOL); *initloc = scm_cons (SCM_CAR (SCM_CDR (arg1)), SCM_EOL);
@ -988,8 +986,7 @@ scm_m_let (SCM xorig, SCM env)
SCM_ASSYNT (scm_ilength (x) >= 2, xorig, scm_s_body, s_let); SCM_ASSYNT (scm_ilength (x) >= 2, xorig, scm_s_body, s_let);
proc = SCM_CAR (x); proc = SCM_CAR (x);
if (SCM_NULLP (proc) if (SCM_NULLP (proc)
|| (SCM_NIMP (proc) && SCM_CONSP (proc) || (SCM_CONSP (proc)
&& SCM_NIMP (SCM_CAR (proc))
&& SCM_CONSP (SCM_CAR (proc)) && SCM_NULLP (SCM_CDR (proc)))) && SCM_CONSP (SCM_CAR (proc)) && SCM_NULLP (SCM_CDR (proc))))
{ {
/* null or single binding, let* is faster */ /* null or single binding, let* is faster */
@ -1018,7 +1015,7 @@ scm_m_let (SCM xorig, SCM env)
{ /* vars and inits both in order */ { /* vars and inits both in order */
arg1 = SCM_CAR (proc); arg1 = SCM_CAR (proc);
SCM_ASSYNT (2 == scm_ilength (arg1), xorig, scm_s_bindings, s_let); SCM_ASSYNT (2 == scm_ilength (arg1), xorig, scm_s_bindings, s_let);
SCM_ASSYNT (SCM_NIMP (SCM_CAR (arg1)) && SCM_SYMBOLP (SCM_CAR (arg1)), SCM_ASSYNT (SCM_SYMBOLP (SCM_CAR (arg1)),
xorig, scm_s_variable, s_let); xorig, scm_s_variable, s_let);
*varloc = scm_cons (SCM_CAR (arg1), SCM_EOL); *varloc = scm_cons (SCM_CAR (arg1), SCM_EOL);
varloc = SCM_CDRLOC (*varloc); varloc = SCM_CDRLOC (*varloc);
@ -1136,7 +1133,7 @@ scm_m_atfop (SCM xorig, SCM env)
SCM x = SCM_CDR (xorig), vcell; SCM x = SCM_CDR (xorig), vcell;
SCM_ASSYNT (scm_ilength (x) >= 1, xorig, scm_s_expression, "@fop"); SCM_ASSYNT (scm_ilength (x) >= 1, xorig, scm_s_expression, "@fop");
vcell = scm_symbol_fref (SCM_CAR (x)); vcell = scm_symbol_fref (SCM_CAR (x));
SCM_ASSYNT (SCM_NIMP (vcell) && SCM_CONSP (vcell), x, SCM_ASSYNT (SCM_CONSP (vcell), x,
"Symbol's function definition is void", NULL); "Symbol's function definition is void", NULL);
SCM_SETCAR (x, vcell + 1); SCM_SETCAR (x, vcell + 1);
return x; return x;
@ -2766,7 +2763,7 @@ evapply:
char *chrs = SCM_CHARS (proc) + SCM_LENGTH (proc) - 1; char *chrs = SCM_CHARS (proc) + SCM_LENGTH (proc) - 1;
while ('c' != *--chrs) while ('c' != *--chrs)
{ {
SCM_ASSERT (SCM_NIMP (t.arg1) && SCM_CONSP (t.arg1), SCM_ASSERT (SCM_CONSP (t.arg1),
t.arg1, SCM_ARG1, SCM_CHARS (proc)); t.arg1, SCM_ARG1, SCM_CHARS (proc));
t.arg1 = ('a' == *chrs) ? SCM_CAR (t.arg1) : SCM_CDR (t.arg1); t.arg1 = ('a' == *chrs) ? SCM_CAR (t.arg1) : SCM_CDR (t.arg1);
} }
@ -3288,7 +3285,7 @@ SCM_APPLY (SCM proc, SCM arg1, SCM args)
} }
else else
{ {
/* SCM_ASRTGO(SCM_NIMP(args) && SCM_CONSP(args), wrongnumargs); */ /* SCM_ASRTGO(SCM_CONSP(args), wrongnumargs); */
args = scm_nconc2last (args); args = scm_nconc2last (args);
#ifdef DEVAL #ifdef DEVAL
debug.vect[0].a.args = scm_cons (arg1, args); debug.vect[0].a.args = scm_cons (arg1, args);
@ -3359,7 +3356,7 @@ tail:
char *chrs = SCM_CHARS (proc) + SCM_LENGTH (proc) - 1; char *chrs = SCM_CHARS (proc) + SCM_LENGTH (proc) - 1;
while ('c' != *--chrs) while ('c' != *--chrs)
{ {
SCM_ASSERT (SCM_NIMP (arg1) && SCM_CONSP (arg1), SCM_ASSERT (SCM_CONSP (arg1),
arg1, SCM_ARG1, SCM_CHARS (proc)); arg1, SCM_ARG1, SCM_CHARS (proc));
arg1 = ('a' == *chrs) ? SCM_CAR (arg1) : SCM_CDR (arg1); arg1 = ('a' == *chrs) ? SCM_CAR (arg1) : SCM_CDR (arg1);
} }
@ -3374,7 +3371,7 @@ tail:
RETURN (SCM_SUBRF (proc) (SCM_UNBNDP (arg1) ? SCM_EOL : scm_cons (arg1, args))) RETURN (SCM_SUBRF (proc) (SCM_UNBNDP (arg1) ? SCM_EOL : scm_cons (arg1, args)))
#endif #endif
case scm_tc7_lsubr_2: case scm_tc7_lsubr_2:
SCM_ASRTGO (SCM_NIMP (args) && SCM_CONSP (args), wrongnumargs); SCM_ASRTGO (SCM_CONSP (args), wrongnumargs);
RETURN (SCM_SUBRF (proc) (arg1, SCM_CAR (args), SCM_CDR (args))) RETURN (SCM_SUBRF (proc) (arg1, SCM_CAR (args), SCM_CDR (args)))
case scm_tc7_asubr: case scm_tc7_asubr:
if (SCM_NULLP (args)) if (SCM_NULLP (args))

10
libguile/evalext.c
View file

@ -59,9 +59,9 @@ scm_m_generalized_set_x (SCM xorig, SCM env)
{ {
SCM x = SCM_CDR (xorig); SCM x = SCM_CDR (xorig);
SCM_ASSYNT (2 == scm_ilength (x), xorig, scm_s_expression, scm_s_set_x); SCM_ASSYNT (2 == scm_ilength (x), xorig, scm_s_expression, scm_s_set_x);
if (SCM_NIMP (SCM_CAR (x)) && SCM_SYMBOLP (SCM_CAR (x))) if (SCM_SYMBOLP (SCM_CAR (x)))
return scm_cons (SCM_IM_SET_X, x); return scm_cons (SCM_IM_SET_X, x);
else if (SCM_NIMP (SCM_CAR (x)) && SCM_CONSP (SCM_CAR (x))) else if (SCM_CONSP (SCM_CAR (x)))
return scm_cons (SCM_LIST2 (scm_sym_setter, SCM_CAAR (x)), return scm_cons (SCM_LIST2 (scm_sym_setter, SCM_CAAR (x)),
scm_append (SCM_LIST2 (SCM_CDAR (x), SCM_CDR (x)))); scm_append (SCM_LIST2 (SCM_CDAR (x), SCM_CDR (x))));
return scm_wta (xorig, scm_s_variable, scm_s_set_x); return scm_wta (xorig, scm_s_variable, scm_s_set_x);
@ -90,7 +90,7 @@ GUILE_PROC (scm_definedp, "defined?", 1, 1, 0,
b = SCM_CAR (frames); b = SCM_CAR (frames);
if (SCM_NFALSEP (scm_procedure_p (b))) if (SCM_NFALSEP (scm_procedure_p (b)))
break; break;
SCM_ASSERT (SCM_NIMP (b) && SCM_CONSP (b), SCM_ASSERT (SCM_CONSP (b),
env, SCM_ARG2, FUNC_NAME); env, SCM_ARG2, FUNC_NAME);
for (b = SCM_CAR (b); SCM_NIMP (b); b = SCM_CDR (b)) for (b = SCM_CAR (b); SCM_NIMP (b); b = SCM_CDR (b))
{ {
@ -125,10 +125,10 @@ scm_m_undefine (SCM x, SCM env)
SCM arg1 = x; SCM arg1 = x;
x = SCM_CDR (x); x = SCM_CDR (x);
SCM_ASSYNT (SCM_TOP_LEVEL (env), arg1, "bad placement ", s_undefine); SCM_ASSYNT (SCM_TOP_LEVEL (env), arg1, "bad placement ", s_undefine);
SCM_ASSYNT (SCM_NIMP (x) && SCM_CONSP (x) && SCM_CDR (x) == SCM_EOL, SCM_ASSYNT (SCM_CONSP (x) && SCM_CDR (x) == SCM_EOL,
arg1, scm_s_expression, s_undefine); arg1, scm_s_expression, s_undefine);
x = SCM_CAR (x); x = SCM_CAR (x);
SCM_ASSYNT (SCM_NIMP (x) && SCM_SYMBOLP (x), arg1, scm_s_variable, s_undefine); SCM_ASSYNT (SCM_SYMBOLP (x), arg1, scm_s_variable, s_undefine);
arg1 = scm_sym2vcell (x, scm_env_top_level (env), SCM_BOOL_F); arg1 = scm_sym2vcell (x, scm_env_top_level (env), SCM_BOOL_F);
SCM_ASSYNT (SCM_NFALSEP (arg1) && !SCM_UNBNDP (SCM_CDR (arg1)), SCM_ASSYNT (SCM_NFALSEP (arg1) && !SCM_UNBNDP (SCM_CDR (arg1)),
x, "variable already unbound ", s_undefine); x, "variable already unbound ", s_undefine);

4
libguile/feature.c
View file

@ -114,7 +114,7 @@ static SCM
make_hook (SCM name, SCM n_args, const char *subr) make_hook (SCM name, SCM n_args, const char *subr)
{ {
int n; int n;
SCM_ASSERT (SCM_FALSEP (name) || (SCM_NIMP (name) && SCM_SYMBOLP (name)), SCM_ASSERT (SCM_FALSEP (name) || (SCM_SYMBOLP (name)),
name, name,
SCM_ARG1, SCM_ARG1,
subr); subr);
@ -204,7 +204,7 @@ GUILE_PROC (scm_hook_p, "hook?", 1, 0, 0,
"") "")
#define FUNC_NAME s_scm_hook_p #define FUNC_NAME s_scm_hook_p
{ {
return SCM_BOOL(SCM_NIMP (x) && SCM_HOOKP (x)); return SCM_BOOL(SCM_HOOKP (x));
} }
#undef FUNC_NAME #undef FUNC_NAME

26
libguile/filesys.c
View file

@ -145,7 +145,7 @@ as @code{-1}, then that ID is not changed.")
SCM_VALIDATE_INT(2,owner); SCM_VALIDATE_INT(2,owner);
SCM_VALIDATE_INT(3,group); SCM_VALIDATE_INT(3,group);
if (SCM_INUMP (object) || (SCM_NIMP (object) && SCM_OPFPORTP (object))) if (SCM_INUMP (object) || (SCM_OPFPORTP (object)))
{ {
if (SCM_INUMP (object)) if (SCM_INUMP (object))
fdes = SCM_INUM (object); fdes = SCM_INUM (object);
@ -155,7 +155,7 @@ as @code{-1}, then that ID is not changed.")
} }
else else
{ {
SCM_ASSERT (SCM_NIMP (object) && SCM_ROSTRINGP (object), SCM_ASSERT (SCM_ROSTRINGP (object),
object, SCM_ARG1, FUNC_NAME); object, SCM_ARG1, FUNC_NAME);
SCM_COERCE_SUBSTR (object); SCM_COERCE_SUBSTR (object);
SCM_SYSCALL (rv = chown (SCM_ROCHARS (object), SCM_SYSCALL (rv = chown (SCM_ROCHARS (object),
@ -185,7 +185,7 @@ The return value is unspecified.")
object = SCM_COERCE_OUTPORT (object); object = SCM_COERCE_OUTPORT (object);
SCM_VALIDATE_INT(2,mode); SCM_VALIDATE_INT(2,mode);
if (SCM_INUMP (object) || (SCM_NIMP (object) && SCM_OPFPORTP (object))) if (SCM_INUMP (object) || SCM_OPFPORTP (object))
{ {
if (SCM_INUMP (object)) if (SCM_INUMP (object))
fdes = SCM_INUM (object); fdes = SCM_INUM (object);
@ -326,7 +326,7 @@ their revealed counts set to zero.")
fd_or_port = SCM_COERCE_OUTPORT (fd_or_port); fd_or_port = SCM_COERCE_OUTPORT (fd_or_port);
if (SCM_NIMP (fd_or_port) && SCM_PORTP (fd_or_port)) if (SCM_PORTP (fd_or_port))
return scm_close_port (fd_or_port); return scm_close_port (fd_or_port);
SCM_VALIDATE_INT(1,fd_or_port); SCM_VALIDATE_INT(1,fd_or_port);
fd = SCM_INUM (fd_or_port); fd = SCM_INUM (fd_or_port);
@ -685,7 +685,7 @@ GUILE_PROC (scm_directory_stream_p, "directory-stream?", 1, 0, 0,
as returned by @code{opendir}.") as returned by @code{opendir}.")
#define FUNC_NAME s_scm_directory_stream_p #define FUNC_NAME s_scm_directory_stream_p
{ {
return SCM_BOOL(SCM_NIMP (obj) && SCM_DIRP (obj)); return SCM_BOOL(SCM_DIRP (obj));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -848,7 +848,7 @@ set_element (SELECT_TYPE *set, SCM element, int arg)
{ {
int fd; int fd;
element = SCM_COERCE_OUTPORT (element); element = SCM_COERCE_OUTPORT (element);
if (SCM_NIMP (element) && SCM_OPFPORTP (element)) if (SCM_OPFPORTP (element))
fd = SCM_FPORT_FDES (element); fd = SCM_FPORT_FDES (element);
else { else {
SCM_ASSERT (SCM_INUMP (element), element, arg, "select"); SCM_ASSERT (SCM_INUMP (element), element, arg, "select");
@ -862,7 +862,7 @@ static int
fill_select_type (SELECT_TYPE *set, SCM list, int arg) fill_select_type (SELECT_TYPE *set, SCM list, int arg)
{ {
int max_fd = 0, fd; int max_fd = 0, fd;
if (SCM_NIMP (list) && SCM_VECTORP (list)) if (SCM_VECTORP (list))
{ {
int len = SCM_LENGTH (list); int len = SCM_LENGTH (list);
SCM *ve = SCM_VELTS (list); SCM *ve = SCM_VELTS (list);
@ -893,7 +893,7 @@ static SCM
get_element (SELECT_TYPE *set, SCM element, SCM list) get_element (SELECT_TYPE *set, SCM element, SCM list)
{ {
element = SCM_COERCE_OUTPORT (element); element = SCM_COERCE_OUTPORT (element);
if (SCM_NIMP (element) && SCM_OPFPORTP (element)) if (SCM_OPFPORTP (element))
{ {
if (FD_ISSET (SCM_FPORT_FDES (element), set)) if (FD_ISSET (SCM_FPORT_FDES (element), set))
list = scm_cons (element, list); list = scm_cons (element, list);
@ -911,7 +911,7 @@ retrieve_select_type (SELECT_TYPE *set, SCM list)
{ {
SCM answer_list = SCM_EOL; SCM answer_list = SCM_EOL;
if (SCM_NIMP (list) && SCM_VECTORP (list)) if (SCM_VECTORP (list))
{ {
int len = SCM_LENGTH (list); int len = SCM_LENGTH (list);
SCM *ve = SCM_VELTS (list); SCM *ve = SCM_VELTS (list);
@ -973,7 +973,7 @@ values instead of a list and has an additional select! interface.
int sreturn; int sreturn;
#define assert_set(x, arg) \ #define assert_set(x, arg) \
SCM_ASSERT (scm_ilength (x) >= 0 || (SCM_NIMP (x) && SCM_VECTORP (x)), \ SCM_ASSERT (scm_ilength (x) >= 0 || (SCM_VECTORP (x)), \
x, arg, FUNC_NAME) x, arg, FUNC_NAME)
assert_set (reads, SCM_ARG1); assert_set (reads, SCM_ARG1);
assert_set (writes, SCM_ARG2); assert_set (writes, SCM_ARG2);
@ -1080,7 +1080,7 @@ The value used to indicate the "close on exec" flag with @code{F_GETFL} or
object = SCM_COERCE_OUTPORT (object); object = SCM_COERCE_OUTPORT (object);
SCM_VALIDATE_INT(2,cmd); SCM_VALIDATE_INT(2,cmd);
if (SCM_NIMP (object) && SCM_OPFPORTP (object)) if (SCM_OPFPORTP (object))
fdes = SCM_FPORT_FDES (object); fdes = SCM_FPORT_FDES (object);
else else
{ {
@ -1113,7 +1113,7 @@ The return value is unspecified.")
object = SCM_COERCE_OUTPORT (object); object = SCM_COERCE_OUTPORT (object);
if (SCM_NIMP (object) && SCM_OPFPORTP (object)) if (SCM_OPFPORTP (object))
{ {
scm_flush (object); scm_flush (object);
fdes = SCM_FPORT_FDES (object); fdes = SCM_FPORT_FDES (object);
@ -1307,7 +1307,7 @@ GUILE_PROC (scm_basename, "basename", 1, 1, 0,
int i, j, len, end; int i, j, len, end;
SCM_VALIDATE_ROSTRING(1,filename); SCM_VALIDATE_ROSTRING(1,filename);
SCM_ASSERT (SCM_UNBNDP (suffix) SCM_ASSERT (SCM_UNBNDP (suffix)
|| (SCM_NIMP (suffix) && SCM_ROSTRINGP (suffix)), || (SCM_ROSTRINGP (suffix)),
suffix, suffix,
SCM_ARG2, SCM_ARG2,
FUNC_NAME); FUNC_NAME);

2
libguile/fluids.c
View file

@ -136,7 +136,7 @@ GUILE_PROC (scm_fluid_p, "fluid?", 1, 0, 0,
"") "")
#define FUNC_NAME s_scm_fluid_p #define FUNC_NAME s_scm_fluid_p
{ {
return SCM_BOOL(SCM_NIMP (fl) && SCM_FLUIDP (fl)); return SCM_BOOL(SCM_FLUIDP (fl));
} }
#undef FUNC_NAME #undef FUNC_NAME

2
libguile/fports.c
View file

@ -451,7 +451,7 @@ prinfport (SCM exp,SCM port,scm_print_state *pstate)
{ {
int fdes; int fdes;
SCM name = SCM_PTAB_ENTRY (exp)->file_name; SCM name = SCM_PTAB_ENTRY (exp)->file_name;
scm_puts (SCM_NIMP (name) && SCM_ROSTRINGP (name) scm_puts (SCM_ROSTRINGP (name)
? SCM_ROCHARS (name) ? SCM_ROCHARS (name)
: SCM_PTOBNAME (SCM_PTOBNUM (exp)), : SCM_PTOBNAME (SCM_PTOBNUM (exp)),
port); port);

8
libguile/gc.c
View file

@ -1379,7 +1379,7 @@ scm_gc_sweep ()
ptr = SCM_VELTS (w); ptr = SCM_VELTS (w);
n = SCM_LENGTH (w); n = SCM_LENGTH (w);
for (j = 0; j < n; ++j) for (j = 0; j < n; ++j)
if (SCM_NIMP (ptr[j]) && SCM_FREEP (ptr[j])) if (SCM_FREEP (ptr[j]))
ptr[j] = SCM_BOOL_F; ptr[j] = SCM_BOOL_F;
} }
else /* if (SCM_IS_WHVEC_ANY (scm_weak_vectors[i])) */ else /* if (SCM_IS_WHVEC_ANY (scm_weak_vectors[i])) */
@ -1413,8 +1413,8 @@ scm_gc_sweep ()
key = SCM_CAAR (alist); key = SCM_CAAR (alist);
value = SCM_CDAR (alist); value = SCM_CDAR (alist);
if ( (weak_keys && SCM_NIMP (key) && SCM_FREEP (key)) if ( (weak_keys && SCM_FREEP (key))
|| (weak_values && SCM_NIMP (value) && SCM_FREEP (value))) || (weak_values && SCM_FREEP (value)))
{ {
*fixup = SCM_CDR (alist); *fixup = SCM_CDR (alist);
} }
@ -1859,7 +1859,7 @@ scm_unprotect_object (SCM obj)
{ {
SCM *tail_ptr = &scm_protects; SCM *tail_ptr = &scm_protects;
while (SCM_NIMP (*tail_ptr) && SCM_CONSP (*tail_ptr)) while (SCM_CONSP (*tail_ptr))
if (SCM_CAR (*tail_ptr) == obj) if (SCM_CAR (*tail_ptr) == obj)
{ {
*tail_ptr = SCM_CDR (*tail_ptr); *tail_ptr = SCM_CDR (*tail_ptr);

14
libguile/gh_data.c
View file

@ -104,7 +104,7 @@ gh_set_substr (char *src, SCM dst, int start, int len)
unsigned long dst_len; unsigned long dst_len;
unsigned long effective_length; unsigned long effective_length;
SCM_ASSERT (SCM_NIMP (dst) && SCM_STRINGP (dst), dst, SCM_ARG3, SCM_ASSERT (SCM_STRINGP (dst), dst, SCM_ARG3,
"gh_set_substr"); "gh_set_substr");
dst_ptr = SCM_CHARS (dst); dst_ptr = SCM_CHARS (dst);
@ -366,7 +366,7 @@ gh_scm2longs (SCM obj, long *m)
for (i = 0; i < n; ++i) for (i = 0; i < n; ++i)
{ {
val = SCM_VELTS (obj)[i]; val = SCM_VELTS (obj)[i];
if (!SCM_INUMP (val) && !(SCM_NIMP (val) && SCM_BIGP (val))) if (!SCM_INUMP (val) && !SCM_BIGP (val))
scm_wrong_type_arg (0, 0, obj); scm_wrong_type_arg (0, 0, obj);
} }
if (m == 0) if (m == 0)
@ -410,7 +410,7 @@ gh_scm2floats (SCM obj, float *m)
{ {
val = SCM_VELTS (obj)[i]; val = SCM_VELTS (obj)[i];
if (!SCM_INUMP (val) if (!SCM_INUMP (val)
&& !(SCM_NIMP (val) && (SCM_BIGP (val) || SCM_REALP (val)))) && !(SCM_BIGP (val) || SCM_REALP (val)))
scm_wrong_type_arg (0, 0, val); scm_wrong_type_arg (0, 0, val);
} }
if (m == 0) if (m == 0)
@ -469,7 +469,7 @@ gh_scm2doubles (SCM obj, double *m)
{ {
val = SCM_VELTS (obj)[i]; val = SCM_VELTS (obj)[i];
if (!SCM_INUMP (val) if (!SCM_INUMP (val)
&& !(SCM_NIMP (val) && (SCM_BIGP (val) || SCM_REALP (val)))) && !(SCM_BIGP (val) || SCM_REALP (val)))
scm_wrong_type_arg (0, 0, val); scm_wrong_type_arg (0, 0, val);
} }
if (m == 0) if (m == 0)
@ -530,7 +530,7 @@ gh_scm2newstr (SCM str, int *lenp)
char *ret_str; char *ret_str;
int len; int len;
SCM_ASSERT (SCM_NIMP (str) && SCM_ROSTRINGP (str), str, SCM_ARG3, SCM_ASSERT (SCM_ROSTRINGP (str), str, SCM_ARG3,
"gh_scm2newstr"); "gh_scm2newstr");
/* protect str from GC while we copy off its data */ /* protect str from GC while we copy off its data */
@ -567,7 +567,7 @@ void
gh_get_substr (SCM src, char *dst, int start, int len) gh_get_substr (SCM src, char *dst, int start, int len)
{ {
int src_len, effective_length; int src_len, effective_length;
SCM_ASSERT (SCM_NIMP (src) && SCM_ROSTRINGP (src), src, SCM_ARG3, SCM_ASSERT (SCM_ROSTRINGP (src), src, SCM_ARG3,
"gh_get_substr"); "gh_get_substr");
scm_protect_object (src); scm_protect_object (src);
@ -592,7 +592,7 @@ gh_symbol2newstr (SCM sym, int *lenp)
char *ret_str; char *ret_str;
int len; int len;
SCM_ASSERT (SCM_NIMP (sym) && SCM_SYMBOLP (sym), sym, SCM_ARG3, SCM_ASSERT (SCM_SYMBOLP (sym), sym, SCM_ARG3,
"gh_scm2newsymbol"); "gh_scm2newsymbol");
/* protect str from GC while we copy off its data */ /* protect str from GC while we copy off its data */

2
libguile/hash.c
View file

@ -169,7 +169,7 @@ scm_ihashv (SCM obj, unsigned int n)
if (SCM_ICHRP(obj)) if (SCM_ICHRP(obj))
return ((unsigned int)(scm_downcase(SCM_ICHR(obj)))) % n; /* downcase!?!! */ return ((unsigned int)(scm_downcase(SCM_ICHR(obj)))) % n; /* downcase!?!! */
if (SCM_NIMP(obj) && SCM_NUMP(obj)) if (SCM_NUMP(obj))
return (unsigned int) scm_hasher(obj, n, 10); return (unsigned int) scm_hasher(obj, n, 10);
else else
return ((unsigned int)obj) % n; return ((unsigned int)obj) % n;

10
libguile/hashtab.c
View file

@ -61,7 +61,7 @@ scm_hash_fn_get_handle (SCM table,SCM obj,unsigned int (*hash_fn)(),SCM (*assoc_
unsigned int k; unsigned int k;
SCM h; SCM h;
SCM_ASSERT (SCM_NIMP (table) && SCM_VECTORP (table), table, SCM_ARG1, "hash_fn_get_handle"); SCM_ASSERT (SCM_VECTORP (table), table, SCM_ARG1, "hash_fn_get_handle");
if (SCM_LENGTH (table) == 0) if (SCM_LENGTH (table) == 0)
return SCM_EOL; return SCM_EOL;
k = hash_fn (obj, SCM_LENGTH (table), closure); k = hash_fn (obj, SCM_LENGTH (table), closure);
@ -82,7 +82,7 @@ scm_hash_fn_create_handle_x (SCM table,SCM obj,SCM init,unsigned int (*hash_fn)(
unsigned int k; unsigned int k;
SCM it; SCM it;
SCM_ASSERT (SCM_NIMP (table) && SCM_VECTORP (table), table, SCM_ARG1, "hash_fn_create_handle_x"); SCM_ASSERT (SCM_VECTORP (table), table, SCM_ARG1, "hash_fn_create_handle_x");
if (SCM_LENGTH (table) == 0) if (SCM_LENGTH (table) == 0)
return SCM_EOL; return SCM_EOL;
k = hash_fn (obj, SCM_LENGTH (table), closure); k = hash_fn (obj, SCM_LENGTH (table), closure);
@ -148,7 +148,7 @@ scm_hash_fn_remove_x (SCM table,SCM obj,unsigned int (*hash_fn)(),SCM (*assoc_fn
unsigned int k; unsigned int k;
SCM h; SCM h;
SCM_ASSERT (SCM_NIMP (table) && SCM_VECTORP (table), table, SCM_ARG1, "hash_fn_remove_x"); SCM_ASSERT (SCM_VECTORP (table), table, SCM_ARG1, "hash_fn_remove_x");
if (SCM_LENGTH (table) == 0) if (SCM_LENGTH (table) == 0)
return SCM_EOL; return SCM_EOL;
k = hash_fn (obj, SCM_LENGTH (table), closure); k = hash_fn (obj, SCM_LENGTH (table), closure);
@ -510,10 +510,10 @@ scm_internal_hash_fold (SCM (*fn) (), void *closure, SCM init, SCM table)
SCM ls = SCM_VELTS (table)[i], handle; SCM ls = SCM_VELTS (table)[i], handle;
while (SCM_NNULLP (ls)) while (SCM_NNULLP (ls))
{ {
SCM_ASSERT (SCM_NIMP (ls) && SCM_CONSP (ls), SCM_ASSERT (SCM_CONSP (ls),
table, SCM_ARG1, s_scm_hash_fold); table, SCM_ARG1, s_scm_hash_fold);
handle = SCM_CAR (ls); handle = SCM_CAR (ls);
SCM_ASSERT (SCM_NIMP (handle) && SCM_CONSP (handle), SCM_ASSERT (SCM_CONSP (handle),
table, SCM_ARG1, s_scm_hash_fold); table, SCM_ARG1, s_scm_hash_fold);
result = fn (closure, SCM_CAR (handle), SCM_CDR (handle), result); result = fn (closure, SCM_CAR (handle), SCM_CDR (handle), result);
ls = SCM_CDR (ls); ls = SCM_CDR (ls);

2
libguile/ioext.c
View file

@ -437,7 +437,7 @@ non-file device, otherwise @code{#f}.")
port = SCM_COERCE_OUTPORT (port); port = SCM_COERCE_OUTPORT (port);
if (!(SCM_NIMP (port) && SCM_OPFPORTP (port))) if (!SCM_OPFPORTP (port))
return SCM_BOOL_F; return SCM_BOOL_F;
rv = isatty (SCM_FPORT_FDES (port)); rv = isatty (SCM_FPORT_FDES (port));

2
libguile/keywords.c
View file

@ -113,7 +113,7 @@ GUILE_PROC(scm_keyword_p, "keyword?", 1, 0, 0,
it returns @code{#f} otherwise.") it returns @code{#f} otherwise.")
#define FUNC_NAME s_scm_keyword_p #define FUNC_NAME s_scm_keyword_p
{ {
return SCM_BOOL(SCM_NIMP(obj) && SCM_KEYWORDP (obj)); return SCM_BOOL(SCM_KEYWORDP (obj));
} }
#undef FUNC_NAME #undef FUNC_NAME

32
libguile/list.c
View file

@ -341,11 +341,11 @@ GUILE_PROC(scm_list_ref, "list-ref", 2, 0, 0,
register long i; register long i;
SCM_VALIDATE_INT_MIN_COPY(2,k,0,i); SCM_VALIDATE_INT_MIN_COPY(2,k,0,i);
while (i-- > 0) { while (i-- > 0) {
SCM_ASRTGO(SCM_NIMP(lst) && SCM_CONSP(lst), erout); SCM_ASRTGO(SCM_CONSP(lst), erout);
lst = SCM_CDR(lst); lst = SCM_CDR(lst);
} }
erout: erout:
SCM_ASSERT(SCM_NIMP(lst) && SCM_CONSP(lst), SCM_ASSERT(SCM_CONSP(lst),
SCM_NULLP(lst)?k:lst, SCM_NULLP(lst)?SCM_OUTOFRANGE:SCM_ARG1, FUNC_NAME); SCM_NULLP(lst)?k:lst, SCM_NULLP(lst)?SCM_OUTOFRANGE:SCM_ARG1, FUNC_NAME);
return SCM_CAR(lst); return SCM_CAR(lst);
} }
@ -359,11 +359,11 @@ GUILE_PROC(scm_list_set_x, "list-set!", 3, 0, 0,
register long i; register long i;
SCM_VALIDATE_INT_MIN_COPY(2,k,0,i); SCM_VALIDATE_INT_MIN_COPY(2,k,0,i);
while (i-- > 0) { while (i-- > 0) {
SCM_ASRTGO(SCM_NIMP(lst) && SCM_CONSP(lst), erout); SCM_ASRTGO(SCM_CONSP(lst), erout);
lst = SCM_CDR(lst); lst = SCM_CDR(lst);
} }
erout: erout:
SCM_ASSERT(SCM_NIMP(lst) && SCM_CONSP(lst), SCM_ASSERT(SCM_CONSP(lst),
SCM_NULLP(lst)?k:lst, SCM_NULLP(lst)?SCM_OUTOFRANGE:SCM_ARG1, FUNC_NAME); SCM_NULLP(lst)?k:lst, SCM_NULLP(lst)?SCM_OUTOFRANGE:SCM_ARG1, FUNC_NAME);
SCM_SETCAR (lst, val); SCM_SETCAR (lst, val);
return val; return val;
@ -402,11 +402,11 @@ GUILE_PROC(scm_list_cdr_set_x, "list-cdr-set!", 3, 0, 0,
register long i; register long i;
SCM_VALIDATE_INT_MIN_COPY(2,k,0,i); SCM_VALIDATE_INT_MIN_COPY(2,k,0,i);
while (i-- > 0) { while (i-- > 0) {
SCM_ASRTGO(SCM_NIMP(lst) && SCM_CONSP(lst), erout); SCM_ASRTGO(SCM_CONSP(lst), erout);
lst = SCM_CDR(lst); lst = SCM_CDR(lst);
} }
erout: erout:
SCM_ASSERT(SCM_NIMP(lst) && SCM_CONSP(lst), SCM_ASSERT(SCM_CONSP(lst),
SCM_NULLP(lst)?k:lst, SCM_NULLP(lst)?SCM_OUTOFRANGE:SCM_ARG1, FUNC_NAME); SCM_NULLP(lst)?k:lst, SCM_NULLP(lst)?SCM_OUTOFRANGE:SCM_ARG1, FUNC_NAME);
SCM_SETCDR (lst, val); SCM_SETCDR (lst, val);
return val; return val;
@ -455,7 +455,7 @@ GUILE_PROC (scm_list_copy, "list-copy", 1, 0, 0,
fill_here = &newlst; fill_here = &newlst;
from_here = lst; from_here = lst;
while (SCM_NIMP (from_here) && SCM_CONSP (from_here)) while (SCM_CONSP (from_here))
{ {
SCM c; SCM c;
c = scm_cons (SCM_CAR (from_here), SCM_CDR (from_here)); c = scm_cons (SCM_CAR (from_here), SCM_CDR (from_here));
@ -480,7 +480,7 @@ not perform any type or error checking. Their use is recommended only
in writing Guile internals, not for high-level Scheme programs.") in writing Guile internals, not for high-level Scheme programs.")
#define FUNC_NAME s_scm_sloppy_memq #define FUNC_NAME s_scm_sloppy_memq
{ {
for(; SCM_NIMP(lst) && SCM_CONSP (lst); lst = SCM_CDR(lst)) for(; SCM_CONSP (lst); lst = SCM_CDR(lst))
{ {
if (SCM_CAR(lst)==x) if (SCM_CAR(lst)==x)
return lst; return lst;
@ -495,7 +495,7 @@ GUILE_PROC (scm_sloppy_memv, "sloppy-memv", 2, 0, 0,
"") "")
#define FUNC_NAME s_scm_sloppy_memv #define FUNC_NAME s_scm_sloppy_memv
{ {
for(; SCM_NIMP(lst) && SCM_CONSP (lst); lst = SCM_CDR(lst)) for(; SCM_CONSP (lst); lst = SCM_CDR(lst))
{ {
if (SCM_BOOL_F != scm_eqv_p (SCM_CAR(lst), x)) if (SCM_BOOL_F != scm_eqv_p (SCM_CAR(lst), x))
return lst; return lst;
@ -510,7 +510,7 @@ GUILE_PROC (scm_sloppy_member, "sloppy-member", 2, 0, 0,
"") "")
#define FUNC_NAME s_scm_sloppy_member #define FUNC_NAME s_scm_sloppy_member
{ {
for(; SCM_NIMP(lst) && SCM_CONSP (lst); lst = SCM_CDR(lst)) for(; SCM_CONSP (lst); lst = SCM_CDR(lst))
{ {
if (SCM_BOOL_F != scm_equal_p (SCM_CAR(lst), x)) if (SCM_BOOL_F != scm_equal_p (SCM_CAR(lst), x))
return lst; return lst;
@ -580,7 +580,7 @@ destructive list functions, these functions cannot modify the binding of
SCM *prev; SCM *prev;
for (prev = &lst, walk = lst; for (prev = &lst, walk = lst;
SCM_NIMP (walk) && SCM_CONSP (walk); SCM_CONSP (walk);
walk = SCM_CDR (walk)) walk = SCM_CDR (walk))
{ {
if (SCM_CAR (walk) == item) if (SCM_CAR (walk) == item)
@ -603,7 +603,7 @@ GUILE_PROC(scm_delv_x, "delv!", 2, 0, 0,
SCM *prev; SCM *prev;
for (prev = &lst, walk = lst; for (prev = &lst, walk = lst;
SCM_NIMP (walk) && SCM_CONSP (walk); SCM_CONSP (walk);
walk = SCM_CDR (walk)) walk = SCM_CDR (walk))
{ {
if (SCM_BOOL_F != scm_eqv_p (SCM_CAR (walk), item)) if (SCM_BOOL_F != scm_eqv_p (SCM_CAR (walk), item))
@ -627,7 +627,7 @@ GUILE_PROC(scm_delete_x, "delete!", 2, 0, 0,
SCM *prev; SCM *prev;
for (prev = &lst, walk = lst; for (prev = &lst, walk = lst;
SCM_NIMP (walk) && SCM_CONSP (walk); SCM_CONSP (walk);
walk = SCM_CDR (walk)) walk = SCM_CDR (walk))
{ {
if (SCM_BOOL_F != scm_equal_p (SCM_CAR (walk), item)) if (SCM_BOOL_F != scm_equal_p (SCM_CAR (walk), item))
@ -689,7 +689,7 @@ GUILE_PROC(scm_delq1_x, "delq1!", 2, 0, 0,
SCM *prev; SCM *prev;
for (prev = &lst, walk = lst; for (prev = &lst, walk = lst;
SCM_NIMP (walk) && SCM_CONSP (walk); SCM_CONSP (walk);
walk = SCM_CDR (walk)) walk = SCM_CDR (walk))
{ {
if (SCM_CAR (walk) == item) if (SCM_CAR (walk) == item)
@ -715,7 +715,7 @@ GUILE_PROC(scm_delv1_x, "delv1!", 2, 0, 0,
SCM *prev; SCM *prev;
for (prev = &lst, walk = lst; for (prev = &lst, walk = lst;
SCM_NIMP (walk) && SCM_CONSP (walk); SCM_CONSP (walk);
walk = SCM_CDR (walk)) walk = SCM_CDR (walk))
{ {
if (SCM_BOOL_F != scm_eqv_p (SCM_CAR (walk), item)) if (SCM_BOOL_F != scm_eqv_p (SCM_CAR (walk), item))
@ -741,7 +741,7 @@ GUILE_PROC(scm_delete1_x, "delete1!", 2, 0, 0,
SCM *prev; SCM *prev;
for (prev = &lst, walk = lst; for (prev = &lst, walk = lst;
SCM_NIMP (walk) && SCM_CONSP (walk); SCM_CONSP (walk);
walk = SCM_CDR (walk)) walk = SCM_CDR (walk))
{ {
if (SCM_BOOL_F != scm_equal_p (SCM_CAR (walk), item)) if (SCM_BOOL_F != scm_equal_p (SCM_CAR (walk), item))

6
libguile/load.c
View file

@ -216,7 +216,7 @@ GUILE_PROC (scm_parse_path, "parse-path", 1, 1, 0,
"") "")
#define FUNC_NAME s_scm_parse_path #define FUNC_NAME s_scm_parse_path
{ {
SCM_ASSERT (SCM_FALSEP (path) || (SCM_NIMP (path) && SCM_ROSTRINGP (path)), SCM_ASSERT (SCM_FALSEP (path) || (SCM_ROSTRINGP (path)),
path, path,
SCM_ARG1, FUNC_NAME); SCM_ARG1, FUNC_NAME);
if (SCM_UNBNDP (tail)) if (SCM_UNBNDP (tail))
@ -288,7 +288,7 @@ GUILE_PROC(scm_search_path, "search-path", 2, 1, 0,
for (walk = path; SCM_NIMP (walk); walk = SCM_CDR (walk)) for (walk = path; SCM_NIMP (walk); walk = SCM_CDR (walk))
{ {
SCM elt = SCM_CAR (walk); SCM elt = SCM_CAR (walk);
SCM_ASSERT (SCM_NIMP (elt) && SCM_ROSTRINGP (elt), elt, SCM_ASSERT (SCM_ROSTRINGP (elt), elt,
"path is not a list of strings", "path is not a list of strings",
FUNC_NAME); FUNC_NAME);
if (SCM_ROLENGTH (elt) > max_path_len) if (SCM_ROLENGTH (elt) > max_path_len)
@ -327,7 +327,7 @@ GUILE_PROC(scm_search_path, "search-path", 2, 1, 0,
for (walk = extensions; SCM_NIMP (walk); walk = SCM_CDR (walk)) for (walk = extensions; SCM_NIMP (walk); walk = SCM_CDR (walk))
{ {
SCM elt = SCM_CAR (walk); SCM elt = SCM_CAR (walk);
SCM_ASSERT (SCM_NIMP (elt) && SCM_ROSTRINGP (elt), elt, SCM_ASSERT (SCM_ROSTRINGP (elt), elt,
"extension list is not a list of strings", "extension list is not a list of strings",
FUNC_NAME); FUNC_NAME);
if (SCM_ROLENGTH (elt) > max_ext_len) if (SCM_ROLENGTH (elt) > max_ext_len)

10
libguile/mit-pthreads.c
View file

@ -419,7 +419,7 @@ scm_lock_mutex (m)
SCM m; SCM m;
#endif #endif
{ {
SCM_ASSERT (SCM_NIMP (m) && SCM_MUTEXP (m), m, SCM_ARG1, s_lock_mutex); SCM_ASSERT (SCM_MUTEXP (m), m, SCM_ARG1, s_lock_mutex);
pthread_mutex_lock (SCM_MUTEX_DATA (m)); pthread_mutex_lock (SCM_MUTEX_DATA (m));
return SCM_BOOL_T; return SCM_BOOL_T;
} }
@ -433,7 +433,7 @@ scm_unlock_mutex (m)
SCM m; SCM m;
#endif #endif
{ {
SCM_ASSERT (SCM_NIMP (m) && SCM_MUTEXP (m), m, SCM_ARG1, s_unlock_mutex); SCM_ASSERT (SCM_MUTEXP (m), m, SCM_ARG1, s_unlock_mutex);
pthread_mutex_unlock (SCM_MUTEX_DATA (m)); pthread_mutex_unlock (SCM_MUTEX_DATA (m));
return SCM_BOOL_T; return SCM_BOOL_T;
} }
@ -463,11 +463,11 @@ scm_wait_condition_variable (c, m)
SCM m; SCM m;
#endif #endif
{ {
SCM_ASSERT (SCM_NIMP (c) && SCM_CONDVARP (c), SCM_ASSERT (SCM_CONDVARP (c),
c, c,
SCM_ARG1, SCM_ARG1,
s_wait_condition_variable); s_wait_condition_variable);
SCM_ASSERT (SCM_NIMP (m) && SCM_MUTEXP (m), SCM_ASSERT (SCM_MUTEXP (m),
m, m,
SCM_ARG2, SCM_ARG2,
s_wait_condition_variable); s_wait_condition_variable);
@ -484,7 +484,7 @@ scm_signal_condition_variable (c)
SCM c; SCM c;
#endif #endif
{ {
SCM_ASSERT (SCM_NIMP (c) && SCM_CONDVARP (c), SCM_ASSERT (SCM_CONDVARP (c),
c, c,
SCM_ARG1, SCM_ARG1,
s_signal_condition_variable); s_signal_condition_variable);

8
libguile/net_db.c
View file

@ -274,7 +274,7 @@ Unusual conditions may result in errors thrown to the
return SCM_BOOL_F; return SCM_BOOL_F;
} }
} }
else if (SCM_NIMP (name) && SCM_ROSTRINGP (name)) else if (SCM_ROSTRINGP (name))
{ {
SCM_COERCE_SUBSTR (name); SCM_COERCE_SUBSTR (name);
entry = gethostbyname (SCM_ROCHARS (name)); entry = gethostbyname (SCM_ROCHARS (name));
@ -348,7 +348,7 @@ given.")
return SCM_BOOL_F; return SCM_BOOL_F;
} }
} }
else if (SCM_NIMP (name) && SCM_ROSTRINGP (name)) else if (SCM_ROSTRINGP (name))
{ {
SCM_COERCE_SUBSTR (name); SCM_COERCE_SUBSTR (name);
entry = getnetbyname (SCM_ROCHARS (name)); entry = getnetbyname (SCM_ROCHARS (name));
@ -400,7 +400,7 @@ argument. @code{getproto} will accept either type, behaving like
return SCM_BOOL_F; return SCM_BOOL_F;
} }
} }
else if (SCM_NIMP (name) && SCM_ROSTRINGP (name)) else if (SCM_ROSTRINGP (name))
{ {
SCM_COERCE_SUBSTR (name); SCM_COERCE_SUBSTR (name);
entry = getprotobyname (SCM_ROCHARS (name)); entry = getprotobyname (SCM_ROCHARS (name));
@ -468,7 +468,7 @@ as its first argument; if given no arguments, it behaves like
} }
SCM_VALIDATE_ROSTRING(2,proto); SCM_VALIDATE_ROSTRING(2,proto);
SCM_COERCE_SUBSTR (proto); SCM_COERCE_SUBSTR (proto);
if (SCM_NIMP (name) && SCM_ROSTRINGP (name)) if (SCM_ROSTRINGP (name))
{ {
SCM_COERCE_SUBSTR (name); SCM_COERCE_SUBSTR (name);
entry = getservbyname (SCM_ROCHARS (name), SCM_ROCHARS (proto)); entry = getservbyname (SCM_ROCHARS (name), SCM_ROCHARS (proto));

182
libguile/numbers.c
View file

@ -103,7 +103,7 @@ GUILE_PROC (scm_exact_p, "exact?", 1, 0, 0,
if (SCM_INUMP (x)) if (SCM_INUMP (x))
return SCM_BOOL_T; return SCM_BOOL_T;
#ifdef SCM_BIGDIG #ifdef SCM_BIGDIG
if (SCM_NIMP (x) && SCM_BIGP (x)) if (SCM_BIGP (x))
return SCM_BOOL_T; return SCM_BOOL_T;
#endif #endif
return SCM_BOOL_F; return SCM_BOOL_F;
@ -154,7 +154,7 @@ scm_abs (SCM x)
#ifdef SCM_BIGDIG #ifdef SCM_BIGDIG
if (SCM_NINUMP (x)) if (SCM_NINUMP (x))
{ {
SCM_GASSERT1 (SCM_NIMP (x) && SCM_BIGP (x), g_abs, x, SCM_ARG1, s_abs); SCM_GASSERT1 (SCM_BIGP (x), g_abs, x, SCM_ARG1, s_abs);
if (SCM_TYP16 (x) == scm_tc16_bigpos) if (SCM_TYP16 (x) == scm_tc16_bigpos)
return x; return x;
return scm_copybig (x, 0); return scm_copybig (x, 0);
@ -184,11 +184,11 @@ scm_quotient (SCM x, SCM y)
if (SCM_NINUMP (x)) if (SCM_NINUMP (x))
{ {
long w; long w;
SCM_GASSERT2 (SCM_NIMP (x) && SCM_BIGP (x), SCM_GASSERT2 (SCM_BIGP (x),
g_quotient, x, y, SCM_ARG1, s_quotient); g_quotient, x, y, SCM_ARG1, s_quotient);
if (SCM_NINUMP (y)) if (SCM_NINUMP (y))
{ {
SCM_ASRTGO (SCM_NIMP (y) && SCM_BIGP (y), bady); SCM_ASRTGO (SCM_BIGP (y), bady);
return scm_divbigbig (SCM_BDIGITS (x), SCM_NUMDIGS (x), return scm_divbigbig (SCM_BDIGITS (x), SCM_NUMDIGS (x),
SCM_BDIGITS (y), SCM_NUMDIGS (y), SCM_BDIGITS (y), SCM_NUMDIGS (y),
SCM_BIGSIGN (x) ^ SCM_BIGSIGN (y), 2); SCM_BIGSIGN (x) ^ SCM_BIGSIGN (y), 2);
@ -222,7 +222,7 @@ scm_quotient (SCM x, SCM y)
} }
if (SCM_NINUMP (y)) if (SCM_NINUMP (y))
{ {
if (!(SCM_NIMP (y) && SCM_BIGP (y))) if (!SCM_BIGP (y))
{ {
bady: bady:
SCM_WTA_DISPATCH_2 (g_quotient, x, y, SCM_ARG2, s_quotient); SCM_WTA_DISPATCH_2 (g_quotient, x, y, SCM_ARG2, s_quotient);
@ -273,11 +273,11 @@ scm_remainder (SCM x, SCM y)
#ifdef SCM_BIGDIG #ifdef SCM_BIGDIG
if (SCM_NINUMP (x)) if (SCM_NINUMP (x))
{ {
SCM_GASSERT2 (SCM_NIMP (x) && SCM_BIGP (x), SCM_GASSERT2 (SCM_BIGP (x),
g_remainder, x, y, SCM_ARG1, s_remainder); g_remainder, x, y, SCM_ARG1, s_remainder);
if (SCM_NINUMP (y)) if (SCM_NINUMP (y))
{ {
SCM_ASRTGO (SCM_NIMP (y) && SCM_BIGP (y), bady); SCM_ASRTGO (SCM_BIGP (y), bady);
return scm_divbigbig (SCM_BDIGITS (x), SCM_NUMDIGS (x), return scm_divbigbig (SCM_BDIGITS (x), SCM_NUMDIGS (x),
SCM_BDIGITS (y), SCM_NUMDIGS (y), SCM_BDIGITS (y), SCM_NUMDIGS (y),
SCM_BIGSIGN (x), 0); SCM_BIGSIGN (x), 0);
@ -288,7 +288,7 @@ scm_remainder (SCM x, SCM y)
} }
if (SCM_NINUMP (y)) if (SCM_NINUMP (y))
{ {
if (!(SCM_NIMP (y) && SCM_BIGP (y))) if (!SCM_BIGP (y))
{ {
bady: bady:
SCM_WTA_DISPATCH_2 (g_remainder, x, y, SCM_ARG2, s_remainder); SCM_WTA_DISPATCH_2 (g_remainder, x, y, SCM_ARG2, s_remainder);
@ -330,11 +330,11 @@ scm_modulo (SCM x, SCM y)
#ifdef SCM_BIGDIG #ifdef SCM_BIGDIG
if (SCM_NINUMP (x)) if (SCM_NINUMP (x))
{ {
SCM_GASSERT2 (SCM_NIMP (x) && SCM_BIGP (x), SCM_GASSERT2 (SCM_BIGP (x),
g_modulo, x, y, SCM_ARG1, s_modulo); g_modulo, x, y, SCM_ARG1, s_modulo);
if (SCM_NINUMP (y)) if (SCM_NINUMP (y))
{ {
SCM_ASRTGO (SCM_NIMP (y) && SCM_BIGP (y), bady); SCM_ASRTGO (SCM_BIGP (y), bady);
return scm_divbigbig (SCM_BDIGITS (x), SCM_NUMDIGS (x), return scm_divbigbig (SCM_BDIGITS (x), SCM_NUMDIGS (x),
SCM_BDIGITS (y), SCM_NUMDIGS (y), SCM_BDIGITS (y), SCM_NUMDIGS (y),
SCM_BIGSIGN (y), SCM_BIGSIGN (y),
@ -347,7 +347,7 @@ scm_modulo (SCM x, SCM y)
} }
if (SCM_NINUMP (y)) if (SCM_NINUMP (y))
{ {
if (!(SCM_NIMP (y) && SCM_BIGP (y))) if (!SCM_BIGP (y))
{ {
bady: bady:
SCM_WTA_DISPATCH_2 (g_modulo, x, y, SCM_ARG2, s_modulo); SCM_WTA_DISPATCH_2 (g_modulo, x, y, SCM_ARG2, s_modulo);
@ -385,14 +385,14 @@ scm_gcd (SCM x, SCM y)
if (SCM_NINUMP (x)) if (SCM_NINUMP (x))
{ {
big_gcd: big_gcd:
SCM_GASSERT2 (SCM_NIMP (x) && SCM_BIGP (x), SCM_GASSERT2 (SCM_BIGP (x),
g_gcd, x, y, SCM_ARG1, s_gcd); g_gcd, x, y, SCM_ARG1, s_gcd);
if (SCM_BIGSIGN (x)) if (SCM_BIGSIGN (x))
x = scm_copybig (x, 0); x = scm_copybig (x, 0);
newy: newy:
if (SCM_NINUMP (y)) if (SCM_NINUMP (y))
{ {
SCM_GASSERT2 (SCM_NIMP (y) && SCM_BIGP (y), SCM_GASSERT2 (SCM_BIGP (y),
g_gcd, x, y, SCM_ARGn, s_gcd); g_gcd, x, y, SCM_ARGn, s_gcd);
if (SCM_BIGSIGN (y)) if (SCM_BIGSIGN (y))
y = scm_copybig (y, 0); y = scm_copybig (y, 0);
@ -483,11 +483,11 @@ scm_lcm (SCM n1, SCM n2)
#else #else
SCM_GASSERT2 (SCM_INUMP (n1) SCM_GASSERT2 (SCM_INUMP (n1)
|| SCM_UNBNDP (n1) || SCM_UNBNDP (n1)
|| (SCM_NIMP (n1) && SCM_BIGP (n1)), || (SCM_BIGP (n1)),
g_lcm, n1, n2, SCM_ARG1, s_lcm); g_lcm, n1, n2, SCM_ARG1, s_lcm);
SCM_GASSERT2 (SCM_INUMP (n2) SCM_GASSERT2 (SCM_INUMP (n2)
|| SCM_UNBNDP (n2) || SCM_UNBNDP (n2)
|| (SCM_NIMP (n2) && SCM_BIGP (n2)), || (SCM_BIGP (n2)),
g_lcm, n1, n2, SCM_ARGn, s_lcm); g_lcm, n1, n2, SCM_ARGn, s_lcm);
#endif #endif
if (SCM_UNBNDP (n2)) if (SCM_UNBNDP (n2))
@ -1872,14 +1872,14 @@ GUILE_PROC (scm_number_to_string, "number->string", 1, 1, 0,
if (SCM_BIGP (x)) if (SCM_BIGP (x))
return big2str (x, (unsigned int) base); return big2str (x, (unsigned int) base);
#ifndef SCM_RECKLESS #ifndef SCM_RECKLESS
if (!(SCM_INEXP (x))) if (!SCM_INEXP (x))
{ {
badx: badx:
scm_wta (x, (char *) SCM_ARG1, FUNC_NAME); scm_wta (x, (char *) SCM_ARG1, FUNC_NAME);
} }
#endif #endif
#else #else
SCM_ASSERT (SCM_NIMP (x) && SCM_INEXP (x), SCM_ASSERT (SCM_INEXP (x),
x, SCM_ARG1, s_number_to_string); x, SCM_ARG1, s_number_to_string);
#endif #endif
return scm_makfromstr (num_buf, iflo2str (x, num_buf), 0); return scm_makfromstr (num_buf, iflo2str (x, num_buf), 0);
@ -1888,7 +1888,7 @@ GUILE_PROC (scm_number_to_string, "number->string", 1, 1, 0,
#ifdef SCM_BIGDIG #ifdef SCM_BIGDIG
if (SCM_NINUMP (x)) if (SCM_NINUMP (x))
{ {
SCM_ASSERT (SCM_NIMP (x) && SCM_BIGP (x), SCM_ASSERT (SCM_BIGP (x),
x, SCM_ARG1, s_number_to_string); x, SCM_ARG1, s_number_to_string);
return big2str (x, (unsigned int) base); return big2str (x, (unsigned int) base);
} }
@ -2355,7 +2355,7 @@ scm_istr2flo (char *str, long len, long radix)
{ /* polar input for complex number */ { /* polar input for complex number */
/* get a `real' for scm_angle */ /* get a `real' for scm_angle */
second = scm_istr2flo (&str[i], (long) (len - i), radix); second = scm_istr2flo (&str[i], (long) (len - i), radix);
if (!(SCM_NIMP (second) && SCM_INEXP (second))) if (!SCM_INEXP (second))
return SCM_BOOL_F; /* not `real' */ return SCM_BOOL_F; /* not `real' */
if (SCM_CPLXP (second)) if (SCM_CPLXP (second))
return SCM_BOOL_F; /* not `real' */ return SCM_BOOL_F; /* not `real' */
@ -2374,7 +2374,7 @@ scm_istr2flo (char *str, long len, long radix)
return scm_makdbl (res, lead_sgn); return scm_makdbl (res, lead_sgn);
/* get a `ureal' for complex part */ /* get a `ureal' for complex part */
second = scm_istr2flo (&str[i], (long) ((len - i) - 1), radix); second = scm_istr2flo (&str[i], (long) ((len - i) - 1), radix);
if (! (SCM_NIMP (second) && SCM_INEXP (second))) if (!SCM_INEXP (second))
return SCM_BOOL_F; /* not `ureal' */ return SCM_BOOL_F; /* not `ureal' */
if (SCM_CPLXP (second)) if (SCM_CPLXP (second))
return SCM_BOOL_F; /* not `ureal' */ return SCM_BOOL_F; /* not `ureal' */
@ -2550,11 +2550,11 @@ GUILE_PROC (scm_number_p, "complex?", 1, 0, 0,
if (SCM_INUMP (x)) if (SCM_INUMP (x))
return SCM_BOOL_T; return SCM_BOOL_T;
#ifdef SCM_FLOATS #ifdef SCM_FLOATS
if (SCM_NIMP (x) && SCM_NUMP (x)) if (SCM_NUMP (x))
return SCM_BOOL_T; return SCM_BOOL_T;
#else #else
#ifdef SCM_BIGDIG #ifdef SCM_BIGDIG
if (SCM_NIMP (x) && SCM_NUMP (x)) if (SCM_NUMP (x))
return SCM_BOOL_T; return SCM_BOOL_T;
#endif #endif
#endif #endif
@ -2624,7 +2624,7 @@ GUILE_PROC (scm_inexact_p, "inexact?", 1, 0, 0,
#define FUNC_NAME s_scm_inexact_p #define FUNC_NAME s_scm_inexact_p
{ {
#ifdef SCM_FLOATS #ifdef SCM_FLOATS
if (SCM_NIMP (x) && SCM_INEXP (x)) if (SCM_INEXP (x))
return SCM_BOOL_T; return SCM_BOOL_T;
#endif #endif
return SCM_BOOL_F; return SCM_BOOL_F;
@ -2644,7 +2644,7 @@ scm_num_eq_p (SCM x, SCM y)
if (SCM_NINUMP (x)) if (SCM_NINUMP (x))
{ {
#ifdef SCM_BIGDIG #ifdef SCM_BIGDIG
if (!(SCM_NIMP (x))) if (!SCM_NIMP (x))
{ {
badx: badx:
SCM_WTA_DISPATCH_2 (g_eq_p, x, y, SCM_ARG1, s_eq_p); SCM_WTA_DISPATCH_2 (g_eq_p, x, y, SCM_ARG1, s_eq_p);
@ -2664,7 +2664,7 @@ scm_num_eq_p (SCM x, SCM y)
} }
SCM_ASRTGO (SCM_INEXP (x), badx); SCM_ASRTGO (SCM_INEXP (x), badx);
#else #else
SCM_GASSERT2 (SCM_NIMP (x) && SCM_INEXP (x), SCM_GASSERT2 (SCM_INEXP (x),
g_eq_p, x, y, SCM_ARG1, s_eq_p); g_eq_p, x, y, SCM_ARG1, s_eq_p);
#endif #endif
if (SCM_INUMP (y)) if (SCM_INUMP (y))
@ -2685,7 +2685,7 @@ scm_num_eq_p (SCM x, SCM y)
} }
SCM_ASRTGO (SCM_INEXP (y), bady); SCM_ASRTGO (SCM_INEXP (y), bady);
#else #else
SCM_ASRTGO (SCM_NIMP (y) && SCM_INEXP (y), bady); SCM_ASRTGO (SCM_INEXP (y), bady);
#endif #endif
if (SCM_REALPART (x) != SCM_REALPART (y)) if (SCM_REALPART (x) != SCM_REALPART (y))
return SCM_BOOL_F; return SCM_BOOL_F;
@ -2701,13 +2701,13 @@ scm_num_eq_p (SCM x, SCM y)
SCM_ASRTGO (SCM_NIMP (y), bady); SCM_ASRTGO (SCM_NIMP (y), bady);
if (SCM_BIGP (y)) if (SCM_BIGP (y))
return SCM_BOOL_F; return SCM_BOOL_F;
if (!(SCM_INEXP (y))) if (!SCM_INEXP (y))
{ {
bady: bady:
SCM_WTA_DISPATCH_2 (g_eq_p, x, y, SCM_ARGn, s_eq_p); SCM_WTA_DISPATCH_2 (g_eq_p, x, y, SCM_ARGn, s_eq_p);
} }
#else #else
if (!(SCM_NIMP (y) && SCM_INEXP (y))) if (!SCM_INEXP (y))
{ {
bady: bady:
SCM_WTA_DISPATCH_2 (g_eq_p, x, y, SCM_ARGn, s_eq_p); SCM_WTA_DISPATCH_2 (g_eq_p, x, y, SCM_ARGn, s_eq_p);
@ -2722,16 +2722,16 @@ scm_num_eq_p (SCM x, SCM y)
#ifdef SCM_BIGDIG #ifdef SCM_BIGDIG
if (SCM_NINUMP (x)) if (SCM_NINUMP (x))
{ {
SCM_GASSERT2 (SCM_NIMP (x) && SCM_BIGP (x), SCM_GASSERT2 (SCM_BIGP (x),
g_eq_p, x, y, SCM_ARG1, s_eq_p); g_eq_p, x, y, SCM_ARG1, s_eq_p);
if (SCM_INUMP (y)) if (SCM_INUMP (y))
return SCM_BOOL_F; return SCM_BOOL_F;
SCM_ASRTGO (SCM_NIMP (y) && SCM_BIGP (y), bady); SCM_ASRTGO (SCM_BIGP (y), bady);
return SCM_BOOL(0 == scm_bigcomp (x, y)); return SCM_BOOL(0 == scm_bigcomp (x, y));
} }
if (SCM_NINUMP (y)) if (SCM_NINUMP (y))
{ {
if (!(SCM_NIMP (y) && SCM_BIGP (y))) if (!SCM_BIGP (y))
{ {
bady: bady:
SCM_WTA_DISPATCH_2 (g_eq_p, x, y, SCM_ARGn, s_eq_p); SCM_WTA_DISPATCH_2 (g_eq_p, x, y, SCM_ARGn, s_eq_p);
@ -2757,7 +2757,7 @@ scm_less_p (SCM x, SCM y)
if (SCM_NINUMP (x)) if (SCM_NINUMP (x))
{ {
#ifdef SCM_BIGDIG #ifdef SCM_BIGDIG
if (!(SCM_NIMP (x))) if (!SCM_NIMP (x))
{ {
badx: badx:
SCM_WTA_DISPATCH_2 (g_less_p, x, y, SCM_ARG1, s_less_p); SCM_WTA_DISPATCH_2 (g_less_p, x, y, SCM_ARG1, s_less_p);
@ -2776,7 +2776,7 @@ scm_less_p (SCM x, SCM y)
} }
SCM_ASRTGO (SCM_REALP (x), badx); SCM_ASRTGO (SCM_REALP (x), badx);
#else #else
SCM_GASSERT2 (SCM_NIMP (x) && SCM_REALP (x), SCM_GASSERT2 (SCM_REALP (x),
g_less_p, x, y, SCM_ARG1, s_less_p); g_less_p, x, y, SCM_ARG1, s_less_p);
#endif #endif
if (SCM_INUMP (y)) if (SCM_INUMP (y))
@ -2789,7 +2789,7 @@ scm_less_p (SCM x, SCM y)
return SCM_BOOL(SCM_REALPART (x) < scm_big2dbl (y)); return SCM_BOOL(SCM_REALPART (x) < scm_big2dbl (y));
SCM_ASRTGO (SCM_REALP (y), bady); SCM_ASRTGO (SCM_REALP (y), bady);
#else #else
SCM_ASRTGO (SCM_NIMP (y) && SCM_REALP (y), bady); SCM_ASRTGO (SCM_REALP (y), bady);
#endif #endif
return SCM_BOOL(SCM_REALPART (x) < SCM_REALPART (y)); return SCM_BOOL(SCM_REALPART (x) < SCM_REALPART (y));
} }
@ -2799,13 +2799,13 @@ scm_less_p (SCM x, SCM y)
SCM_ASRTGO (SCM_NIMP (y), bady); SCM_ASRTGO (SCM_NIMP (y), bady);
if (SCM_BIGP (y)) if (SCM_BIGP (y))
return SCM_NEGATE_BOOL(SCM_BIGSIGN (y)); return SCM_NEGATE_BOOL(SCM_BIGSIGN (y));
if (!(SCM_REALP (y))) if (!SCM_REALP (y))
{ {
bady: bady:
SCM_WTA_DISPATCH_2 (g_less_p, x, y, SCM_ARGn, s_less_p); SCM_WTA_DISPATCH_2 (g_less_p, x, y, SCM_ARGn, s_less_p);
} }
#else #else
if (!(SCM_NIMP (y) && SCM_REALP (y))) if (!SCM_REALP (y))
{ {
bady: bady:
SCM_WTA_DISPATCH_2 (g_less_p, x, y, SCM_ARGn, s_less_p); SCM_WTA_DISPATCH_2 (g_less_p, x, y, SCM_ARGn, s_less_p);
@ -2819,16 +2819,16 @@ scm_less_p (SCM x, SCM y)
#ifdef SCM_BIGDIG #ifdef SCM_BIGDIG
if (SCM_NINUMP (x)) if (SCM_NINUMP (x))
{ {
SCM_GASSERT2 (SCM_NIMP (x) && SCM_BIGP (x), SCM_GASSERT2 (SCM_BIGP (x),
g_less_p, x, y, SCM_ARG1, s_less_p); g_less_p, x, y, SCM_ARG1, s_less_p);
if (SCM_INUMP (y)) if (SCM_INUMP (y))
return SCM_BOOL(SCM_BIGSIGN (x)); return SCM_BOOL(SCM_BIGSIGN (x));
SCM_ASRTGO (SCM_NIMP (y) && SCM_BIGP (y), bady); SCM_ASRTGO (SCM_BIGP (y), bady);
return SCM_BOOL(1 == scm_bigcomp (x, y)); return SCM_BOOL(1 == scm_bigcomp (x, y));
} }
if (SCM_NINUMP (y)) if (SCM_NINUMP (y))
{ {
if (!(SCM_NIMP (y) && SCM_BIGP (y))) if (!SCM_BIGP (y))
{ {
bady: bady:
SCM_WTA_DISPATCH_2 (g_less_p, x, y, SCM_ARGn, s_less_p); SCM_WTA_DISPATCH_2 (g_less_p, x, y, SCM_ARGn, s_less_p);
@ -2889,13 +2889,13 @@ scm_zero_p (SCM z)
SCM_ASRTGO (SCM_NIMP (z), badz); SCM_ASRTGO (SCM_NIMP (z), badz);
if (SCM_BIGP (z)) if (SCM_BIGP (z))
return SCM_BOOL_F; return SCM_BOOL_F;
if (!(SCM_INEXP (z))) if (!SCM_INEXP (z))
{ {
badz: badz:
SCM_WTA_DISPATCH_1 (g_zero_p, z, SCM_ARG1, s_zero_p); SCM_WTA_DISPATCH_1 (g_zero_p, z, SCM_ARG1, s_zero_p);
} }
#else #else
SCM_GASSERT1 (SCM_NIMP (z) && SCM_INEXP (z), SCM_GASSERT1 (SCM_INEXP (z),
g_zero_p, z, SCM_ARG1, s_zero_p); g_zero_p, z, SCM_ARG1, s_zero_p);
#endif #endif
return SCM_BOOL(z == scm_flo0); return SCM_BOOL(z == scm_flo0);
@ -2904,7 +2904,7 @@ scm_zero_p (SCM z)
#ifdef SCM_BIGDIG #ifdef SCM_BIGDIG
if (SCM_NINUMP (z)) if (SCM_NINUMP (z))
{ {
SCM_GASSERT1 (SCM_NIMP (z) && SCM_BIGP (z), SCM_GASSERT1 (SCM_BIGP (z),
g_zero_p, z, SCM_ARG1, s_zero_p); g_zero_p, z, SCM_ARG1, s_zero_p);
return SCM_BOOL_F; return SCM_BOOL_F;
} }
@ -2929,13 +2929,13 @@ scm_positive_p (SCM x)
SCM_ASRTGO (SCM_NIMP (x), badx); SCM_ASRTGO (SCM_NIMP (x), badx);
if (SCM_BIGP (x)) if (SCM_BIGP (x))
return SCM_BOOL(SCM_TYP16 (x) == scm_tc16_bigpos); return SCM_BOOL(SCM_TYP16 (x) == scm_tc16_bigpos);
if (!(SCM_REALP (x))) if (!SCM_REALP (x))
{ {
badx: badx:
SCM_WTA_DISPATCH_1 (g_positive_p, x, SCM_ARG1, s_positive_p); SCM_WTA_DISPATCH_1 (g_positive_p, x, SCM_ARG1, s_positive_p);
} }
#else #else
SCM_GASSERT1 (SCM_NIMP (x) && SCM_REALP (x), SCM_GASSERT1 (SCM_REALP (x),
g_positive_p, x, SCM_ARG1, s_positive_p); g_positive_p, x, SCM_ARG1, s_positive_p);
#endif #endif
return SCM_BOOL(SCM_REALPART (x) > 0.0); return SCM_BOOL(SCM_REALPART (x) > 0.0);
@ -2944,7 +2944,7 @@ scm_positive_p (SCM x)
#ifdef SCM_BIGDIG #ifdef SCM_BIGDIG
if (SCM_NINUMP (x)) if (SCM_NINUMP (x))
{ {
SCM_GASSERT1 (SCM_NIMP (x) && SCM_BIGP (x), SCM_GASSERT1 (SCM_BIGP (x),
g_positive_p, x, SCM_ARG1, s_positive_p); g_positive_p, x, SCM_ARG1, s_positive_p);
return SCM_BOOL(SCM_TYP16 (x) == scm_tc16_bigpos); return SCM_BOOL(SCM_TYP16 (x) == scm_tc16_bigpos);
} }
@ -2975,7 +2975,7 @@ scm_negative_p (SCM x)
SCM_WTA_DISPATCH_1 (g_negative_p, x, SCM_ARG1, s_negative_p); SCM_WTA_DISPATCH_1 (g_negative_p, x, SCM_ARG1, s_negative_p);
} }
#else #else
SCM_GASSERT1 (SCM_NIMP (x) && SCM_REALP (x), SCM_GASSERT1 (SCM_REALP (x),
g_negative_p, x, SCM_ARG1, s_negative_p); g_negative_p, x, SCM_ARG1, s_negative_p);
#endif #endif
return SCM_BOOL(SCM_REALPART (x) < 0.0); return SCM_BOOL(SCM_REALPART (x) < 0.0);
@ -2984,7 +2984,7 @@ scm_negative_p (SCM x)
#ifdef SCM_BIGDIG #ifdef SCM_BIGDIG
if (SCM_NINUMP (x)) if (SCM_NINUMP (x))
{ {
SCM_GASSERT1 (SCM_NIMP (x) && SCM_BIGP (x), SCM_GASSERT1 (SCM_BIGP (x),
g_negative_p, x, SCM_ARG1, s_negative_p); g_negative_p, x, SCM_ARG1, s_negative_p);
return SCM_BOOL(SCM_TYP16 (x) == scm_tc16_bigneg); return SCM_BOOL(SCM_TYP16 (x) == scm_tc16_bigneg);
} }
@ -3033,7 +3033,7 @@ scm_max (SCM x, SCM y)
} }
SCM_ASRTGO (SCM_REALP (x), badx2); SCM_ASRTGO (SCM_REALP (x), badx2);
#else #else
SCM_GASSERT2 (SCM_NIMP (x) && SCM_REALP (x), SCM_GASSERT2 (SCM_REALP (x),
g_max, x, y, SCM_ARG1, s_max); g_max, x, y, SCM_ARG1, s_max);
#endif #endif
if (SCM_INUMP (y)) if (SCM_INUMP (y))
@ -3048,7 +3048,7 @@ scm_max (SCM x, SCM y)
: x); : x);
SCM_ASRTGO (SCM_REALP (y), bady); SCM_ASRTGO (SCM_REALP (y), bady);
#else #else
SCM_ASRTGO (SCM_NIMP (y) && SCM_REALP (y), bady); SCM_ASRTGO (SCM_REALP (y), bady);
#endif #endif
return (SCM_REALPART (x) < SCM_REALPART (y)) ? y : x; return (SCM_REALPART (x) < SCM_REALPART (y)) ? y : x;
} }
@ -3064,7 +3064,7 @@ scm_max (SCM x, SCM y)
SCM_WTA_DISPATCH_2 (g_max, x, y, SCM_ARGn, s_max); SCM_WTA_DISPATCH_2 (g_max, x, y, SCM_ARGn, s_max);
} }
#else #else
if (!(SCM_NIMP (y) && SCM_REALP (y))) if (!SCM_REALP (y))
{ {
bady: bady:
SCM_WTA_DISPATCH_2 (g_max, x, y, SCM_ARGn, s_max); SCM_WTA_DISPATCH_2 (g_max, x, y, SCM_ARGn, s_max);
@ -3078,16 +3078,16 @@ scm_max (SCM x, SCM y)
#ifdef SCM_BIGDIG #ifdef SCM_BIGDIG
if (SCM_NINUMP (x)) if (SCM_NINUMP (x))
{ {
SCM_GASSERT2 (SCM_NIMP (x) && SCM_BIGP (x), SCM_GASSERT2 (SCM_BIGP (x),
g_max, x, y, SCM_ARG1, s_max); g_max, x, y, SCM_ARG1, s_max);
if (SCM_INUMP (y)) if (SCM_INUMP (y))
return SCM_BIGSIGN (x) ? y : x; return SCM_BIGSIGN (x) ? y : x;
SCM_ASRTGO (SCM_NIMP (y) && SCM_BIGP (y), bady); SCM_ASRTGO (SCM_BIGP (y), bady);
return (1 == scm_bigcomp (x, y)) ? y : x; return (1 == scm_bigcomp (x, y)) ? y : x;
} }
if (SCM_NINUMP (y)) if (SCM_NINUMP (y))
{ {
if (!(SCM_NIMP (y) && SCM_BIGP (y))) if (!SCM_BIGP (y))
{ {
bady: bady:
SCM_WTA_DISPATCH_2 (g_max, x, y, SCM_ARGn, s_max); SCM_WTA_DISPATCH_2 (g_max, x, y, SCM_ARGn, s_max);
@ -3124,7 +3124,7 @@ scm_min (SCM x, SCM y)
if (SCM_NINUMP (x)) if (SCM_NINUMP (x))
{ {
#ifdef SCM_BIGDIG #ifdef SCM_BIGDIG
if (!(SCM_NIMP (x))) if (!SCM_NIMP (x))
{ {
badx2: badx2:
SCM_WTA_DISPATCH_2 (g_min, x, y, SCM_ARG1, s_min); SCM_WTA_DISPATCH_2 (g_min, x, y, SCM_ARG1, s_min);
@ -3142,7 +3142,7 @@ scm_min (SCM x, SCM y)
} }
SCM_ASRTGO (SCM_REALP (x), badx2); SCM_ASRTGO (SCM_REALP (x), badx2);
#else #else
SCM_GASSERT2 (SCM_NIMP (x) && SCM_REALP (x), SCM_GASSERT2 (SCM_REALP (x),
g_min, x, y, SCM_ARG1, s_min); g_min, x, y, SCM_ARG1, s_min);
#endif #endif
if (SCM_INUMP (y)) if (SCM_INUMP (y))
@ -3157,7 +3157,7 @@ scm_min (SCM x, SCM y)
: x); : x);
SCM_ASRTGO (SCM_REALP (y), bady); SCM_ASRTGO (SCM_REALP (y), bady);
#else #else
SCM_ASRTGO (SCM_NIMP (y) && SCM_REALP (y), bady); SCM_ASRTGO (SCM_REALP (y), bady);
#endif #endif
return (SCM_REALPART (x) > SCM_REALPART (y)) ? y : x; return (SCM_REALPART (x) > SCM_REALPART (y)) ? y : x;
} }
@ -3173,7 +3173,7 @@ scm_min (SCM x, SCM y)
SCM_WTA_DISPATCH_2 (g_min, x, y, SCM_ARGn, s_min); SCM_WTA_DISPATCH_2 (g_min, x, y, SCM_ARGn, s_min);
} }
#else #else
if (!(SCM_NIMP (y) && SCM_REALP (y))) if (!SCM_REALP (y))
{ {
bady: bady:
SCM_WTA_DISPATCH_2 (g_min, x, y, SCM_ARGn, s_min); SCM_WTA_DISPATCH_2 (g_min, x, y, SCM_ARGn, s_min);
@ -3187,16 +3187,16 @@ scm_min (SCM x, SCM y)
#ifdef SCM_BIGDIG #ifdef SCM_BIGDIG
if (SCM_NINUMP (x)) if (SCM_NINUMP (x))
{ {
SCM_GASSERT2 (SCM_NIMP (x) && SCM_BIGP (x), SCM_GASSERT2 (SCM_BIGP (x),
g_min, x, y, SCM_ARG1, s_min); g_min, x, y, SCM_ARG1, s_min);
if (SCM_INUMP (y)) if (SCM_INUMP (y))
return SCM_BIGSIGN (x) ? x : y; return SCM_BIGSIGN (x) ? x : y;
SCM_ASRTGO (SCM_NIMP (y) && SCM_BIGP (y), bady); SCM_ASRTGO (SCM_BIGP (y), bady);
return (-1 == scm_bigcomp (x, y)) ? y : x; return (-1 == scm_bigcomp (x, y)) ? y : x;
} }
if (SCM_NINUMP (y)) if (SCM_NINUMP (y))
{ {
if (!(SCM_NIMP (y) && SCM_BIGP (y))) if (!SCM_BIGP (y))
{ {
bady: bady:
SCM_WTA_DISPATCH_2 (g_min, x, y, SCM_ARGn, s_min); SCM_WTA_DISPATCH_2 (g_min, x, y, SCM_ARGn, s_min);
@ -3265,7 +3265,7 @@ scm_sum (SCM x, SCM y)
} }
SCM_ASRTGO (SCM_INEXP (x), badx2); SCM_ASRTGO (SCM_INEXP (x), badx2);
#else #else
SCM_ASRTGO (SCM_NIMP (x) && SCM_INEXP (x), badx2); SCM_ASRTGO (SCM_INEXP (x), badx2);
#endif #endif
if (SCM_INUMP (y)) if (SCM_INUMP (y))
{ {
@ -3283,13 +3283,13 @@ scm_sum (SCM x, SCM y)
y = t; y = t;
goto bigreal; goto bigreal;
} }
else if (!(SCM_INEXP (y))) else if (!SCM_INEXP (y))
{ {
bady: bady:
SCM_WTA_DISPATCH_2 (g_sum, x, y, SCM_ARGn, s_sum); SCM_WTA_DISPATCH_2 (g_sum, x, y, SCM_ARGn, s_sum);
} }
#else #else
if (!(SCM_NIMP (y) && SCM_INEXP (y))) if (!SCM_INEXP (y))
{ {
bady: bady:
SCM_WTA_DISPATCH_2 (g_sum, x, y, SCM_ARGn, s_sum); SCM_WTA_DISPATCH_2 (g_sum, x, y, SCM_ARGn, s_sum);
@ -3328,7 +3328,7 @@ scm_sum (SCM x, SCM y)
} }
SCM_ASRTGO (SCM_INEXP (y), bady); SCM_ASRTGO (SCM_INEXP (y), bady);
#else #else
SCM_ASRTGO (SCM_NIMP (y) && SCM_INEXP (y), bady); SCM_ASRTGO (SCM_INEXP (y), bady);
#endif #endif
intreal: intreal:
return scm_makdbl (SCM_INUM (x) + SCM_REALPART (y), return scm_makdbl (SCM_INUM (x) + SCM_REALPART (y),
@ -3339,7 +3339,7 @@ scm_sum (SCM x, SCM y)
if (SCM_NINUMP (x)) if (SCM_NINUMP (x))
{ {
SCM t; SCM t;
SCM_ASRTGO (SCM_NIMP (x) && SCM_BIGP (x), badx2); SCM_ASRTGO (SCM_BIGP (x), badx2);
if (SCM_INUMP (y)) if (SCM_INUMP (y))
{ {
t = x; t = x;
@ -3347,7 +3347,7 @@ scm_sum (SCM x, SCM y)
y = t; y = t;
goto intbig; goto intbig;
} }
SCM_ASRTGO (SCM_NIMP (y) && SCM_BIGP (y), bady); SCM_ASRTGO (SCM_BIGP (y), bady);
if (SCM_NUMDIGS (x) > SCM_NUMDIGS (y)) if (SCM_NUMDIGS (x) > SCM_NUMDIGS (y))
{ {
t = x; t = x;
@ -3359,7 +3359,7 @@ scm_sum (SCM x, SCM y)
} }
if (SCM_NINUMP (y)) if (SCM_NINUMP (y))
{ {
if (!(SCM_NIMP (y) && SCM_BIGP (y))) if (!SCM_BIGP (y))
{ {
bady: bady:
SCM_WTA_DISPATCH_2 (g_sum, x, y, SCM_ARGn, s_sum); SCM_WTA_DISPATCH_2 (g_sum, x, y, SCM_ARGn, s_sum);
@ -3463,7 +3463,7 @@ scm_difference (SCM x, SCM y)
SCM_ASRTGO (SCM_INEXP (y), bady); SCM_ASRTGO (SCM_INEXP (y), bady);
#else #else
SCM_ASRTGO (SCM_INEXP (x), badx2); SCM_ASRTGO (SCM_INEXP (x), badx2);
SCM_ASRTGO (SCM_NIMP (y) && SCM_INEXP (y), bady); SCM_ASRTGO (SCM_INEXP (y), bady);
#endif #endif
if (SCM_CPLXP (x)) if (SCM_CPLXP (x))
{ {
@ -3499,13 +3499,13 @@ scm_difference (SCM x, SCM y)
y, 0x0100); y, 0x0100);
#endif #endif
} }
if (!(SCM_INEXP (y))) if (!SCM_INEXP (y))
{ {
bady: bady:
SCM_WTA_DISPATCH_2 (g_difference, x, y, SCM_ARGn, s_difference); SCM_WTA_DISPATCH_2 (g_difference, x, y, SCM_ARGn, s_difference);
} }
#else #else
if (!(SCM_NIMP (y) && SCM_INEXP (y))) if (!SCM_INEXP (y))
{ {
bady: bady:
SCM_WTA_DISPATCH_2 (g_difference, x, y, SCM_ARGn, s_difference); SCM_WTA_DISPATCH_2 (g_difference, x, y, SCM_ARGn, s_difference);
@ -3518,7 +3518,7 @@ scm_difference (SCM x, SCM y)
#ifdef SCM_BIGDIG #ifdef SCM_BIGDIG
if (SCM_NINUMP (x)) if (SCM_NINUMP (x))
{ {
SCM_GASSERT2 (SCM_NIMP (x) && SCM_BIGP (x), SCM_GASSERT2 (SCM_BIGP (x),
g_difference, x, y, SCM_ARG1, s_difference); g_difference, x, y, SCM_ARG1, s_difference);
if (SCM_UNBNDP (y)) if (SCM_UNBNDP (y))
{ {
@ -3540,7 +3540,7 @@ scm_difference (SCM x, SCM y)
x, 0); x, 0);
#endif #endif
} }
SCM_ASRTGO (SCM_NIMP (y) && SCM_BIGP (y), bady); SCM_ASRTGO (SCM_BIGP (y), bady);
return (SCM_NUMDIGS (x) < SCM_NUMDIGS (y)) ? return (SCM_NUMDIGS (x) < SCM_NUMDIGS (y)) ?
scm_addbig (SCM_BDIGITS (x), SCM_NUMDIGS (x), SCM_BIGSIGN (x), scm_addbig (SCM_BDIGITS (x), SCM_NUMDIGS (x), SCM_BIGSIGN (x),
y, 0x0100) : y, 0x0100) :
@ -3554,7 +3554,7 @@ scm_difference (SCM x, SCM y)
} }
if (SCM_NINUMP (y)) if (SCM_NINUMP (y))
{ {
if (!(SCM_NIMP (y) && SCM_BIGP (y))) if (!SCM_BIGP (y))
{ {
bady: bady:
SCM_WTA_DISPATCH_2 (g_difference, x, y, SCM_ARGn, s_difference); SCM_WTA_DISPATCH_2 (g_difference, x, y, SCM_ARGn, s_difference);
@ -3647,7 +3647,7 @@ scm_product (SCM x, SCM y)
} }
SCM_ASRTGO (SCM_INEXP (x), badx2); SCM_ASRTGO (SCM_INEXP (x), badx2);
#else #else
SCM_ASRTGO (SCM_NIMP (x) && SCM_INEXP (x), badx2); SCM_ASRTGO (SCM_INEXP (x), badx2);
#endif #endif
if (SCM_INUMP (y)) if (SCM_INUMP (y))
{ {
@ -3671,7 +3671,7 @@ scm_product (SCM x, SCM y)
SCM_WTA_DISPATCH_2 (g_product, x, y, SCM_ARGn, s_product); SCM_WTA_DISPATCH_2 (g_product, x, y, SCM_ARGn, s_product);
} }
#else #else
if (!(SCM_NIMP (y) && SCM_INEXP (y))) if (!SCM_INEXP (y))
{ {
bady: bady:
SCM_WTA_DISPATCH_2 (g_product, x, y, SCM_ARGn, s_product); SCM_WTA_DISPATCH_2 (g_product, x, y, SCM_ARGn, s_product);
@ -3721,7 +3721,7 @@ scm_product (SCM x, SCM y)
} }
SCM_ASRTGO (SCM_INEXP (y), bady); SCM_ASRTGO (SCM_INEXP (y), bady);
#else #else
SCM_ASRTGO (SCM_NIMP (y) && SCM_INEXP (y), bady); SCM_ASRTGO (SCM_INEXP (y), bady);
#endif #endif
intreal: intreal:
return scm_makdbl (SCM_INUM (x) * SCM_REALPART (y), return scm_makdbl (SCM_INUM (x) * SCM_REALPART (y),
@ -3731,7 +3731,7 @@ scm_product (SCM x, SCM y)
#ifdef SCM_BIGDIG #ifdef SCM_BIGDIG
if (SCM_NINUMP (x)) if (SCM_NINUMP (x))
{ {
SCM_ASRTGO (SCM_NIMP (x) && SCM_BIGP (x), badx2); SCM_ASRTGO (SCM_BIGP (x), badx2);
if (SCM_INUMP (y)) if (SCM_INUMP (y))
{ {
SCM t = x; SCM t = x;
@ -3739,14 +3739,14 @@ scm_product (SCM x, SCM y)
y = t; y = t;
goto intbig; goto intbig;
} }
SCM_ASRTGO (SCM_NIMP (y) && SCM_BIGP (y), bady); SCM_ASRTGO (SCM_BIGP (y), bady);
return scm_mulbig (SCM_BDIGITS (x), SCM_NUMDIGS (x), return scm_mulbig (SCM_BDIGITS (x), SCM_NUMDIGS (x),
SCM_BDIGITS (y), SCM_NUMDIGS (y), SCM_BDIGITS (y), SCM_NUMDIGS (y),
SCM_BIGSIGN (x) ^ SCM_BIGSIGN (y)); SCM_BIGSIGN (x) ^ SCM_BIGSIGN (y));
} }
if (SCM_NINUMP (y)) if (SCM_NINUMP (y))
{ {
if (!(SCM_NIMP (y) && SCM_BIGP (y))) if (!SCM_BIGP (y))
{ {
bady: bady:
SCM_WTA_DISPATCH_2 (g_product, x, y, SCM_ARGn, s_product); SCM_WTA_DISPATCH_2 (g_product, x, y, SCM_ARGn, s_product);
@ -3942,7 +3942,7 @@ scm_divide (SCM x, SCM y)
} }
SCM_ASRTGO (SCM_INEXP (y), bady); SCM_ASRTGO (SCM_INEXP (y), bady);
#else #else
SCM_ASRTGO (SCM_NIMP (y) && SCM_INEXP (y), bady); SCM_ASRTGO (SCM_INEXP (y), bady);
#endif #endif
if (SCM_REALP (y)) if (SCM_REALP (y))
{ {
@ -3978,7 +3978,7 @@ scm_divide (SCM x, SCM y)
SCM_WTA_DISPATCH_2 (g_divide, x, y, SCM_ARGn, s_divide); SCM_WTA_DISPATCH_2 (g_divide, x, y, SCM_ARGn, s_divide);
} }
#else #else
if (!(SCM_NIMP (y) && SCM_INEXP (y))) if (!SCM_INEXP (y))
{ {
bady: bady:
SCM_WTA_DISPATCH_2 (g_divide, x, y, SCM_ARGn, s_divide); SCM_WTA_DISPATCH_2 (g_divide, x, y, SCM_ARGn, s_divide);
@ -3998,7 +3998,7 @@ scm_divide (SCM x, SCM y)
if (SCM_NINUMP (x)) if (SCM_NINUMP (x))
{ {
SCM z; SCM z;
SCM_GASSERT2 (SCM_NIMP (x) && SCM_BIGP (x), SCM_GASSERT2 (SCM_BIGP (x),
g_divide, x, y, SCM_ARG1, s_divide); g_divide, x, y, SCM_ARG1, s_divide);
if (SCM_UNBNDP (y)) if (SCM_UNBNDP (y))
goto ov; goto ov;
@ -4036,7 +4036,7 @@ scm_divide (SCM x, SCM y)
} }
else else
{ {
SCM_ASRTGO (SCM_NIMP (y) && SCM_BIGP (y), bady); SCM_ASRTGO (SCM_BIGP (y), bady);
z = scm_divbigbig (SCM_BDIGITS (x), SCM_NUMDIGS (x), z = scm_divbigbig (SCM_BDIGITS (x), SCM_NUMDIGS (x),
SCM_BDIGITS (y), SCM_NUMDIGS (y), SCM_BDIGITS (y), SCM_NUMDIGS (y),
SCM_BIGSIGN (x) ^ SCM_BIGSIGN (y), 3); SCM_BIGSIGN (x) ^ SCM_BIGSIGN (y), 3);
@ -4053,7 +4053,7 @@ scm_divide (SCM x, SCM y)
} }
if (SCM_NINUMP (y)) if (SCM_NINUMP (y))
{ {
if (!(SCM_NIMP (y) && SCM_BIGP (y))) if (!SCM_BIGP (y))
{ {
bady: bady:
SCM_WTA_DISPATCH_2 (g_divide, x, y, SCM_ARGn, s_divide); SCM_WTA_DISPATCH_2 (g_divide, x, y, SCM_ARGn, s_divide);
@ -4204,14 +4204,14 @@ scm_two_doubles (SCM z1, SCM z2, const char *sstring, struct dpair *xy)
else else
{ {
#ifndef SCM_RECKLESS #ifndef SCM_RECKLESS
if (!(SCM_REALP (z1))) if (!SCM_REALP (z1))
badz1:scm_wta (z1, (char *) SCM_ARG1, sstring); badz1:scm_wta (z1, (char *) SCM_ARG1, sstring);
#endif #endif
xy->x = SCM_REALPART (z1); xy->x = SCM_REALPART (z1);
} }
#else #else
{ {
SCM_ASSERT (SCM_NIMP (z1) && SCM_REALP (z1), z1, SCM_ARG1, sstring); SCM_ASSERT (SCM_REALP (z1), z1, SCM_ARG1, sstring);
xy->x = SCM_REALPART (z1); xy->x = SCM_REALPART (z1);
} }
#endif #endif
@ -4234,7 +4234,7 @@ scm_two_doubles (SCM z1, SCM z2, const char *sstring, struct dpair *xy)
} }
#else #else
{ {
SCM_ASSERT (SCM_NIMP (z2) && SCM_REALP (z2), z2, SCM_ARG2, sstring); SCM_ASSERT (SCM_REALP (z2), z2, SCM_ARG2, sstring);
xy->y = SCM_REALPART (z2); xy->y = SCM_REALPART (z2);
} }
#endif #endif
@ -4314,7 +4314,7 @@ scm_real_part (SCM z)
SCM_WTA_DISPATCH_1 (g_real_part, z, SCM_ARG1, s_real_part); SCM_WTA_DISPATCH_1 (g_real_part, z, SCM_ARG1, s_real_part);
} }
#else #else
SCM_GASSERT1 (SCM_NIMP (z) && SCM_INEXP (z), SCM_GASSERT1 (SCM_INEXP (z),
g_real_part, z, SCM_ARG1, s_real_part); g_real_part, z, SCM_ARG1, s_real_part);
#endif #endif
if (SCM_CPLXP (z)) if (SCM_CPLXP (z))
@ -4342,7 +4342,7 @@ scm_imag_part (SCM z)
SCM_WTA_DISPATCH_1 (g_imag_part, z, SCM_ARG1, s_imag_part); SCM_WTA_DISPATCH_1 (g_imag_part, z, SCM_ARG1, s_imag_part);
} }
#else #else
SCM_GASSERT1 (SCM_NIMP (z) && SCM_INEXP (z), SCM_GASSERT1 (SCM_INEXP (z),
g_imag_part, z, SCM_ARG1, s_imag_part); g_imag_part, z, SCM_ARG1, s_imag_part);
#endif #endif
if (SCM_CPLXP (z)) if (SCM_CPLXP (z))
@ -4369,7 +4369,7 @@ scm_magnitude (SCM z)
SCM_WTA_DISPATCH_1 (g_magnitude, z, SCM_ARG1, s_magnitude); SCM_WTA_DISPATCH_1 (g_magnitude, z, SCM_ARG1, s_magnitude);
} }
#else #else
SCM_GASSERT1 (SCM_NIMP (z) && SCM_INEXP (z), SCM_GASSERT1 (SCM_INEXP (z),
g_magnitude, z, SCM_ARG1, s_magnitude); g_magnitude, z, SCM_ARG1, s_magnitude);
#endif #endif
if (SCM_CPLXP (z)) if (SCM_CPLXP (z))
@ -4407,7 +4407,7 @@ scm_angle (SCM z)
SCM_WTA_DISPATCH_1 (g_angle, z, SCM_ARG1, s_angle); SCM_WTA_DISPATCH_1 (g_angle, z, SCM_ARG1, s_angle);
} }
#else #else
SCM_GASSERT1 (SCM_NIMP (z) && SCM_INEXP (z), g_angle, z, SCM_ARG1, s_angle); SCM_GASSERT1 (SCM_INEXP (z), g_angle, z, SCM_ARG1, s_angle);
#endif #endif
if (SCM_REALP (z)) if (SCM_REALP (z))
{ {

6
libguile/objects.c
View file

@ -364,7 +364,7 @@ GUILE_PROC (scm_entity_p, "entity?", 1, 0, 0,
"") "")
#define FUNC_NAME s_scm_entity_p #define FUNC_NAME s_scm_entity_p
{ {
return SCM_BOOL(SCM_NIMP (obj) && SCM_STRUCTP (obj) && SCM_I_ENTITYP (obj)); return SCM_BOOL(SCM_STRUCTP (obj) && SCM_I_ENTITYP (obj));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -385,7 +385,7 @@ GUILE_PROC (scm_set_object_procedure_x, "set-object-procedure!", 2, 0, 0,
"") "")
#define FUNC_NAME s_scm_set_object_procedure_x #define FUNC_NAME s_scm_set_object_procedure_x
{ {
SCM_ASSERT (SCM_NIMP (obj) && SCM_STRUCTP (obj) SCM_ASSERT (SCM_STRUCTP (obj)
&& ((SCM_CLASS_FLAGS (obj) & SCM_CLASSF_OPERATOR) && ((SCM_CLASS_FLAGS (obj) & SCM_CLASSF_OPERATOR)
|| (SCM_I_ENTITYP (obj) || (SCM_I_ENTITYP (obj)
&& !(SCM_OBJ_CLASS_FLAGS (obj) && !(SCM_OBJ_CLASS_FLAGS (obj)
@ -408,7 +408,7 @@ GUILE_PROC (scm_object_procedure, "object-procedure", 1, 0, 0,
"") "")
#define FUNC_NAME s_scm_object_procedure #define FUNC_NAME s_scm_object_procedure
{ {
SCM_ASSERT (SCM_NIMP (obj) && SCM_STRUCTP (obj) SCM_ASSERT (SCM_STRUCTP (obj)
&& ((SCM_CLASS_FLAGS (obj) & SCM_CLASSF_OPERATOR) && ((SCM_CLASS_FLAGS (obj) & SCM_CLASSF_OPERATOR)
|| SCM_I_ENTITYP (obj)), || SCM_I_ENTITYP (obj)),
obj, SCM_ARG1, FUNC_NAME); obj, SCM_ARG1, FUNC_NAME);

2
libguile/options.c
View file

@ -164,7 +164,7 @@ scm_options (SCM arg, scm_option options[], int n, const char *s)
flags[i] = (unsigned long) options[i].val; flags[i] = (unsigned long) options[i].val;
while (SCM_NNULLP (new_mode)) while (SCM_NNULLP (new_mode))
{ {
SCM_ASSERT (SCM_NIMP (new_mode) && SCM_CONSP (new_mode), SCM_ASSERT (SCM_CONSP (new_mode),
new_mode, new_mode,
SCM_ARG1, SCM_ARG1,
s); s);

6
libguile/ports.c
View file

@ -1043,7 +1043,7 @@ the current position of a port can be obtained using:
SCM_VALIDATE_INT_COPY(3,whence,how); SCM_VALIDATE_INT_COPY(3,whence,how);
if (how != SEEK_SET && how != SEEK_CUR && how != SEEK_END) if (how != SEEK_SET && how != SEEK_CUR && how != SEEK_END)
SCM_OUT_OF_RANGE (3, whence); SCM_OUT_OF_RANGE (3, whence);
if (SCM_NIMP (object) && SCM_OPPORTP (object)) if (SCM_OPPORTP (object))
{ {
scm_ptob_descriptor *ptob = scm_ptobs + SCM_PTOBNUM (object); scm_ptob_descriptor *ptob = scm_ptobs + SCM_PTOBNUM (object);
@ -1083,7 +1083,7 @@ The return value is unspecified.")
if (SCM_UNBNDP (length)) if (SCM_UNBNDP (length))
{ {
/* must supply length if object is a filename. */ /* must supply length if object is a filename. */
if (SCM_NIMP (object) && SCM_ROSTRINGP (object)) if (SCM_ROSTRINGP (object))
scm_wrong_num_args (SCM_FUNC_NAME); scm_wrong_num_args (SCM_FUNC_NAME);
length = scm_seek (object, SCM_INUM0, SCM_MAKINUM (SEEK_CUR)); length = scm_seek (object, SCM_INUM0, SCM_MAKINUM (SEEK_CUR));
@ -1097,7 +1097,7 @@ The return value is unspecified.")
{ {
SCM_SYSCALL (rv = ftruncate (SCM_INUM (object), c_length)); SCM_SYSCALL (rv = ftruncate (SCM_INUM (object), c_length));
} }
else if (SCM_NIMP (object) && SCM_OPOUTPORTP (object)) else if (SCM_OPOUTPORTP (object))
{ {
scm_port *pt = SCM_PTAB_ENTRY (object); scm_port *pt = SCM_PTAB_ENTRY (object);
scm_ptob_descriptor *ptob = scm_ptobs + SCM_PTOBNUM (object); scm_ptob_descriptor *ptob = scm_ptobs + SCM_PTOBNUM (object);

7
libguile/posix.c
View file

@ -845,7 +845,7 @@ scm_convert_exec_args (SCM args, int pos, const char *subr)
int i; int i;
SCM_ASSERT (SCM_NULLP (args) SCM_ASSERT (SCM_NULLP (args)
|| (SCM_NIMP (args) && SCM_CONSP (args)), || (SCM_CONSP (args)),
args, pos, subr); args, pos, subr);
num_args = scm_ilength (args); num_args = scm_ilength (args);
execargv = (char **) execargv = (char **)
@ -855,7 +855,7 @@ scm_convert_exec_args (SCM args, int pos, const char *subr)
scm_sizet len; scm_sizet len;
char *dst; char *dst;
char *src; char *src;
SCM_ASSERT (SCM_NIMP (SCM_CAR (args)) && SCM_ROSTRINGP (SCM_CAR (args)), SCM_ASSERT (SCM_ROSTRINGP (SCM_CAR (args)),
SCM_CAR (args), SCM_ARGn, subr); SCM_CAR (args), SCM_ARGn, subr);
len = 1 + SCM_ROLENGTH (SCM_CAR (args)); len = 1 + SCM_ROLENGTH (SCM_CAR (args));
dst = (char *) scm_must_malloc ((long) len, subr); dst = (char *) scm_must_malloc ((long) len, subr);
@ -923,8 +923,7 @@ environ_list_to_c (SCM envlist, int arg, const char *proc)
char **result; char **result;
int i = 0; int i = 0;
SCM_ASSERT (SCM_NULLP (envlist) SCM_ASSERT (SCM_NULLP (envlist) || SCM_CONSP (envlist),
|| (SCM_NIMP (envlist) && SCM_CONSP (envlist)),
envlist, arg, proc); envlist, arg, proc);
num_strings = scm_ilength (envlist); num_strings = scm_ilength (envlist);
result = (char **) malloc ((num_strings + 1) * sizeof (char *)); result = (char **) malloc ((num_strings + 1) * sizeof (char *));

6
libguile/print.c
View file

@ -417,7 +417,7 @@ taloop:
env = SCM_ENV (exp); env = SCM_ENV (exp);
scm_puts ("#<procedure", port); scm_puts ("#<procedure", port);
} }
if (SCM_NIMP (name) && SCM_ROSTRINGP (name)) if (SCM_ROSTRINGP (name))
{ {
scm_putc (' ', port); scm_putc (' ', port);
scm_puts (SCM_ROCHARS (name), port); scm_puts (SCM_ROCHARS (name), port);
@ -708,7 +708,7 @@ scm_prin1 (SCM exp, SCM port, int writingp)
/* If PORT is a print-state/port pair, use that. Else create a new /* If PORT is a print-state/port pair, use that. Else create a new
print-state. */ print-state. */
if (SCM_NIMP (port) && SCM_PORT_WITH_PS_P (port)) if (SCM_PORT_WITH_PS_P (port))
{ {
pstate_scm = SCM_PORT_WITH_PS_PS (port); pstate_scm = SCM_PORT_WITH_PS_PS (port);
port = SCM_PORT_WITH_PS_PORT (port); port = SCM_PORT_WITH_PS_PORT (port);
@ -794,7 +794,7 @@ scm_iprlist (char *hdr,SCM exp,int tlr,SCM port,scm_print_state *pstate)
O(depth * N) instead of O(N^2). */ O(depth * N) instead of O(N^2). */
hare = SCM_CDR (exp); hare = SCM_CDR (exp);
tortoise = exp; tortoise = exp;
while (SCM_NIMP (hare) && SCM_ECONSP (hare)) while (SCM_ECONSP (hare))
{ {
if (hare == tortoise) if (hare == tortoise)
goto fancy_printing; goto fancy_printing;

10
libguile/procprop.c
View file

@ -116,7 +116,7 @@ scm_i_procedure_arity (SCM proc)
proc = SCM_CAR (SCM_CODE (proc)); proc = SCM_CAR (SCM_CODE (proc));
if (SCM_IMP (proc)) if (SCM_IMP (proc))
break; break;
while (SCM_NIMP (proc) && SCM_CONSP (proc)) while (SCM_CONSP (proc))
{ {
++a; ++a;
proc = SCM_CDR (proc); proc = SCM_CDR (proc);
@ -169,7 +169,7 @@ GUILE_PROC(scm_procedure_properties, "procedure-properties", 1, 0, 0,
{ {
SCM_VALIDATE_PROC(1,proc); SCM_VALIDATE_PROC(1,proc);
return scm_acons (scm_sym_arity, scm_i_procedure_arity (proc), return scm_acons (scm_sym_arity, scm_i_procedure_arity (proc),
SCM_PROCPROPS (SCM_NIMP (proc) && SCM_CLOSUREP (proc) SCM_PROCPROPS (SCM_CLOSUREP (proc)
? proc ? proc
: scm_stand_in_scm_proc (proc))); : scm_stand_in_scm_proc (proc)));
} }
@ -180,7 +180,7 @@ GUILE_PROC(scm_set_procedure_properties_x, "set-procedure-properties!", 2, 0, 0,
"Set @var{obj}'s property list to @var{alist}.") "Set @var{obj}'s property list to @var{alist}.")
#define FUNC_NAME s_scm_set_procedure_properties_x #define FUNC_NAME s_scm_set_procedure_properties_x
{ {
if (!(SCM_NIMP (proc) && SCM_CLOSUREP (proc))) if (!SCM_CLOSUREP (proc))
proc = scm_stand_in_scm_proc(proc); proc = scm_stand_in_scm_proc(proc);
SCM_VALIDATE_CLOSURE(1,proc); SCM_VALIDATE_CLOSURE(1,proc);
SCM_SETPROCPROPS (proc, new_val); SCM_SETPROCPROPS (proc, new_val);
@ -203,7 +203,7 @@ GUILE_PROC(scm_procedure_property, "procedure-property", 2, 0, 0,
} }
SCM_VALIDATE_PROC(1,p); SCM_VALIDATE_PROC(1,p);
assoc = scm_sloppy_assq (k, assoc = scm_sloppy_assq (k,
SCM_PROCPROPS (SCM_NIMP (p) && SCM_CLOSUREP (p) SCM_PROCPROPS (SCM_CLOSUREP (p)
? p ? p
: scm_stand_in_scm_proc (p))); : scm_stand_in_scm_proc (p)));
return (SCM_NIMP (assoc) ? SCM_CDR (assoc) : SCM_BOOL_F); return (SCM_NIMP (assoc) ? SCM_CDR (assoc) : SCM_BOOL_F);
@ -217,7 +217,7 @@ GUILE_PROC(scm_set_procedure_property_x, "set-procedure-property!", 3, 0, 0,
#define FUNC_NAME s_scm_set_procedure_property_x #define FUNC_NAME s_scm_set_procedure_property_x
{ {
SCM assoc; SCM assoc;
if (!(SCM_NIMP (p) && SCM_CLOSUREP (p))) if (!SCM_CLOSUREP (p))
p = scm_stand_in_scm_proc(p); p = scm_stand_in_scm_proc(p);
SCM_VALIDATE_CLOSURE(1,p); SCM_VALIDATE_CLOSURE(1,p);
if (k == scm_sym_arity) if (k == scm_sym_arity)

4
libguile/procs.c
View file

@ -208,7 +208,7 @@ GUILE_PROC(scm_closure_p, "closure?", 1, 0, 0,
"") "")
#define FUNC_NAME s_scm_closure_p #define FUNC_NAME s_scm_closure_p
{ {
return SCM_BOOL(SCM_NIMP (obj) && SCM_CLOSUREP (obj)); return SCM_BOOL(SCM_CLOSUREP (obj));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -303,7 +303,7 @@ GUILE_PROC (scm_procedure_with_setter_p, "procedure-with-setter?", 1, 0, 0,
"") "")
#define FUNC_NAME s_scm_procedure_with_setter_p #define FUNC_NAME s_scm_procedure_with_setter_p
{ {
return SCM_BOOL(SCM_NIMP (obj) && SCM_PROCEDURE_WITH_SETTER_P (obj)); return SCM_BOOL(SCM_PROCEDURE_WITH_SETTER_P (obj));
} }
#undef FUNC_NAME #undef FUNC_NAME

14
libguile/ramap.c
View file

@ -539,7 +539,7 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore)
case scm_tc7_fvect: case scm_tc7_fvect:
{ /* scope */ { /* scope */
float f, *ve = (float *) SCM_VELTS (ra); float f, *ve = (float *) SCM_VELTS (ra);
SCM_ASRTGO (SCM_NIMP (fill) && SCM_REALP (fill), badarg2); SCM_ASRTGO (SCM_REALP (fill), badarg2);
f = SCM_REALPART (fill); f = SCM_REALPART (fill);
for (i = base; n--; i += inc) for (i = base; n--; i += inc)
ve[i] = f; ve[i] = f;
@ -549,7 +549,7 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore)
case scm_tc7_dvect: case scm_tc7_dvect:
{ /* scope */ { /* scope */
double f, *ve = (double *) SCM_VELTS (ra); double f, *ve = (double *) SCM_VELTS (ra);
SCM_ASRTGO (SCM_NIMP (fill) && SCM_REALP (fill), badarg2); SCM_ASRTGO (SCM_REALP (fill), badarg2);
f = SCM_REALPART (fill); f = SCM_REALPART (fill);
for (i = base; n--; i += inc) for (i = base; n--; i += inc)
ve[i] = f; ve[i] = f;
@ -559,7 +559,7 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore)
{ /* scope */ { /* scope */
double fr, fi; double fr, fi;
double (*ve)[2] = (double (*)[2]) SCM_VELTS (ra); double (*ve)[2] = (double (*)[2]) SCM_VELTS (ra);
SCM_ASRTGO (SCM_NIMP (fill) && SCM_INEXP (fill), badarg2); SCM_ASRTGO (SCM_INEXP (fill), badarg2);
fr = SCM_REALPART (fill); fr = SCM_REALPART (fill);
fi = (SCM_CPLXP (fill) ? SCM_IMAG (fill) : 0.0); fi = (SCM_CPLXP (fill) ? SCM_IMAG (fill) : 0.0);
for (i = base; n--; i += inc) for (i = base; n--; i += inc)
@ -1656,7 +1656,7 @@ unspecified. The order of application is unspecified.")
if (SCM_INUMP(fill)) if (SCM_INUMP(fill))
{ {
prot = scm_array_prototype (ra0); prot = scm_array_prototype (ra0);
if (SCM_NIMP (prot) && SCM_INEXP (prot)) if (SCM_INEXP (prot))
fill = scm_makdbl ((double) SCM_INUM (fill), 0.0); fill = scm_makdbl ((double) SCM_INUM (fill), 0.0);
} }
@ -1665,18 +1665,18 @@ unspecified. The order of application is unspecified.")
else else
{ {
SCM tail, ra1 = SCM_CAR (lra); SCM tail, ra1 = SCM_CAR (lra);
SCM v0 = (SCM_NIMP (ra0) && SCM_ARRAYP (ra0) ? SCM_ARRAY_V (ra0) : ra0); SCM v0 = (SCM_ARRAYP (ra0) ? SCM_ARRAY_V (ra0) : ra0);
ra_iproc *p; ra_iproc *p;
/* Check to see if order might matter. /* Check to see if order might matter.
This might be an argument for a separate This might be an argument for a separate
SERIAL-ARRAY-MAP! */ SERIAL-ARRAY-MAP! */
if (v0 == ra1 || (SCM_NIMP (ra1) && SCM_ARRAYP (ra1) && v0 == SCM_ARRAY_V (ra1))) if (v0 == ra1 || (SCM_ARRAYP (ra1) && v0 == SCM_ARRAY_V (ra1)))
if (ra0 != ra1 || (SCM_ARRAYP(ra0) && !SCM_ARRAY_CONTP(ra0))) if (ra0 != ra1 || (SCM_ARRAYP(ra0) && !SCM_ARRAY_CONTP(ra0)))
goto gencase; goto gencase;
for (tail = SCM_CDR (lra); SCM_NNULLP (tail); tail = SCM_CDR (tail)) for (tail = SCM_CDR (lra); SCM_NNULLP (tail); tail = SCM_CDR (tail))
{ {
ra1 = SCM_CAR (tail); ra1 = SCM_CAR (tail);
if (v0 == ra1 || (SCM_NIMP (ra1) && SCM_ARRAYP (ra1) && v0 == SCM_ARRAY_V (ra1))) if (v0 == ra1 || (SCM_ARRAYP (ra1) && v0 == SCM_ARRAY_V (ra1)))
goto gencase; goto gencase;
} }
for (p = ra_asubrs; p->name; p++) for (p = ra_asubrs; p->name; p++)

2
libguile/random.c
View file

@ -196,7 +196,7 @@ scm_rstate *
scm_c_default_rstate () scm_c_default_rstate ()
{ {
SCM state = SCM_CDR (scm_var_random_state); SCM state = SCM_CDR (scm_var_random_state);
SCM_ASSERT (SCM_NIMP (state) && SCM_RSTATEP (state), SCM_ASSERT (SCM_RSTATEP (state),
state, "*random-state* contains bogus random state", 0); state, "*random-state* contains bogus random state", 0);
return SCM_RSTATE (state); return SCM_RSTATE (state);
} }

10
libguile/read.c
View file

@ -197,7 +197,7 @@ recsexpr (SCM obj,int line,int column,SCM filename)
{ {
copy = scm_cons (recsexpr (SCM_CAR (obj), line, column, filename), copy = scm_cons (recsexpr (SCM_CAR (obj), line, column, filename),
SCM_UNDEFINED); SCM_UNDEFINED);
while (SCM_NIMP (tmp = SCM_CDR (tmp)) && SCM_CONSP (tmp)) while ((tmp = SCM_CDR (tmp)) && SCM_CONSP (tmp))
{ {
SCM_SETCDR (copy, scm_cons (recsexpr (SCM_CAR (tmp), SCM_SETCDR (copy, scm_cons (recsexpr (SCM_CAR (tmp),
line, line,
@ -211,7 +211,7 @@ recsexpr (SCM obj,int line,int column,SCM filename)
else else
{ {
recsexpr (SCM_CAR (obj), line, column, filename); recsexpr (SCM_CAR (obj), line, column, filename);
while (SCM_NIMP (tmp = SCM_CDR (tmp)) && SCM_CONSP (tmp)) while ((tmp = SCM_CDR (tmp)) && SCM_CONSP (tmp))
recsexpr (SCM_CAR (tmp), line, column, filename); recsexpr (SCM_CAR (tmp), line, column, filename);
copy = SCM_UNDEFINED; copy = SCM_UNDEFINED;
} }
@ -657,7 +657,7 @@ scm_lreadrecparen (SCM *tok_buf, SCM port, char *name, SCM *copy)
/* Build the head of the list structure. */ /* Build the head of the list structure. */
ans = tl = scm_cons (tmp, SCM_EOL); ans = tl = scm_cons (tmp, SCM_EOL);
if (SCM_COPY_SOURCE_P) if (SCM_COPY_SOURCE_P)
ans2 = tl2 = scm_cons (SCM_NIMP (tmp) && SCM_CONSP (tmp) ans2 = tl2 = scm_cons (SCM_CONSP (tmp)
? *copy ? *copy
: tmp, : tmp,
SCM_EOL); SCM_EOL);
@ -668,7 +668,7 @@ scm_lreadrecparen (SCM *tok_buf, SCM port, char *name, SCM *copy)
{ {
SCM_SETCDR (tl, tmp = scm_lreadr (tok_buf, port, copy)); SCM_SETCDR (tl, tmp = scm_lreadr (tok_buf, port, copy));
if (SCM_COPY_SOURCE_P) if (SCM_COPY_SOURCE_P)
SCM_SETCDR (tl2, scm_cons (SCM_NIMP (tmp) && SCM_CONSP (tmp) SCM_SETCDR (tl2, scm_cons (SCM_CONSP (tmp)
? *copy ? *copy
: tmp, : tmp,
SCM_EOL)); SCM_EOL));
@ -678,7 +678,7 @@ scm_lreadrecparen (SCM *tok_buf, SCM port, char *name, SCM *copy)
} }
tl = SCM_SETCDR (tl, scm_cons (tmp, SCM_EOL)); tl = SCM_SETCDR (tl, scm_cons (tmp, SCM_EOL));
if (SCM_COPY_SOURCE_P) if (SCM_COPY_SOURCE_P)
tl2 = SCM_SETCDR (tl2, scm_cons (SCM_NIMP (tmp) && SCM_CONSP (tmp) tl2 = SCM_SETCDR (tl2, scm_cons (SCM_CONSP (tmp)
? *copy ? *copy
: tmp, : tmp,
SCM_EOL)); SCM_EOL));

2
libguile/regex-posix.c
View file

@ -139,7 +139,7 @@ GUILE_PROC (scm_regexp_p, "regexp?", 1, 0, 0,
@code{#f} otherwise.") @code{#f} otherwise.")
#define FUNC_NAME s_scm_regexp_p #define FUNC_NAME s_scm_regexp_p
{ {
return SCM_BOOL(SCM_NIMP (x) && SCM_RGXP (x)); return SCM_BOOL(SCM_RGXP (x));
} }
#undef FUNC_NAME #undef FUNC_NAME

2
libguile/root.c
View file

@ -119,7 +119,7 @@ scm_make_root (SCM parent)
root_state = (scm_root_state *) scm_must_malloc (sizeof (scm_root_state), root_state = (scm_root_state *) scm_must_malloc (sizeof (scm_root_state),
"scm_make_root"); "scm_make_root");
if (SCM_NIMP (parent) && SCM_ROOTP (parent)) if (SCM_ROOTP (parent))
{ {
memcpy (root_state, SCM_ROOT_STATE (parent), sizeof (scm_root_state)); memcpy (root_state, SCM_ROOT_STATE (parent), sizeof (scm_root_state));
scm_copy_fluids (root_state); scm_copy_fluids (root_state);

5
libguile/scm_validate.h
View file

@ -1,4 +1,4 @@
/* $Id: scm_validate.h,v 1.6 1999-12-13 00:52:43 gjb Exp $ */ /* $Id: scm_validate.h,v 1.7 1999-12-16 20:48:04 gjb Exp $ */
/* Copyright (C) 1999 Free Software Foundation, Inc. /* Copyright (C) 1999 Free Software Foundation, Inc.
* *
* This program is free software; you can redistribute it and/or modify * This program is free software; you can redistribute it and/or modify
@ -223,6 +223,9 @@
do { SCM_ASSERT (SCM_NIMP (a) && SCM_ASYNCP (a), a, pos, FUNC_NAME); \ do { SCM_ASSERT (SCM_NIMP (a) && SCM_ASYNCP (a), a, pos, FUNC_NAME); \
cvar = SCM_ASYNC(a); } while (0) cvar = SCM_ASYNC(a); } while (0)
#define SCM_VALIDATE_THREAD(pos,a) \
do { SCM_ASSERT (SCM_NIMP (a) && SCM_THREADP (a), a, pos, FUNC_NAME); } while (0)
#define SCM_VALIDATE_THUNK(pos,thunk) \ #define SCM_VALIDATE_THUNK(pos,thunk) \
do { SCM_ASSERT (SCM_NFALSEP (scm_thunk_p (thunk)), thunk, pos, FUNC_NAME); } while (0) do { SCM_ASSERT (SCM_NFALSEP (scm_thunk_p (thunk)), thunk, pos, FUNC_NAME); } while (0)

8
libguile/socket.c
View file

@ -309,7 +309,7 @@ The return value is unspecified.")
{ {
#ifdef HAVE_STRUCT_LINGER #ifdef HAVE_STRUCT_LINGER
struct linger ling; struct linger ling;
SCM_ASSERT (SCM_NIMP (value) && SCM_CONSP (value) SCM_ASSERT (SCM_CONSP (value)
&& SCM_INUMP (SCM_CAR (value)) && SCM_INUMP (SCM_CAR (value))
&& SCM_INUMP (SCM_CDR (value)), && SCM_INUMP (SCM_CDR (value)),
value, SCM_ARG4, FUNC_NAME); value, SCM_ARG4, FUNC_NAME);
@ -319,7 +319,7 @@ The return value is unspecified.")
memcpy (optval, (void *) &ling, optlen); memcpy (optval, (void *) &ling, optlen);
#else #else
scm_sizet ling; scm_sizet ling;
SCM_ASSERT (SCM_NIMP (value) && SCM_CONSP (value) SCM_ASSERT (SCM_CONSP (value)
&& SCM_INUMP (SCM_CAR (value)) && SCM_INUMP (SCM_CAR (value))
&& SCM_INUMP (SCM_CDR (value)), && SCM_INUMP (SCM_CDR (value)),
value, SCM_ARG4, FUNC_NAME); value, SCM_ARG4, FUNC_NAME);
@ -416,7 +416,7 @@ scm_fill_sockaddr (int fam,SCM address,SCM *args,int which_arg,const char *proc,
soka->sin_family = AF_INET; soka->sin_family = AF_INET;
soka->sin_addr.s_addr = soka->sin_addr.s_addr =
htonl (scm_num2ulong (address, (char *) which_arg, proc)); htonl (scm_num2ulong (address, (char *) which_arg, proc));
SCM_ASSERT (SCM_NIMP (*args) && SCM_CONSP (*args), *args, SCM_ASSERT (SCM_CONSP (*args), *args,
which_arg + 1, proc); which_arg + 1, proc);
isport = SCM_CAR (*args); isport = SCM_CAR (*args);
*args = SCM_CDR (*args); *args = SCM_CDR (*args);
@ -434,7 +434,7 @@ scm_fill_sockaddr (int fam,SCM address,SCM *args,int which_arg,const char *proc,
scm_must_malloc (sizeof (struct sockaddr_un), proc); scm_must_malloc (sizeof (struct sockaddr_un), proc);
memset (soka, 0, sizeof (struct sockaddr_un)); memset (soka, 0, sizeof (struct sockaddr_un));
soka->sun_family = AF_UNIX; soka->sun_family = AF_UNIX;
SCM_ASSERT (SCM_NIMP (address) && SCM_ROSTRINGP (address), address, SCM_ASSERT (SCM_ROSTRINGP (address), address,
which_arg, proc); which_arg, proc);
memcpy (soka->sun_path, SCM_ROCHARS (address), memcpy (soka->sun_path, SCM_ROCHARS (address),
1 + SCM_ROLENGTH (address)); 1 + SCM_ROLENGTH (address));

12
libguile/srcprop.c
View file

@ -261,7 +261,7 @@ GUILE_PROC (scm_set_source_property_x, "set-source-property!", 3, 0, 0,
if (scm_sym_breakpoint == key) if (scm_sym_breakpoint == key)
{ {
if (SCM_FALSEP (datum)) if (SCM_FALSEP (datum))
CLEARSRCPROPBRK (SCM_NIMP (p) && SRCPROPSP (p) CLEARSRCPROPBRK (SRCPROPSP (p)
? p ? p
: SCM_WHASHSET (scm_source_whash, h, : SCM_WHASHSET (scm_source_whash, h,
scm_make_srcprops (0, scm_make_srcprops (0,
@ -270,7 +270,7 @@ GUILE_PROC (scm_set_source_property_x, "set-source-property!", 3, 0, 0,
SCM_UNDEFINED, SCM_UNDEFINED,
p))); p)));
else else
SETSRCPROPBRK (SCM_NIMP (p) && SRCPROPSP (p) SETSRCPROPBRK (SRCPROPSP (p)
? p ? p
: SCM_WHASHSET (scm_source_whash, h, : SCM_WHASHSET (scm_source_whash, h,
scm_make_srcprops (0, scm_make_srcprops (0,
@ -282,7 +282,7 @@ GUILE_PROC (scm_set_source_property_x, "set-source-property!", 3, 0, 0,
else if (scm_sym_line == key) else if (scm_sym_line == key)
{ {
SCM_VALIDATE_INT(3,datum); SCM_VALIDATE_INT(3,datum);
if (SCM_NIMP (p) && SRCPROPSP (p)) if (SRCPROPSP (p))
SETSRCPROPLINE (p, SCM_INUM (datum)); SETSRCPROPLINE (p, SCM_INUM (datum));
else else
SCM_WHASHSET (scm_source_whash, h, SCM_WHASHSET (scm_source_whash, h,
@ -292,7 +292,7 @@ GUILE_PROC (scm_set_source_property_x, "set-source-property!", 3, 0, 0,
else if (scm_sym_column == key) else if (scm_sym_column == key)
{ {
SCM_VALIDATE_INT(3,datum); SCM_VALIDATE_INT(3,datum);
if (SCM_NIMP (p) && SRCPROPSP (p)) if (SRCPROPSP (p))
SETSRCPROPCOL (p, SCM_INUM (datum)); SETSRCPROPCOL (p, SCM_INUM (datum));
else else
SCM_WHASHSET (scm_source_whash, h, SCM_WHASHSET (scm_source_whash, h,
@ -301,14 +301,14 @@ GUILE_PROC (scm_set_source_property_x, "set-source-property!", 3, 0, 0,
} }
else if (scm_sym_filename == key) else if (scm_sym_filename == key)
{ {
if (SCM_NIMP (p) && SRCPROPSP (p)) if (SRCPROPSP (p))
SRCPROPFNAME (p) = datum; SRCPROPFNAME (p) = datum;
else else
SCM_WHASHSET (scm_source_whash, h, scm_make_srcprops (0, 0, datum, SCM_UNDEFINED, p)); SCM_WHASHSET (scm_source_whash, h, scm_make_srcprops (0, 0, datum, SCM_UNDEFINED, p));
} }
else if (scm_sym_filename == key) else if (scm_sym_filename == key)
{ {
if (SCM_NIMP (p) && SRCPROPSP (p)) if (SRCPROPSP (p))
SRCPROPCOPY (p) = datum; SRCPROPCOPY (p) = datum;
else else
SCM_WHASHSET (scm_source_whash, h, scm_make_srcprops (0, 0, SCM_UNDEFINED, datum, p)); SCM_WHASHSET (scm_source_whash, h, scm_make_srcprops (0, 0, SCM_UNDEFINED, datum, p));

12
libguile/stacks.c
View file

@ -226,7 +226,7 @@ static SCM
get_applybody () get_applybody ()
{ {
SCM proc = SCM_CDR (scm_sym2vcell (scm_sym_apply, SCM_BOOL_F, SCM_BOOL_F)); SCM proc = SCM_CDR (scm_sym2vcell (scm_sym_apply, SCM_BOOL_F, SCM_BOOL_F));
if (SCM_NIMP (proc) && SCM_CLOSUREP (proc)) if (SCM_CLOSUREP (proc))
return SCM_CADR (SCM_CODE (proc)); return SCM_CADR (SCM_CODE (proc));
else else
return SCM_UNDEFINED; return SCM_UNDEFINED;
@ -415,7 +415,7 @@ GUILE_PROC (scm_stack_p, "stack?", 1, 0, 0,
"Return @code{#t} if @var{obj} is a calling stack.") "Return @code{#t} if @var{obj} is a calling stack.")
#define FUNC_NAME s_scm_stack_p #define FUNC_NAME s_scm_stack_p
{ {
return SCM_BOOL(SCM_NIMP (obj) && SCM_STACKP (obj)); return SCM_BOOL(SCM_STACKP (obj));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -431,7 +431,7 @@ GUILE_PROC (scm_make_stack, "make-stack", 0, 0, 1,
SCM stack, id; SCM stack, id;
SCM obj, inner_cut, outer_cut; SCM obj, inner_cut, outer_cut;
SCM_ASSERT (SCM_NIMP (args) && SCM_CONSP (args), SCM_ASSERT (SCM_CONSP (args),
SCM_FUNC_NAME, SCM_WNA, NULL); SCM_FUNC_NAME, SCM_WNA, NULL);
obj = SCM_CAR (args); obj = SCM_CAR (args);
args = SCM_CDR (args); args = SCM_CDR (args);
@ -480,11 +480,11 @@ GUILE_PROC (scm_make_stack, "make-stack", 0, 0, 1,
SCM_STACK (stack) -> length = n; SCM_STACK (stack) -> length = n;
/* Narrow the stack according to the arguments given to scm_make_stack. */ /* Narrow the stack according to the arguments given to scm_make_stack. */
while (n > 0 && SCM_NIMP (args) && SCM_CONSP (args)) while (n > 0 && SCM_CONSP (args))
{ {
inner_cut = SCM_CAR (args); inner_cut = SCM_CAR (args);
args = SCM_CDR (args); args = SCM_CDR (args);
if (SCM_NIMP (args) && SCM_CONSP (args)) if (SCM_CONSP (args))
{ {
outer_cut = SCM_CAR (args); outer_cut = SCM_CAR (args);
args = SCM_CDR (args); args = SCM_CDR (args);
@ -580,7 +580,7 @@ GUILE_PROC (scm_frame_p, "frame?", 1, 0, 0,
"") "")
#define FUNC_NAME s_scm_frame_p #define FUNC_NAME s_scm_frame_p
{ {
return SCM_BOOL(SCM_NIMP (obj) && SCM_FRAMEP (obj)); return SCM_BOOL(SCM_FRAMEP (obj));
} }
#undef FUNC_NAME #undef FUNC_NAME

7
libguile/stime.c
View file

@ -311,7 +311,7 @@ setzone (SCM zone, int pos, const char *subr)
char *buf; char *buf;
/* if zone was supplied, set the environment temporarily. */ /* if zone was supplied, set the environment temporarily. */
SCM_ASSERT (SCM_NIMP (zone) && SCM_ROSTRINGP (zone), zone, pos, subr); SCM_ASSERT (SCM_ROSTRINGP (zone), zone, pos, subr);
SCM_COERCE_SUBSTR (zone); SCM_COERCE_SUBSTR (zone);
buf = scm_must_malloc (SCM_LENGTH (zone) + sizeof (tzvar) + 1, buf = scm_must_malloc (SCM_LENGTH (zone) + sizeof (tzvar) + 1,
subr); subr);
@ -436,7 +436,7 @@ bdtime2c (SCM sbd_time, struct tm *lt, int pos, const char *subr)
SCM *velts; SCM *velts;
int i; int i;
SCM_ASSERT (SCM_NIMP (sbd_time) && SCM_VECTORP (sbd_time) SCM_ASSERT (SCM_VECTORP (sbd_time)
&& SCM_LENGTH (sbd_time) == 11, && SCM_LENGTH (sbd_time) == 11,
sbd_time, pos, subr); sbd_time, pos, subr);
velts = SCM_VELTS (sbd_time); velts = SCM_VELTS (sbd_time);
@ -444,8 +444,7 @@ bdtime2c (SCM sbd_time, struct tm *lt, int pos, const char *subr)
{ {
SCM_ASSERT (SCM_INUMP (velts[i]), sbd_time, pos, subr); SCM_ASSERT (SCM_INUMP (velts[i]), sbd_time, pos, subr);
} }
SCM_ASSERT (SCM_FALSEP (velts[10]) SCM_ASSERT (SCM_FALSEP (velts[10]) || SCM_STRINGP (velts[10]),
|| (SCM_NIMP (velts[10]) && SCM_STRINGP (velts[10])),
sbd_time, pos, subr); sbd_time, pos, subr);
lt->tm_sec = SCM_INUM (velts[0]); lt->tm_sec = SCM_INUM (velts[0]);

2
libguile/strings.c
View file

@ -114,7 +114,7 @@ GUILE_PROC(scm_string, "string", 0, 0, 1,
for (len = 0, s = chrs; s != SCM_EOL; s = SCM_CDR (s)) for (len = 0, s = chrs; s != SCM_EOL; s = SCM_CDR (s))
if (SCM_ICHRP (SCM_CAR (s))) if (SCM_ICHRP (SCM_CAR (s)))
len += 1; len += 1;
else if (SCM_NIMP (SCM_CAR (s)) && SCM_ROSTRINGP (SCM_CAR (s))) else if (SCM_ROSTRINGP (SCM_CAR (s)))
len += SCM_ROLENGTH (SCM_CAR (s)); len += SCM_ROLENGTH (SCM_CAR (s));
else else
{ {

2
libguile/strop.c
View file

@ -44,7 +44,7 @@ scm_i_index (SCM *str, SCM chr, int direction, SCM sub_start,
int upper; int upper;
int ch; int ch;
SCM_ASSERT (SCM_NIMP (*str) && SCM_ROSTRINGP (*str), *str, SCM_ARG1, why); SCM_ASSERT (SCM_ROSTRINGP (*str), *str, SCM_ARG1, why);
SCM_ASSERT (SCM_ICHRP (chr), chr, SCM_ARG2, why); SCM_ASSERT (SCM_ICHRP (chr), chr, SCM_ARG2, why);
if (sub_start == SCM_BOOL_F) if (sub_start == SCM_BOOL_F)

2
libguile/strports.c
View file

@ -258,7 +258,7 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char *caller)
int str_len; int str_len;
SCM_ASSERT (SCM_INUMP(pos) && SCM_INUM(pos) >= 0, pos, SCM_ARG1, caller); SCM_ASSERT (SCM_INUMP(pos) && SCM_INUM(pos) >= 0, pos, SCM_ARG1, caller);
SCM_ASSERT (SCM_NIMP(str) && SCM_ROSTRINGP(str), str, SCM_ARG1, caller); SCM_ASSERT (SCM_ROSTRINGP(str), str, SCM_ARG1, caller);
str_len = SCM_ROLENGTH (str); str_len = SCM_ROLENGTH (str);
if (SCM_INUM (pos) > str_len) if (SCM_INUM (pos) > str_len)
scm_out_of_range (caller, pos); scm_out_of_range (caller, pos);

2
libguile/struct.c
View file

@ -245,7 +245,7 @@ GUILE_PROC (scm_struct_p, "struct?", 1, 0, 0,
"Return #t iff @var{obj} is a structure object, else #f.") "Return #t iff @var{obj} is a structure object, else #f.")
#define FUNC_NAME s_scm_struct_p #define FUNC_NAME s_scm_struct_p
{ {
return SCM_BOOL(SCM_NIMP (x) && SCM_STRUCTP (x)); return SCM_BOOL(SCM_STRUCTP (x));
} }
#undef FUNC_NAME #undef FUNC_NAME

2
libguile/symbols.c
View file

@ -480,7 +480,7 @@ table; instead, simply return @code{#f}.")
SCM_VALIDATE_ROSTRING(2,s); SCM_VALIDATE_ROSTRING(2,s);
SCM_ASSERT((o == SCM_BOOL_F) SCM_ASSERT((o == SCM_BOOL_F)
|| (o == SCM_BOOL_T) || (o == SCM_BOOL_T)
|| (SCM_NIMP(o) && SCM_VECTORP(o)), || (SCM_VECTORP(o)),
o, SCM_ARG1, FUNC_NAME); o, SCM_ARG1, FUNC_NAME);
softness = ((softp != SCM_UNDEFINED) && (softp != SCM_BOOL_F)); softness = ((softp != SCM_UNDEFINED) && (softp != SCM_BOOL_F));

7
libguile/throw.c
View file

@ -551,7 +551,7 @@ this call to @code{catch}.")
{ {
struct scm_body_thunk_data c; struct scm_body_thunk_data c;
SCM_ASSERT ((SCM_NIMP(tag) && SCM_SYMBOLP(tag)) || tag == SCM_BOOL_T, SCM_ASSERT (SCM_SYMBOLP(tag) || tag == SCM_BOOL_T,
tag, SCM_ARG1, FUNC_NAME); tag, SCM_ARG1, FUNC_NAME);
c.tag = tag; c.tag = tag;
@ -576,8 +576,7 @@ GUILE_PROC(scm_lazy_catch, "lazy-catch", 3, 0, 0,
{ {
struct scm_body_thunk_data c; struct scm_body_thunk_data c;
SCM_ASSERT ((SCM_NIMP(tag) && SCM_SYMBOLP(tag)) SCM_ASSERT (SCM_SYMBOLP(tag) || (tag == SCM_BOOL_T),
|| (tag == SCM_BOOL_T),
tag, SCM_ARG1, FUNC_NAME); tag, SCM_ARG1, FUNC_NAME);
c.tag = tag; c.tag = tag;
@ -634,7 +633,7 @@ scm_ithrow (SCM key, SCM args, int noreturn)
abort (); abort ();
dynpair = SCM_CAR (winds); dynpair = SCM_CAR (winds);
if (SCM_NIMP (dynpair) && SCM_CONSP (dynpair)) if (SCM_CONSP (dynpair))
{ {
SCM this_key = SCM_CAR (dynpair); SCM this_key = SCM_CAR (dynpair);

22
libguile/unif.c
View file

@ -179,7 +179,7 @@ scm_make_uve (long k, SCM prot)
else else
type = scm_tc7_ivect; type = scm_tc7_ivect;
} }
else if (SCM_NIMP (prot) && SCM_SYMBOLP (prot) && (1 == SCM_LENGTH (prot))) else if (SCM_SYMBOLP (prot) && (1 == SCM_LENGTH (prot)))
{ {
char s; char s;
@ -320,12 +320,12 @@ loop:
# ifdef SCM_FLOATS # ifdef SCM_FLOATS
# ifdef SCM_SINGLES # ifdef SCM_SINGLES
case scm_tc7_fvect: case scm_tc7_fvect:
return nprot || SCM_BOOL(SCM_NIMP(prot) && SCM_SINGP(prot)); return nprot || SCM_BOOL(SCM_SINGP(prot));
# endif # endif
case scm_tc7_dvect: case scm_tc7_dvect:
return nprot || SCM_BOOL(SCM_NIMP(prot) && SCM_REALP(prot)); return nprot || SCM_BOOL(SCM_REALP(prot));
case scm_tc7_cvect: case scm_tc7_cvect:
return nprot || SCM_BOOL(SCM_NIMP(prot) && SCM_CPLXP(prot)); return nprot || SCM_BOOL(SCM_CPLXP(prot));
# endif # endif
case scm_tc7_vector: case scm_tc7_vector:
case scm_tc7_wvect: case scm_tc7_wvect:
@ -500,7 +500,7 @@ scm_shap2ra (SCM args, const char *what)
s_bad_spec, what); s_bad_spec, what);
s->lbnd = SCM_INUM (SCM_CAR (spec)); s->lbnd = SCM_INUM (SCM_CAR (spec));
sp = SCM_CDR (spec); sp = SCM_CDR (spec);
SCM_ASSERT (SCM_NIMP (sp) && SCM_CONSP (sp) SCM_ASSERT (SCM_CONSP (sp)
&& SCM_INUMP (SCM_CAR (sp)) && SCM_NULLP (SCM_CDR (sp)), && SCM_INUMP (SCM_CAR (sp)) && SCM_NULLP (SCM_CDR (sp)),
spec, s_bad_spec, what); spec, s_bad_spec, what);
s->ubnd = SCM_INUM (SCM_CAR (sp)); s->ubnd = SCM_INUM (SCM_CAR (sp));
@ -531,7 +531,7 @@ Creates and returns a uniform array or vector of type corresponding to
if (!SCM_UNBNDP (fill)) if (!SCM_UNBNDP (fill))
scm_array_fill_x (answer, fill); scm_array_fill_x (answer, fill);
else if (SCM_NIMP (prot) && SCM_SYMBOLP (prot)) else if (SCM_SYMBOLP (prot))
scm_array_fill_x (answer, SCM_MAKINUM (0)); scm_array_fill_x (answer, SCM_MAKINUM (0));
else else
scm_array_fill_x (answer, prot); scm_array_fill_x (answer, prot);
@ -540,7 +540,7 @@ Creates and returns a uniform array or vector of type corresponding to
else else
dims = scm_cons (dims, SCM_EOL); dims = scm_cons (dims, SCM_EOL);
} }
SCM_ASSERT (SCM_NULLP (dims) || (SCM_NIMP (dims) && SCM_CONSP (dims)), SCM_ASSERT (SCM_NULLP (dims) || SCM_CONSP (dims),
dims, SCM_ARG1, FUNC_NAME); dims, SCM_ARG1, FUNC_NAME);
ra = scm_shap2ra (dims, FUNC_NAME); ra = scm_shap2ra (dims, FUNC_NAME);
SCM_SETOR_CAR (ra, SCM_ARRAY_CONTIGUOUS); SCM_SETOR_CAR (ra, SCM_ARRAY_CONTIGUOUS);
@ -587,7 +587,7 @@ Creates and returns a uniform array or vector of type corresponding to
{ {
scm_array_fill_x (ra, fill); scm_array_fill_x (ra, fill);
} }
else if (SCM_NIMP (prot) && SCM_SYMBOLP (prot)) else if (SCM_SYMBOLP (prot))
scm_array_fill_x (ra, SCM_MAKINUM (0)); scm_array_fill_x (ra, SCM_MAKINUM (0));
else else
scm_array_fill_x (ra, prot); scm_array_fill_x (ra, prot);
@ -1327,7 +1327,7 @@ GUILE_PROC(scm_array_set_x, "array-set!", 2, 0, 1,
((double *) SCM_CDR (v))[pos] = scm_num2dbl(obj, FUNC_NAME); break; ((double *) SCM_CDR (v))[pos] = scm_num2dbl(obj, FUNC_NAME); break;
break; break;
case scm_tc7_cvect: case scm_tc7_cvect:
SCM_ASRTGO (SCM_NIMP (obj) && SCM_INEXP (obj), badobj); SCM_ASRTGO (SCM_INEXP (obj), badobj);
((double *) SCM_CDR (v))[2 * pos] = SCM_REALPART (obj); ((double *) SCM_CDR (v))[2 * pos] = SCM_REALPART (obj);
((double *) SCM_CDR (v))[2 * pos + 1] = SCM_CPLXP (obj) ? SCM_IMAG (obj) : 0.0; ((double *) SCM_CDR (v))[2 * pos + 1] = SCM_CPLXP (obj) ? SCM_IMAG (obj) : 0.0;
break; break;
@ -1481,7 +1481,7 @@ returned by @code{(current-input-port)}.")
port_or_fd = scm_cur_inp; port_or_fd = scm_cur_inp;
else else
SCM_ASSERT (SCM_INUMP (port_or_fd) SCM_ASSERT (SCM_INUMP (port_or_fd)
|| (SCM_NIMP (port_or_fd) && SCM_OPINPORTP (port_or_fd)), || (SCM_OPINPORTP (port_or_fd)),
port_or_fd, SCM_ARG2, FUNC_NAME); port_or_fd, SCM_ARG2, FUNC_NAME);
vlen = SCM_LENGTH (v); vlen = SCM_LENGTH (v);
@ -1639,7 +1639,7 @@ omitted, in which case it defaults to the value returned by
port_or_fd = scm_cur_outp; port_or_fd = scm_cur_outp;
else else
SCM_ASSERT (SCM_INUMP (port_or_fd) SCM_ASSERT (SCM_INUMP (port_or_fd)
|| (SCM_NIMP (port_or_fd) && SCM_OPOUTPORTP (port_or_fd)), || (SCM_OPOUTPORTP (port_or_fd)),
port_or_fd, SCM_ARG2, FUNC_NAME); port_or_fd, SCM_ARG2, FUNC_NAME);
vlen = SCM_LENGTH (v); vlen = SCM_LENGTH (v);

2
libguile/variable.c
View file

@ -144,7 +144,7 @@ GUILE_PROC(scm_variable_p, "variable?", 1, 0, 0,
"") "")
#define FUNC_NAME s_scm_variable_p #define FUNC_NAME s_scm_variable_p
{ {
return SCM_BOOL(SCM_NIMP(obj) && SCM_VARIABLEP (obj)); return SCM_BOOL(SCM_VARIABLEP (obj));
} }
#undef FUNC_NAME #undef FUNC_NAME

6
libguile/vectors.c
View file

@ -137,7 +137,7 @@ SCM_GPROC(s_vector_length, "vector-length", 1, 0, 0, scm_vector_length, g_vector
SCM SCM
scm_vector_length(SCM v) scm_vector_length(SCM v)
{ {
SCM_GASSERT1(SCM_NIMP(v) && SCM_VECTORP(v), SCM_GASSERT1(SCM_VECTORP(v),
g_vector_length, v, SCM_ARG1, s_vector_length); g_vector_length, v, SCM_ARG1, s_vector_length);
return SCM_MAKINUM(SCM_LENGTH(v)); return SCM_MAKINUM(SCM_LENGTH(v));
} }
@ -166,7 +166,7 @@ SCM_GPROC(s_vector_ref, "vector-ref", 2, 0, 0, scm_vector_ref, g_vector_ref);
SCM SCM
scm_vector_ref (SCM v, SCM k) scm_vector_ref (SCM v, SCM k)
{ {
SCM_GASSERT2 (SCM_NIMP (v) && SCM_VECTORP (v), SCM_GASSERT2 (SCM_VECTORP (v),
g_vector_ref, v, k, SCM_ARG1, s_vector_ref); g_vector_ref, v, k, SCM_ARG1, s_vector_ref);
SCM_GASSERT2 (SCM_INUMP (k), SCM_GASSERT2 (SCM_INUMP (k),
g_vector_ref, v, k, SCM_ARG2, s_vector_ref); g_vector_ref, v, k, SCM_ARG2, s_vector_ref);
@ -180,7 +180,7 @@ SCM_GPROC(s_vector_set_x, "vector-set!", 3, 0, 0, scm_vector_set_x, g_vector_set
SCM SCM
scm_vector_set_x(SCM v, SCM k, SCM obj) scm_vector_set_x(SCM v, SCM k, SCM obj)
{ {
SCM_GASSERTn (SCM_NIMP(v) && SCM_VECTORP(v), SCM_GASSERTn (SCM_VECTORP(v),
g_vector_set_x, SCM_LIST3 (v, k, obj), g_vector_set_x, SCM_LIST3 (v, k, obj),
SCM_ARG1, s_vector_set_x); SCM_ARG1, s_vector_set_x);
SCM_GASSERTn (SCM_INUMP(k), SCM_GASSERTn (SCM_INUMP(k),

10
libguile/weaks.c
View file

@ -95,7 +95,7 @@ its arguments while @code{list->weak-vector} uses its only argument
res = scm_make_weak_vector (SCM_MAKINUM (i), SCM_UNSPECIFIED); res = scm_make_weak_vector (SCM_MAKINUM (i), SCM_UNSPECIFIED);
data = SCM_VELTS (res); data = SCM_VELTS (res);
for (; for (;
i && SCM_NIMP (l) && SCM_CONSP (l); i && SCM_CONSP (l);
--i, l = SCM_CDR (l)) --i, l = SCM_CDR (l))
*data++ = SCM_CAR (l); *data++ = SCM_CAR (l);
return res; return res;
@ -109,7 +109,7 @@ GUILE_PROC(scm_weak_vector_p, "weak-vector?", 1, 0, 0,
hashes are also weak vectors.") hashes are also weak vectors.")
#define FUNC_NAME s_scm_weak_vector_p #define FUNC_NAME s_scm_weak_vector_p
{ {
return SCM_BOOL(SCM_NIMP (x) && SCM_WVECTP (x) && !SCM_IS_WHVEC (x)); return SCM_BOOL(SCM_WVECTP (x) && !SCM_IS_WHVEC (x));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -182,7 +182,7 @@ that a doubly weak hash table is neither a weak key nor a weak value
hash table.") hash table.")
#define FUNC_NAME s_scm_weak_key_hash_table_p #define FUNC_NAME s_scm_weak_key_hash_table_p
{ {
return SCM_BOOL(SCM_NIMP (x) && SCM_WVECTP (x) && SCM_IS_WHVEC(x)); return SCM_BOOL(SCM_WVECTP (x) && SCM_IS_WHVEC(x));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -192,7 +192,7 @@ GUILE_PROC (scm_weak_value_hash_table_p, "weak-value-hash-table?", 1, 0, 0,
"") "")
#define FUNC_NAME s_scm_weak_value_hash_table_p #define FUNC_NAME s_scm_weak_value_hash_table_p
{ {
return SCM_BOOL(SCM_NIMP (x) && SCM_WVECTP (x) && SCM_IS_WHVEC_V(x)); return SCM_BOOL(SCM_WVECTP (x) && SCM_IS_WHVEC_V(x));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -202,7 +202,7 @@ GUILE_PROC (scm_doubly_weak_hash_table_p, "doubly-weak-hash-table?", 1, 0, 0,
"") "")
#define FUNC_NAME s_scm_doubly_weak_hash_table_p #define FUNC_NAME s_scm_doubly_weak_hash_table_p
{ {
return SCM_BOOL(SCM_NIMP (x) && SCM_WVECTP (x) && SCM_IS_WHVEC_B (x)); return SCM_BOOL(SCM_WVECTP (x) && SCM_IS_WHVEC_B (x));
} }
#undef FUNC_NAME #undef FUNC_NAME