From 7888309be8638cb5b75db163383a3d977bd9769d Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Tue, 6 Jul 2004 10:59:25 +0000 Subject: [PATCH] * deprecated.h, boolean.h (SCM_FALSEP, SCM_NFALSEP, SCM_BOOL, SCM_NEGATE_BOOL, SCM_BOOLP): Deprecated by moving into "deprecated.h". Replaced all uses with scm_is_false, scm_is_true, scm_from_bool, and scm_is_bool, respectively. --- libguile/ChangeLog | 24 +++++++++++++ libguile/alist.c | 8 ++--- libguile/async.c | 2 +- libguile/backtrace.c | 28 +++++++-------- libguile/chars.c | 34 +++++++++--------- libguile/convert.i.c | 8 ++--- libguile/coop-pthreads.c | 12 +++---- libguile/coop-threads.c | 8 ++--- libguile/debug.c | 12 +++---- libguile/debug.h | 6 ++-- libguile/deprecated.c | 46 +++++++++++++++---------- libguile/deprecation.c | 2 +- libguile/dynl.c | 2 +- libguile/dynwind.c | 2 +- libguile/environments.c | 24 ++++++------- libguile/eq.c | 26 +++++++------- libguile/error.c | 8 ++--- libguile/eval.c | 74 ++++++++++++++++++++-------------------- libguile/evalext.c | 6 ++-- libguile/filesys.c | 6 ++-- libguile/fluids.c | 2 +- libguile/fports.c | 2 +- libguile/gc.c | 6 ++-- libguile/gh_data.c | 4 +-- libguile/gh_predicates.c | 32 ++++++++--------- libguile/goops.c | 38 ++++++++++----------- libguile/goops.h | 2 +- libguile/guardians.c | 12 +++---- libguile/hashtab.c | 12 +++---- libguile/hooks.c | 12 +++---- libguile/init.c | 4 +-- libguile/ioext.c | 2 +- libguile/keywords.c | 4 +-- libguile/list.c | 20 +++++------ libguile/load.c | 10 +++--- libguile/macros.c | 6 ++-- libguile/modules.c | 40 +++++++++++----------- libguile/net_db.c | 8 ++--- libguile/objects.c | 14 ++++---- libguile/options.c | 2 +- libguile/pairs.c | 2 +- libguile/ports.c | 14 ++++---- libguile/posix.c | 10 +++--- libguile/print.c | 18 +++++----- libguile/procprop.c | 6 ++-- libguile/procs.c | 8 ++--- libguile/properties.c | 10 +++--- libguile/ramap.c | 32 ++++++++--------- libguile/rdelim.c | 2 +- libguile/read.c | 18 +++++----- libguile/regex-posix.c | 2 +- libguile/scmsigs.c | 14 ++++---- libguile/script.c | 2 +- libguile/simpos.c | 2 +- libguile/sort.c | 30 ++++++++-------- libguile/srcprop.c | 8 ++--- libguile/srcprop.h | 4 +-- libguile/stacks.c | 20 +++++------ libguile/stime.c | 6 ++-- libguile/strings.c | 2 +- libguile/strop.c | 8 ++--- libguile/strorder.c | 12 +++---- libguile/struct.c | 10 +++--- libguile/symbols.c | 4 +-- libguile/threads.c | 14 ++++---- libguile/throw.c | 6 ++-- libguile/unif.c | 28 +++++++-------- libguile/validate.h | 13 ++++--- libguile/variable.c | 4 +-- libguile/vectors.c | 4 +-- libguile/vports.c | 10 +++--- libguile/weaks.c | 8 ++--- 72 files changed, 469 insertions(+), 432 deletions(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 6fd885239..471f4f7e9 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,27 @@ +2004-07-06 Marius Vollmer + + * tags.h (scm_is_eq): New. + + * deprecated.h, boolean.h (SCM_FALSEP, SCM_NFALSEP, SCM_BOOL, + SCM_NEGATE_BOOL, SCM_BOOLP): Deprecated by moving into + "deprecated.h". Replaced all uses with scm_is_false, scm_is_true, + scm_from_bool, and scm_is_bool, respectively. + + * boolean.h (scm_is_bool): Fix bug in prototype. + (scm_from_bool): The argument is "x" not "f", stupid. + + * boolean.c (scm_is_bool): Fix typo. + + * numbers.h, numbers.c (scm_is_integer, scm_is_signed_integer, + scm_is_unsigned_integer, scm_to_signed_integer, + scm_to_unsigned_integer, scm_to_schar, scm_to_uchar, scm_to_char, + scm_to_short, scm_to_ushort, scm_to_long, scm_to_ulong, + scm_to_size_t, scm_to_ssize_t, scm_from_schar, scm_from_uchar, + scm_from_char, scm_from_short, scm_from_ushort, scm_from_int, + scm_from_uint, scm_from_long, scm_from_ulong, scm_from_size_t, + scm_from_ssize_t, scm_is_real, scm_to_double, scm_from_double): + New. + 2004-07-05 Marius Vollmer * boolean.h, boolean.c (scm_is_true, scm_is_false, scm_from_bool, diff --git a/libguile/alist.c b/libguile/alist.c index 05eed0241..b876ae59d 100644 --- a/libguile/alist.c +++ b/libguile/alist.c @@ -71,7 +71,7 @@ SCM_DEFINE (scm_sloppy_assv, "sloppy-assv", 2, 0, 0, { SCM tmp = SCM_CAR (alist); if (SCM_CONSP (tmp) - && SCM_NFALSEP (scm_eqv_p (SCM_CAR (tmp), key))) + && scm_is_true (scm_eqv_p (SCM_CAR (tmp), key))) return tmp; } return SCM_BOOL_F; @@ -89,7 +89,7 @@ SCM_DEFINE (scm_sloppy_assoc, "sloppy-assoc", 2, 0, 0, { SCM tmp = SCM_CAR (alist); if (SCM_CONSP (tmp) - && SCM_NFALSEP (scm_equal_p (SCM_CAR (tmp), key))) + && scm_is_true (scm_equal_p (SCM_CAR (tmp), key))) return tmp; } return SCM_BOOL_F; @@ -139,7 +139,7 @@ SCM_DEFINE (scm_assv, "assv", 2, 0, 0, SCM tmp = SCM_CAR (ls); SCM_ASSERT_TYPE (SCM_CONSP (tmp), alist, SCM_ARG2, FUNC_NAME, "association list"); - if (SCM_NFALSEP (scm_eqv_p (SCM_CAR (tmp), key))) + if (scm_is_true (scm_eqv_p (SCM_CAR (tmp), key))) return tmp; } SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (ls), alist, SCM_ARG2, FUNC_NAME, @@ -160,7 +160,7 @@ SCM_DEFINE (scm_assoc, "assoc", 2, 0, 0, SCM tmp = SCM_CAR (ls); SCM_ASSERT_TYPE (SCM_CONSP (tmp), alist, SCM_ARG2, FUNC_NAME, "association list"); - if (SCM_NFALSEP (scm_equal_p (SCM_CAR (tmp), key))) + if (scm_is_true (scm_equal_p (SCM_CAR (tmp), key))) return tmp; } SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (ls), alist, SCM_ARG2, FUNC_NAME, diff --git a/libguile/async.c b/libguile/async.c index 34165fe11..333b8d0e1 100644 --- a/libguile/async.c +++ b/libguile/async.c @@ -162,7 +162,7 @@ scm_async_click () for (asyncs = scm_root->signal_asyncs; !SCM_NULLP(asyncs); asyncs = SCM_CDR (asyncs)) { - if (!SCM_FALSEP (SCM_CAR (asyncs))) + if (scm_is_true (SCM_CAR (asyncs))) { SCM proc = SCM_CAR (asyncs); SCM_SETCAR (asyncs, SCM_BOOL_F); diff --git a/libguile/backtrace.c b/libguile/backtrace.c index 59542d619..9bf942932 100644 --- a/libguile/backtrace.c +++ b/libguile/backtrace.c @@ -89,7 +89,7 @@ display_header (SCM source, SCM port) else scm_puts ("", port); - if (!SCM_FALSEP (line) && !SCM_FALSEP (col)) + if (scm_is_true (line) && scm_is_true (col)) { scm_putc (':', port); scm_intprint (SCM_INUM (line) + 1, 10, port); @@ -116,7 +116,7 @@ struct display_error_message_data { static SCM display_error_message (struct display_error_message_data *d) { - if (SCM_STRINGP (d->message) && !SCM_FALSEP (scm_list_p (d->args))) + if (SCM_STRINGP (d->message) && scm_is_true (scm_list_p (d->args))) scm_simple_format (d->port, d->message, d->args); else scm_display (d->message, d->port); @@ -225,7 +225,7 @@ display_error_body (struct display_error_args *a) current_frame = scm_stack_ref (a->stack, SCM_INUM0); source = SCM_FRAME_SOURCE (current_frame); prev_frame = SCM_FRAME_PREV (current_frame); - if (!SCM_MEMOIZEDP (source) && !SCM_FALSEP (prev_frame)) + if (!SCM_MEMOIZEDP (source) && scm_is_true (prev_frame)) source = SCM_FRAME_SOURCE (prev_frame); if (!SCM_SYMBOLP (pname) && !SCM_STRINGP (pname) && SCM_FRAME_PROC_P (current_frame) && SCM_EQ_P (scm_procedure_p (SCM_FRAME_PROC (current_frame)), SCM_BOOL_T)) @@ -416,11 +416,11 @@ static void display_application (SCM frame, int indentation, SCM sport, SCM port, scm_print_state *pstate) { SCM proc = SCM_FRAME_PROC (frame); - SCM name = (!SCM_FALSEP (scm_procedure_p (proc)) + SCM name = (scm_is_true (scm_procedure_p (proc)) ? scm_procedure_name (proc) : SCM_BOOL_F); display_frame_expr ("[", - scm_cons (!SCM_FALSEP (name) ? name : proc, + scm_cons (scm_is_true (name) ? name : proc, SCM_FRAME_ARGS (frame)), SCM_FRAME_EVAL_ARGS_P (frame) ? " ..." : "]", indentation, @@ -500,8 +500,8 @@ display_backtrace_file (frame, last_file, port, pstate) *last_file = file; scm_puts ("In ", port); - if (SCM_FALSEP (file)) - if (SCM_FALSEP (line)) + if (scm_is_false (file)) + if (scm_is_false (line)) scm_puts ("unknown file", port); else scm_puts ("current input", port); @@ -523,9 +523,9 @@ display_backtrace_file_and_line (SCM frame, SCM port, scm_print_state *pstate) if (SCM_EQ_P (SCM_PACK (SCM_SHOW_FILE_NAME), sym_base)) { - if (SCM_FALSEP (file)) + if (scm_is_false (file)) { - if (SCM_FALSEP (line)) + if (scm_is_false (line)) scm_putc ('?', port); else scm_puts ("", port); @@ -544,7 +544,7 @@ display_backtrace_file_and_line (SCM frame, SCM port, scm_print_state *pstate) scm_putc (':', port); } - else if (!SCM_FALSEP (line)) + else if (scm_is_true (line)) { int i, j=0; for (i = SCM_INUM (line)+1; i > 0; i = i/10, j++) @@ -552,7 +552,7 @@ display_backtrace_file_and_line (SCM frame, SCM port, scm_print_state *pstate) indent (4-j, port); } - if (SCM_FALSEP (line)) + if (scm_is_false (line)) scm_puts (" ?", port); else scm_intprint (SCM_INUM (line) + 1, 10, port); @@ -572,7 +572,7 @@ display_frame (SCM frame, int nfield, int indentation, SCM sport, SCM port, scm_ } /* display file name and line number */ - if (!SCM_FALSEP (SCM_PACK (SCM_SHOW_FILE_NAME))) + if (scm_is_true (SCM_PACK (SCM_SHOW_FILE_NAME))) display_backtrace_file_and_line (frame, port, pstate); /* Check size of frame number. */ @@ -772,7 +772,7 @@ SCM_DEFINE (scm_backtrace, "backtrace", 0, 0, 0, { SCM the_last_stack = scm_fluid_ref (SCM_VARIABLE_REF (scm_the_last_stack_fluid_var)); - if (!SCM_FALSEP (the_last_stack)) + if (scm_is_true (the_last_stack)) { scm_newline (scm_cur_outp); scm_puts ("Backtrace:\n", scm_cur_outp); @@ -781,7 +781,7 @@ SCM_DEFINE (scm_backtrace, "backtrace", 0, 0, 0, SCM_UNDEFINED, SCM_UNDEFINED); scm_newline (scm_cur_outp); - if (SCM_FALSEP (SCM_VARIABLE_REF (scm_has_shown_backtrace_hint_p_var)) + if (scm_is_false (SCM_VARIABLE_REF (scm_has_shown_backtrace_hint_p_var)) && !SCM_BACKTRACE_P) { scm_puts ("Type \"(debug-enable 'backtrace)\" if you would like " diff --git a/libguile/chars.c b/libguile/chars.c index dc6edf2d0..c4fdf9b03 100644 --- a/libguile/chars.c +++ b/libguile/chars.c @@ -31,7 +31,7 @@ SCM_DEFINE (scm_char_p, "char?", 1, 0, 0, "Return @code{#t} iff @var{x} is a character, else @code{#f}.") #define FUNC_NAME s_scm_char_p { - return SCM_BOOL(SCM_CHARP(x)); + return scm_from_bool (SCM_CHARP(x)); } #undef FUNC_NAME @@ -42,7 +42,7 @@ SCM_DEFINE1 (scm_char_eq_p, "char=?", scm_tc7_rpsubr, { SCM_VALIDATE_CHAR (1, x); SCM_VALIDATE_CHAR (2, y); - return SCM_BOOL (SCM_EQ_P (x, y)); + return scm_from_bool (SCM_EQ_P (x, y)); } #undef FUNC_NAME @@ -55,7 +55,7 @@ SCM_DEFINE1 (scm_char_less_p, "char?", scm_tc7_rpsubr, { SCM_VALIDATE_CHAR (1, x); SCM_VALIDATE_CHAR (2, y); - return SCM_BOOL(SCM_CHAR(x) > SCM_CHAR(y)); + return scm_from_bool (SCM_CHAR(x) > SCM_CHAR(y)); } #undef FUNC_NAME @@ -91,7 +91,7 @@ SCM_DEFINE1 (scm_char_geq_p, "char>=?", scm_tc7_rpsubr, { SCM_VALIDATE_CHAR (1, x); SCM_VALIDATE_CHAR (2, y); - return SCM_BOOL(SCM_CHAR(x) >= SCM_CHAR(y)); + return scm_from_bool (SCM_CHAR(x) >= SCM_CHAR(y)); } #undef FUNC_NAME @@ -103,7 +103,7 @@ SCM_DEFINE1 (scm_char_ci_eq_p, "char-ci=?", scm_tc7_rpsubr, { SCM_VALIDATE_CHAR (1, x); SCM_VALIDATE_CHAR (2, y); - return SCM_BOOL(scm_c_upcase(SCM_CHAR(x))==scm_c_upcase(SCM_CHAR(y))); + return scm_from_bool (scm_c_upcase(SCM_CHAR(x))==scm_c_upcase(SCM_CHAR(y))); } #undef FUNC_NAME @@ -115,7 +115,7 @@ SCM_DEFINE1 (scm_char_ci_less_p, "char-ci?", scm_tc7_rpsubr, { SCM_VALIDATE_CHAR (1, x); SCM_VALIDATE_CHAR (2, y); - return SCM_BOOL(scm_c_upcase(SCM_CHAR(x)) > scm_c_upcase(SCM_CHAR(y))); + return scm_from_bool (scm_c_upcase(SCM_CHAR(x)) > scm_c_upcase(SCM_CHAR(y))); } #undef FUNC_NAME @@ -151,7 +151,7 @@ SCM_DEFINE1 (scm_char_ci_geq_p, "char-ci>=?", scm_tc7_rpsubr, { SCM_VALIDATE_CHAR (1, x); SCM_VALIDATE_CHAR (2, y); - return SCM_BOOL(scm_c_upcase(SCM_CHAR(x)) >= scm_c_upcase(SCM_CHAR(y))); + return scm_from_bool (scm_c_upcase(SCM_CHAR(x)) >= scm_c_upcase(SCM_CHAR(y))); } #undef FUNC_NAME @@ -163,7 +163,7 @@ SCM_DEFINE (scm_char_alphabetic_p, "char-alphabetic?", 1, 0, 0, #define FUNC_NAME s_scm_char_alphabetic_p { SCM_VALIDATE_CHAR (1, chr); - return SCM_BOOL(isalpha(SCM_CHAR(chr))); + return scm_from_bool (isalpha(SCM_CHAR(chr))); } #undef FUNC_NAME @@ -174,7 +174,7 @@ SCM_DEFINE (scm_char_numeric_p, "char-numeric?", 1, 0, 0, #define FUNC_NAME s_scm_char_numeric_p { SCM_VALIDATE_CHAR (1, chr); - return SCM_BOOL(isdigit(SCM_CHAR(chr))); + return scm_from_bool (isdigit(SCM_CHAR(chr))); } #undef FUNC_NAME @@ -185,7 +185,7 @@ SCM_DEFINE (scm_char_whitespace_p, "char-whitespace?", 1, 0, 0, #define FUNC_NAME s_scm_char_whitespace_p { SCM_VALIDATE_CHAR (1, chr); - return SCM_BOOL(isspace(SCM_CHAR(chr))); + return scm_from_bool (isspace(SCM_CHAR(chr))); } #undef FUNC_NAME @@ -198,7 +198,7 @@ SCM_DEFINE (scm_char_upper_case_p, "char-upper-case?", 1, 0, 0, #define FUNC_NAME s_scm_char_upper_case_p { SCM_VALIDATE_CHAR (1, chr); - return SCM_BOOL(isupper(SCM_CHAR(chr))); + return scm_from_bool (isupper(SCM_CHAR(chr))); } #undef FUNC_NAME @@ -210,7 +210,7 @@ SCM_DEFINE (scm_char_lower_case_p, "char-lower-case?", 1, 0, 0, #define FUNC_NAME s_scm_char_lower_case_p { SCM_VALIDATE_CHAR (1, chr); - return SCM_BOOL(islower(SCM_CHAR(chr))); + return scm_from_bool (islower(SCM_CHAR(chr))); } #undef FUNC_NAME @@ -224,7 +224,7 @@ SCM_DEFINE (scm_char_is_both_p, "char-is-both?", 1, 0, 0, #define FUNC_NAME s_scm_char_is_both_p { SCM_VALIDATE_CHAR (1, chr); - return SCM_BOOL((isupper(SCM_CHAR(chr)) || islower(SCM_CHAR(chr)))); + return scm_from_bool ((isupper(SCM_CHAR(chr)) || islower(SCM_CHAR(chr)))); } #undef FUNC_NAME diff --git a/libguile/convert.i.c b/libguile/convert.i.c index 703cf0141..282854400 100644 --- a/libguile/convert.i.c +++ b/libguile/convert.i.c @@ -10,15 +10,15 @@ SCM2CTYPES (SCM obj, CTYPE *data) long i, n; SCM val; - SCM_ASSERT (SCM_NIMP (obj) || SCM_NFALSEP (scm_list_p (obj)), + SCM_ASSERT (SCM_NIMP (obj) || scm_is_true (scm_list_p (obj)), obj, SCM_ARG1, FUNC_NAME); /* list conversion */ - if (SCM_NFALSEP (scm_list_p (obj))) + if (scm_is_true (scm_list_p (obj))) { /* traverse the given list and validate the range of each member */ SCM list = obj; - for (n = 0; SCM_NFALSEP (scm_pair_p (list)); list = SCM_CDR (list), n++) + for (n = 0; scm_is_true (scm_pair_p (list)); list = SCM_CDR (list), n++) { val = SCM_CAR (list); #if SIZEOF_CTYPE && SIZEOF_CTYPE < SIZEOF_SCM_T_BITS @@ -55,7 +55,7 @@ SCM2CTYPES (SCM obj, CTYPE *data) /* traverse the list once more and convert each member */ list = obj; - for (i = 0; SCM_NFALSEP (scm_pair_p (list)); list = SCM_CDR (list), i++) + for (i = 0; scm_is_true (scm_pair_p (list)); list = SCM_CDR (list), i++) { val = SCM_CAR (list); if (SCM_INUMP (val)) diff --git a/libguile/coop-pthreads.c b/libguile/coop-pthreads.c index 42a53457d..57386d4ae 100644 --- a/libguile/coop-pthreads.c +++ b/libguile/coop-pthreads.c @@ -549,7 +549,7 @@ scm_call_with_new_thread (SCM argl) if (!SCM_CONSP (args)) SCM_WRONG_NUM_ARGS (); thunk = SCM_CAR (args); - SCM_ASSERT (SCM_NFALSEP (scm_thunk_p (thunk)), + SCM_ASSERT (scm_is_true (scm_thunk_p (thunk)), thunk, SCM_ARG1, s_call_with_new_thread); @@ -557,7 +557,7 @@ scm_call_with_new_thread (SCM argl) if (!SCM_CONSP (args)) SCM_WRONG_NUM_ARGS (); handler = SCM_CAR (args); - SCM_ASSERT (SCM_NFALSEP (scm_procedure_p (handler)), + SCM_ASSERT (scm_is_true (scm_procedure_p (handler)), handler, SCM_ARG2, s_call_with_new_thread); @@ -677,7 +677,7 @@ scm_unlock_mutex (SCM mx) else { SCM next = dequeue (m->waiting); - if (!SCM_FALSEP (next)) + if (scm_is_true (next)) { m->owner = next; unblock (SCM_THREAD_DATA (next)); @@ -763,7 +763,7 @@ scm_timed_wait_condition_variable (SCM cv, SCM mx, SCM t) else res = timed_block (&waittime); scm_lock_mutex (mx); - return SCM_BOOL (res); + return scm_from_bool (res); } #undef FUNC_NAME @@ -778,7 +778,7 @@ scm_signal_condition_variable (SCM cv) SCM_ARG1, s_signal_condition_variable); c = SCM_CONDVAR_DATA (cv); - if (!SCM_FALSEP (th = dequeue (c->waiting))) + if (scm_is_true (th = dequeue (c->waiting))) unblock (SCM_THREAD_DATA (th)); return SCM_BOOL_T; } @@ -795,7 +795,7 @@ scm_broadcast_condition_variable (SCM cv) SCM_ARG1, s_signal_condition_variable); c = SCM_CONDVAR_DATA (cv); - while (!SCM_FALSEP (th = dequeue (c->waiting))) + while (scm_is_true (th = dequeue (c->waiting))) unblock (SCM_THREAD_DATA (th)); return SCM_BOOL_T; } diff --git a/libguile/coop-threads.c b/libguile/coop-threads.c index 646aa8871..cd50b45aa 100644 --- a/libguile/coop-threads.c +++ b/libguile/coop-threads.c @@ -220,7 +220,7 @@ scm_call_with_new_thread (SCM argl) if (!SCM_CONSP (args)) SCM_WRONG_NUM_ARGS (); thunk = SCM_CAR (args); - SCM_ASSERT (SCM_NFALSEP (scm_thunk_p (thunk)), + SCM_ASSERT (scm_is_true (scm_thunk_p (thunk)), thunk, SCM_ARG1, s_call_with_new_thread); @@ -228,7 +228,7 @@ scm_call_with_new_thread (SCM argl) if (!SCM_CONSP (args)) SCM_WRONG_NUM_ARGS (); handler = SCM_CAR (args); - SCM_ASSERT (SCM_NFALSEP (scm_procedure_p (handler)), + SCM_ASSERT (scm_is_true (scm_procedure_p (handler)), handler, SCM_ARG2, s_call_with_new_thread); @@ -452,7 +452,7 @@ SCM scm_try_mutex (SCM m) { SCM_ASSERT (SCM_MUTEXP (m), m, SCM_ARG1, s_lock_mutex); - return SCM_BOOL (coop_mutex_trylock (SCM_MUTEX_DATA (m))); + return scm_from_bool (coop_mutex_trylock (SCM_MUTEX_DATA (m))); } SCM @@ -509,7 +509,7 @@ scm_timed_wait_condition_variable (SCM c, SCM m, SCM t) SCM_VALIDATE_UINT_COPY (3, t, waittime.tv_sec); waittime.tv_nsec = 0; } - return SCM_BOOL( + return scm_from_bool( coop_condition_variable_timed_wait_mutex (cv, mx, &waittime)); } else diff --git a/libguile/debug.c b/libguile/debug.c index 8fda04c7c..52e507ae6 100644 --- a/libguile/debug.c +++ b/libguile/debug.c @@ -134,7 +134,7 @@ SCM_DEFINE (scm_memoized_p, "memoized?", 1, 0, 0, "Return @code{#t} if @var{obj} is memoized.") #define FUNC_NAME s_scm_memoized_p { - return SCM_BOOL(SCM_MEMOIZEDP (obj)); + return scm_from_bool(SCM_MEMOIZEDP (obj)); } #undef FUNC_NAME @@ -301,10 +301,10 @@ SCM_DEFINE (scm_procedure_name, "procedure-name", 1, 0, 0, #if 0 /* Source property scm_sym_procname not implemented yet... */ SCM name = scm_source_property (SCM_CAR (SCM_CLOSURE_BODY (proc)), scm_sym_procname); - if (SCM_FALSEP (name)) + if (scm_is_false (name)) name = scm_procedure_property (proc, scm_sym_name); #endif - if (SCM_FALSEP (name) && SCM_CLOSUREP (proc)) + if (scm_is_false (name) && SCM_CLOSUREP (proc)) name = scm_reverse_lookup (SCM_ENV (proc), proc); return name; } @@ -326,7 +326,7 @@ SCM_DEFINE (scm_procedure_source, "procedure-source", 1, 0, 0, const SCM body = SCM_CLOSURE_BODY (proc); const SCM src = scm_source_property (body, scm_sym_copy); - if (!SCM_FALSEP (src)) + if (scm_is_true (src)) { return scm_cons2 (scm_sym_lambda, formals, src); } @@ -356,7 +356,7 @@ SCM_DEFINE (scm_procedure_source, "procedure-source", 1, 0, 0, case scm_tc7_pws: { SCM src = scm_procedure_property (proc, scm_sym_source); - if (!SCM_FALSEP (src)) + if (scm_is_true (src)) return src; proc = SCM_PROCEDURE (proc); goto again; @@ -493,7 +493,7 @@ SCM_DEFINE (scm_debug_object_p, "debug-object?", 1, 0, 0, "Return @code{#t} if @var{obj} is a debug object.") #define FUNC_NAME s_scm_debug_object_p { - return SCM_BOOL(SCM_DEBUGOBJP (obj)); + return scm_from_bool(SCM_DEBUGOBJP (obj)); } #undef FUNC_NAME diff --git a/libguile/debug.h b/libguile/debug.h index 426215cc6..81e1fb3f1 100644 --- a/libguile/debug.h +++ b/libguile/debug.h @@ -68,11 +68,11 @@ SCM_API int scm_check_exit_p; #define SCM_RESET_DEBUG_MODE \ do {\ scm_check_entry_p = (SCM_ENTER_FRAME_P || SCM_BREAKPOINTS_P)\ - && !SCM_FALSEP (SCM_ENTER_FRAME_HDLR);\ + && scm_is_true (SCM_ENTER_FRAME_HDLR);\ scm_check_apply_p = (SCM_APPLY_FRAME_P || SCM_TRACE_P)\ - && !SCM_FALSEP (SCM_APPLY_FRAME_HDLR);\ + && scm_is_true (SCM_APPLY_FRAME_HDLR);\ scm_check_exit_p = (SCM_EXIT_FRAME_P || SCM_TRACE_P)\ - && !SCM_FALSEP (SCM_EXIT_FRAME_HDLR);\ + && scm_is_true (SCM_EXIT_FRAME_HDLR);\ scm_debug_mode_p = SCM_DEVAL_P\ || scm_check_entry_p || scm_check_apply_p || scm_check_exit_p;\ } while (0) diff --git a/libguile/deprecated.c b/libguile/deprecated.c index 042debaa6..c3dc8bbee 100644 --- a/libguile/deprecated.c +++ b/libguile/deprecated.c @@ -429,7 +429,7 @@ scm_create_hook (const char *name, int n_args) ("'scm_create_hook' is deprecated. " "Use 'scm_make_hook' and 'scm_c_define' instead."); { - SCM hook = scm_make_hook (SCM_MAKINUM (n_args)); + SCM hook = scm_make_hook (scm_from_int (n_args)); scm_c_define (name, hook); return scm_permanent_object (hook); } @@ -467,7 +467,7 @@ SCM_DEFINE (scm_sloppy_memv, "sloppy-memv", 2, 0, 0, for(; SCM_CONSP (lst); lst = SCM_CDR(lst)) { - if (! SCM_FALSEP (scm_eqv_p (SCM_CAR (lst), x))) + if (! scm_is_false (scm_eqv_p (SCM_CAR (lst), x))) return lst; } return lst; @@ -487,7 +487,7 @@ SCM_DEFINE (scm_sloppy_member, "sloppy-member", 2, 0, 0, for(; SCM_CONSP (lst); lst = SCM_CDR(lst)) { - if (! SCM_FALSEP (scm_equal_p (SCM_CAR (lst), x))) + if (! scm_is_false (scm_equal_p (SCM_CAR (lst), x))) return lst; } return lst; @@ -712,7 +712,7 @@ scm_sym2ovcell (SCM sym, SCM obarray) "Use hashtables instead."); answer = scm_sym2ovcell_soft (sym, obarray); - if (!SCM_FALSEP (answer)) + if (scm_is_true (answer)) return answer; SCM_MISC_ERROR ("uninterned symbol: ~S", scm_list_1 (sym)); return SCM_UNSPECIFIED; /* not reached */ @@ -751,7 +751,7 @@ scm_intern_obarray_soft (const char *name,size_t len,SCM obarray,unsigned int so scm_c_issue_deprecation_warning ("`scm_intern_obarray_soft' is deprecated. " "Use hashtables instead."); - if (SCM_FALSEP (obarray)) + if (scm_is_false (obarray)) { if (softness) return SCM_BOOL_F; @@ -826,14 +826,14 @@ SCM_DEFINE (scm_string_to_obarray_symbol, "string->obarray-symbol", 2, 1, 0, int softness; SCM_VALIDATE_STRING (2, s); - SCM_ASSERT (SCM_BOOLP (o) || SCM_VECTORP (o), o, SCM_ARG1, FUNC_NAME); + SCM_ASSERT (scm_is_bool (o) || SCM_VECTORP (o), o, SCM_ARG1, FUNC_NAME); scm_c_issue_deprecation_warning ("`string->obarray-symbol' is deprecated. " "Use hashtables instead."); - softness = (!SCM_UNBNDP (softp) && !SCM_FALSEP(softp)); + softness = (!SCM_UNBNDP (softp) && scm_is_true(softp)); /* iron out some screwy calling conventions */ - if (SCM_FALSEP (o)) + if (scm_is_false (o)) { /* nothing interesting to do here. */ return scm_string_to_symbol (s); @@ -845,7 +845,7 @@ SCM_DEFINE (scm_string_to_obarray_symbol, "string->obarray-symbol", 2, 1, 0, SCM_STRING_LENGTH (s), o, softness); - if (SCM_FALSEP (vcell)) + if (scm_is_false (vcell)) return vcell; answer = SCM_CAR (vcell); return answer; @@ -861,7 +861,7 @@ SCM_DEFINE (scm_intern_symbol, "intern-symbol", 2, 0, 0, { size_t hval; SCM_VALIDATE_SYMBOL (2,s); - if (SCM_FALSEP (o)) + if (scm_is_false (o)) return SCM_UNSPECIFIED; scm_c_issue_deprecation_warning ("`intern-symbol' is deprecated. " @@ -907,7 +907,7 @@ SCM_DEFINE (scm_unintern_symbol, "unintern-symbol", 2, 0, 0, "Use hashtables instead."); SCM_VALIDATE_SYMBOL (2,s); - if (SCM_FALSEP (o)) + if (scm_is_false (o)) return SCM_BOOL_F; SCM_VALIDATE_VECTOR (1,o); hval = SCM_SYMBOL_HASH (s) % SCM_VECTOR_LENGTH (o); @@ -924,7 +924,7 @@ SCM_DEFINE (scm_unintern_symbol, "unintern-symbol", 2, 0, 0, if (SCM_EQ_P (SCM_CAR (sym), s)) { /* Found the symbol to unintern. */ - if (SCM_FALSEP (lsym_follow)) + if (scm_is_false (lsym_follow)) SCM_VECTOR_SET (o, hval, lsym); else SCM_SETCDR (lsym_follow, SCM_CDR(lsym)); @@ -952,7 +952,7 @@ SCM_DEFINE (scm_symbol_binding, "symbol-binding", 2, 0, 0, "Use hashtables instead."); SCM_VALIDATE_SYMBOL (2,s); - if (SCM_FALSEP (o)) + if (scm_is_false (o)) return scm_variable_ref (scm_lookup (s)); SCM_VALIDATE_VECTOR (1,o); vcell = scm_sym2ovcell (s, o); @@ -973,7 +973,7 @@ SCM_DEFINE (scm_symbol_interned_p, "symbol-interned?", 2, 0, 0, "Use hashtables instead."); SCM_VALIDATE_SYMBOL (2,s); - if (SCM_FALSEP (o)) + if (scm_is_false (o)) { SCM var = scm_sym2var (s, SCM_BOOL_F, SCM_BOOL_F); if (var != SCM_BOOL_F) @@ -1005,7 +1005,7 @@ SCM_DEFINE (scm_symbol_bound_p, "symbol-bound?", 2, 0, 0, "Use hashtables instead."); SCM_VALIDATE_SYMBOL (2,s); - if (SCM_FALSEP (o)) + if (scm_is_false (o)) { SCM var = scm_sym2var (s, SCM_BOOL_F, SCM_BOOL_F); if (SCM_VARIABLEP(var) && !SCM_UNBNDP(SCM_VARIABLE_REF(var))) @@ -1014,7 +1014,7 @@ SCM_DEFINE (scm_symbol_bound_p, "symbol-bound?", 2, 0, 0, } SCM_VALIDATE_VECTOR (1,o); vcell = scm_sym2ovcell_soft (s, o); - return SCM_BOOL (SCM_NIMP (vcell) && !SCM_UNBNDP (SCM_CDR (vcell))); + return scm_from_bool (SCM_NIMP (vcell) && !SCM_UNBNDP (SCM_CDR (vcell))); } #undef FUNC_NAME @@ -1032,7 +1032,7 @@ SCM_DEFINE (scm_symbol_set_x, "symbol-set!", 3, 0, 0, "Use the module system instead."); SCM_VALIDATE_SYMBOL (2,s); - if (SCM_FALSEP (o)) + if (scm_is_false (o)) { scm_define (s, v); return SCM_UNSPECIFIED; @@ -1089,7 +1089,7 @@ SCM_DEFINE (scm_gentemp, "gentemp", 0, 2, 0, FUNC_NAME); do n_digits = scm_iint2str (gentemp_counter++, 10, &name[len]); - while (!SCM_FALSEP (scm_intern_obarray_soft (name, + while (scm_is_true (scm_intern_obarray_soft (name, len + n_digits, obarray, 1))); @@ -1105,6 +1105,16 @@ SCM_DEFINE (scm_gentemp, "gentemp", 0, 2, 0, } #undef FUNC_NAME +#if 0 +SCM +SCM_MAKINUM (scm_t_signed_bits val) +{ + scm_c_issue_deprecation_warning + ("SCM_MAKINUM is deprecated. Use scm_from_int or similar instead."); + return scm_from_int (val); +} +#endif + void scm_i_init_deprecated () { diff --git a/libguile/deprecation.c b/libguile/deprecation.c index e4597dfd2..2c7d2a413 100644 --- a/libguile/deprecation.c +++ b/libguile/deprecation.c @@ -142,7 +142,7 @@ SCM_DEFINE(scm_include_deprecated_features, "in public interfaces.") #define FUNC_NAME s_scm_include_deprecated_features { - return SCM_BOOL (SCM_ENABLE_DEPRECATED == 1); + return scm_from_bool (SCM_ENABLE_DEPRECATED == 1); } #undef FUNC_NAME diff --git a/libguile/dynl.c b/libguile/dynl.c index d6175a76c..16431b0cc 100644 --- a/libguile/dynl.c +++ b/libguile/dynl.c @@ -163,7 +163,7 @@ SCM_DEFINE (scm_dynamic_object_p, "dynamic-object?", 1, 0, 0, "or @code{#f} otherwise.") #define FUNC_NAME s_scm_dynamic_object_p { - return SCM_BOOL (SCM_TYP16_PREDICATE (scm_tc16_dynamic_obj, obj)); + return scm_from_bool (SCM_TYP16_PREDICATE (scm_tc16_dynamic_obj, obj)); } #undef FUNC_NAME diff --git a/libguile/dynwind.c b/libguile/dynwind.c index 5f13c9242..8dc5a4e03 100644 --- a/libguile/dynwind.c +++ b/libguile/dynwind.c @@ -98,7 +98,7 @@ SCM_DEFINE (scm_dynamic_wind, "dynamic-wind", 3, 0, 0, #define FUNC_NAME s_scm_dynamic_wind { SCM ans; - SCM_ASSERT (SCM_NFALSEP (scm_thunk_p (out_guard)), + SCM_ASSERT (scm_is_true (scm_thunk_p (out_guard)), out_guard, SCM_ARG3, FUNC_NAME); scm_call_0 (in_guard); diff --git a/libguile/environments.c b/libguile/environments.c index 7086a0c96..92b46f570 100644 --- a/libguile/environments.c +++ b/libguile/environments.c @@ -106,7 +106,7 @@ SCM_DEFINE (scm_environment_p, "environment?", 1, 0, 0, "otherwise.") #define FUNC_NAME s_scm_environment_p { - return SCM_BOOL (SCM_ENVIRONMENT_P (obj)); + return scm_from_bool (SCM_ENVIRONMENT_P (obj)); } #undef FUNC_NAME @@ -120,7 +120,7 @@ SCM_DEFINE (scm_environment_bound_p, "environment-bound?", 2, 0, 0, SCM_ASSERT (SCM_ENVIRONMENT_P (env), env, SCM_ARG1, FUNC_NAME); SCM_ASSERT (SCM_SYMBOLP (sym), sym, SCM_ARG2, FUNC_NAME); - return SCM_BOOL (SCM_ENVIRONMENT_BOUND_P (env, sym)); + return scm_from_bool (SCM_ENVIRONMENT_BOUND_P (env, sym)); } #undef FUNC_NAME @@ -330,9 +330,9 @@ SCM_DEFINE (scm_environment_cell, "environment-cell", 3, 0, 0, SCM_ASSERT (SCM_ENVIRONMENT_P (env), env, SCM_ARG1, FUNC_NAME); SCM_ASSERT (SCM_SYMBOLP (sym), sym, SCM_ARG2, FUNC_NAME); - SCM_ASSERT (SCM_BOOLP (for_write), for_write, SCM_ARG3, FUNC_NAME); + SCM_ASSERT (scm_is_bool (for_write), for_write, SCM_ARG3, FUNC_NAME); - location = SCM_ENVIRONMENT_CELL (env, sym, !SCM_FALSEP (for_write)); + location = SCM_ENVIRONMENT_CELL (env, sym, scm_is_true (for_write)); if (!SCM_IMP (location)) return location; else if (SCM_UNBNDP (location)) @@ -921,7 +921,7 @@ leaf_environment_undefine (SCM env, SCM sym) SCM obarray = LEAF_ENVIRONMENT (env)->obarray; SCM removed = obarray_remove (obarray, sym); - if (!SCM_FALSEP (removed)) + if (scm_is_true (removed)) core_environments_broadcast (env); return SCM_ENVIRONMENT_SUCCESS; @@ -1037,7 +1037,7 @@ SCM_DEFINE (scm_leaf_environment_p, "leaf-environment?", 1, 0, 0, "otherwise.") #define FUNC_NAME s_scm_leaf_environment_p { - return SCM_BOOL (SCM_LEAF_ENVIRONMENT_P (object)); + return scm_from_bool (SCM_LEAF_ENVIRONMENT_P (object)); } #undef FUNC_NAME @@ -1439,7 +1439,7 @@ SCM_DEFINE (scm_eval_environment_p, "eval-environment?", 1, 0, 0, "otherwise.") #define FUNC_NAME s_scm_eval_environment_p { - return SCM_BOOL (SCM_EVAL_ENVIRONMENT_P (object)); + return scm_from_bool (SCM_EVAL_ENVIRONMENT_P (object)); } #undef FUNC_NAME @@ -1851,7 +1851,7 @@ SCM_DEFINE (scm_import_environment_p, "import-environment?", 1, 0, 0, "@code{#f} otherwise.") #define FUNC_NAME s_scm_import_environment_p { - return SCM_BOOL (SCM_IMPORT_ENVIRONMENT_P (object)); + return scm_from_bool (SCM_IMPORT_ENVIRONMENT_P (object)); } #undef FUNC_NAME @@ -1946,7 +1946,7 @@ export_environment_ref (SCM env, SCM sym) struct export_environment *body = EXPORT_ENVIRONMENT (env); SCM entry = scm_assq (sym, body->signature); - if (SCM_FALSEP (entry)) + if (scm_is_false (entry)) return SCM_UNDEFINED; else return SCM_ENVIRONMENT_REF (body->private, sym); @@ -1999,7 +1999,7 @@ export_environment_set_x (SCM env, SCM sym, SCM val) struct export_environment *body = EXPORT_ENVIRONMENT (env); SCM entry = scm_assq (sym, body->signature); - if (SCM_FALSEP (entry)) + if (scm_is_false (entry)) { return SCM_UNDEFINED; } @@ -2021,7 +2021,7 @@ export_environment_cell (SCM env, SCM sym, int for_write) struct export_environment *body = EXPORT_ENVIRONMENT (env); SCM entry = scm_assq (sym, body->signature); - if (SCM_FALSEP (entry)) + if (scm_is_false (entry)) { return SCM_UNDEFINED; } @@ -2177,7 +2177,7 @@ SCM_DEFINE (scm_export_environment_p, "export-environment?", 1, 0, 0, "@code{#f} otherwise.") #define FUNC_NAME s_scm_export_environment_p { - return SCM_BOOL (SCM_EXPORT_ENVIRONMENT_P (object)); + return scm_from_bool (SCM_EXPORT_ENVIRONMENT_P (object)); } #undef FUNC_NAME diff --git a/libguile/eq.c b/libguile/eq.c index 40d5d86ec..7f368ed1a 100644 --- a/libguile/eq.c +++ b/libguile/eq.c @@ -47,7 +47,7 @@ SCM_DEFINE1 (scm_eq_p, "eq?", scm_tc7_rpsubr, "@code{eqv?}.") #define FUNC_NAME s_scm_eq_p { - return SCM_BOOL (SCM_EQ_P (x, y)); + return scm_from_bool (SCM_EQ_P (x, y)); } #undef FUNC_NAME @@ -90,12 +90,12 @@ SCM_PRIMITIVE_GENERIC_1 (scm_eqv_p, "eqv?", scm_tc7_rpsubr, if (SCM_INEXACTP (x)) { if (SCM_REALP (x)) - return SCM_BOOL (SCM_COMPLEXP (y) + return scm_from_bool (SCM_COMPLEXP (y) && real_eqv (SCM_REAL_VALUE (x), SCM_COMPLEX_REAL (y)) && SCM_COMPLEX_IMAG (y) == 0.0); else - return SCM_BOOL (SCM_REALP (y) + return scm_from_bool (SCM_REALP (y) && real_eqv (SCM_COMPLEX_REAL (x), SCM_REAL_VALUE (y)) && SCM_COMPLEX_IMAG (x) == 0.0); @@ -108,13 +108,13 @@ SCM_PRIMITIVE_GENERIC_1 (scm_eqv_p, "eqv?", scm_tc7_rpsubr, if (SCM_NUMP (x)) { if (SCM_BIGP (x)) { - return SCM_BOOL (scm_i_bigcmp (x, y) == 0); + return scm_from_bool (scm_i_bigcmp (x, y) == 0); } else if (SCM_REALP (x)) { - return SCM_BOOL (real_eqv (SCM_REAL_VALUE (x), SCM_REAL_VALUE (y))); + return scm_from_bool (real_eqv (SCM_REAL_VALUE (x), SCM_REAL_VALUE (y))); } else if (SCM_FRACTIONP (x)) { return scm_i_fraction_equalp (x, y); } else { /* complex */ - return SCM_BOOL (real_eqv (SCM_COMPLEX_REAL (x), + return scm_from_bool (real_eqv (SCM_COMPLEX_REAL (x), SCM_COMPLEX_REAL (y)) && real_eqv (SCM_COMPLEX_IMAG (x), SCM_COMPLEX_IMAG (y))); @@ -149,7 +149,7 @@ SCM_PRIMITIVE_GENERIC_1 (scm_equal_p, "equal?", scm_tc7_rpsubr, return SCM_BOOL_F; if (SCM_CONSP (x) && SCM_CONSP (y)) { - if (SCM_FALSEP (scm_equal_p (SCM_CAR (x), SCM_CAR (y)))) + if (scm_is_false (scm_equal_p (SCM_CAR (x), SCM_CAR (y)))) return SCM_BOOL_F; x = SCM_CDR(x); y = SCM_CDR(y); @@ -164,11 +164,11 @@ SCM_PRIMITIVE_GENERIC_1 (scm_equal_p, "equal?", scm_tc7_rpsubr, if (SCM_INEXACTP (x) && SCM_INEXACTP (y)) { if (SCM_REALP (x)) - return SCM_BOOL (SCM_COMPLEXP (y) + return scm_from_bool (SCM_COMPLEXP (y) && SCM_REAL_VALUE (x) == SCM_COMPLEX_REAL (y) && SCM_COMPLEX_IMAG (y) == 0.0); else - return SCM_BOOL (SCM_REALP (y) + return scm_from_bool (SCM_REALP (y) && SCM_COMPLEX_REAL (x) == SCM_REAL_VALUE (y) && SCM_COMPLEX_IMAG (x) == 0.0); } @@ -177,17 +177,17 @@ SCM_PRIMITIVE_GENERIC_1 (scm_equal_p, "equal?", scm_tc7_rpsubr, else if ((SCM_FRACTIONP (x)) && (SCM_INEXACTP (y))) { if (SCM_REALP (y)) - return SCM_BOOL (scm_i_fraction2double (x) == SCM_REAL_VALUE (y)); + return scm_from_bool (scm_i_fraction2double (x) == SCM_REAL_VALUE (y)); else - return SCM_BOOL (SCM_COMPLEX_REAL (y) == scm_i_fraction2double (x) + return scm_from_bool (SCM_COMPLEX_REAL (y) == scm_i_fraction2double (x) && SCM_COMPLEX_IMAG (y) == 0.0); } else if ((SCM_FRACTIONP (y)) && (SCM_INEXACTP (x))) { if (SCM_REALP (x)) - return SCM_BOOL (scm_i_fraction2double (y) == SCM_REAL_VALUE (x)); + return scm_from_bool (scm_i_fraction2double (y) == SCM_REAL_VALUE (x)); else - return SCM_BOOL (SCM_COMPLEX_REAL (x) == scm_i_fraction2double (y) + return scm_from_bool (SCM_COMPLEX_REAL (x) == scm_i_fraction2double (y) && SCM_COMPLEX_IMAG (x) == 0.0); } diff --git a/libguile/error.c b/libguile/error.c index fd6d70709..76023a232 100644 --- a/libguile/error.c +++ b/libguile/error.c @@ -102,7 +102,7 @@ SCM_DEFINE (scm_error_scm, "scm-error", 5, 0, 0, SCM_VALIDATE_SYMBOL (1, key); - if (SCM_FALSEP (subr)) + if (scm_is_false (subr)) { szSubr = NULL; } @@ -116,7 +116,7 @@ SCM_DEFINE (scm_error_scm, "scm-error", 5, 0, 0, szSubr = SCM_STRING_CHARS (subr); } - if (SCM_FALSEP (message)) + if (scm_is_false (message)) { szMessage = NULL; } @@ -163,7 +163,7 @@ scm_syserror (const char *subr) subr, "~A", scm_cons (scm_makfrom0str (SCM_I_STRERROR (save_errno)), SCM_EOL), - scm_cons (SCM_MAKINUM (save_errno), SCM_EOL)); + scm_cons (scm_from_int (save_errno), SCM_EOL)); } void @@ -173,7 +173,7 @@ scm_syserror_msg (const char *subr, const char *message, SCM args, int eno) subr, message, args, - scm_cons (SCM_MAKINUM (eno), SCM_EOL)); + scm_cons (scm_from_int (eno), SCM_EOL)); } SCM_GLOBAL_SYMBOL (scm_num_overflow_key, "numerical-overflow"); diff --git a/libguile/eval.c b/libguile/eval.c index 1267aebe1..d7b37f4b9 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -266,7 +266,7 @@ syntax_error (const char* const msg, const SCM form, const SCM expr) linenr = scm_source_property (form, scm_sym_line); } - if (SCM_FALSEP (filename) && SCM_FALSEP (linenr) && SCM_CONSP (expr)) + if (scm_is_false (filename) && scm_is_false (linenr) && SCM_CONSP (expr)) { filename = scm_source_property (expr, scm_sym_filename); linenr = scm_source_property (expr, scm_sym_line); @@ -274,12 +274,12 @@ syntax_error (const char* const msg, const SCM form, const SCM expr) if (!SCM_UNBNDP (expr)) { - if (!SCM_FALSEP (filename)) + if (scm_is_true (filename)) { format = "In file ~S, line ~S: ~A ~S in expression ~S."; args = scm_list_5 (filename, linenr, msg_string, form, expr); } - else if (!SCM_FALSEP (linenr)) + else if (scm_is_true (linenr)) { format = "In line ~S: ~A ~S in expression ~S."; args = scm_list_4 (linenr, msg_string, form, expr); @@ -292,12 +292,12 @@ syntax_error (const char* const msg, const SCM form, const SCM expr) } else { - if (!SCM_FALSEP (filename)) + if (scm_is_true (filename)) { format = "In file ~S, line ~S: ~A ~S."; args = scm_list_4 (filename, linenr, msg_string, form); } - else if (!SCM_FALSEP (linenr)) + else if (scm_is_true (linenr)) { format = "In line ~S: ~A ~S."; args = scm_list_3 (linenr, msg_string, form); @@ -369,7 +369,7 @@ SCM_DEFINE (scm_dbg_make_iloc, "dbg-make-iloc", 3, 0, 0, SCM_VALIDATE_INUM (2, binding); return SCM_MAKE_ILOC (SCM_INUM (frame), SCM_INUM (binding), - !SCM_FALSEP (cdrp)); + scm_is_true (cdrp)); } #undef FUNC_NAME @@ -380,7 +380,7 @@ SCM_DEFINE (scm_dbg_iloc_p, "dbg-iloc?", 1, 0, 0, "Return @code{#t} if @var{obj} is an iloc.") #define FUNC_NAME s_scm_dbg_iloc_p { - return SCM_BOOL (SCM_ILOCP (obj)); + return scm_from_bool (SCM_ILOCP (obj)); } #undef FUNC_NAME @@ -450,7 +450,7 @@ static SCM lookup_global_symbol (const SCM symbol, const SCM top_level) { const SCM variable = scm_sym2var (symbol, top_level, SCM_BOOL_F); - if (SCM_FALSEP (variable)) + if (scm_is_false (variable)) return SCM_UNDEFINED; else return variable; @@ -555,7 +555,7 @@ unmemoize_expression (const SCM expr, const SCM env) else if (SCM_VARIABLEP (expr)) { const SCM sym = scm_module_reverse_lookup (scm_env_module (env), expr); - return !SCM_FALSEP (sym) ? sym : sym_three_question_marks; + return scm_is_true (sym) ? sym : sym_three_question_marks; } else if (SCM_VECTORP (expr)) { @@ -995,7 +995,7 @@ scm_m_case (SCM expr, SCM env) for (; !SCM_NULLP (all_labels); all_labels = SCM_CDR (all_labels)) { const SCM label = SCM_CAR (all_labels); - ASSERT_SYNTAX_2 (SCM_FALSEP (scm_c_memq (label, SCM_CDR (all_labels))), + ASSERT_SYNTAX_2 (scm_is_false (scm_c_memq (label, SCM_CDR (all_labels))), s_duplicate_case_label, label, expr); } @@ -1207,7 +1207,7 @@ scm_m_define (SCM expr, SCM env) tmp = SCM_MACRO_CODE (tmp); if (SCM_CLOSUREP (tmp) /* Only the first definition determines the name. */ - && SCM_FALSEP (scm_procedure_property (tmp, scm_sym_name))) + && scm_is_false (scm_procedure_property (tmp, scm_sym_name))) scm_set_procedure_property_x (tmp, scm_sym_name, variable); } @@ -1311,7 +1311,7 @@ scm_m_do (SCM expr, SCM env SCM_UNUSED) const SCM init = SCM_CADR (binding); const SCM step = (length == 2) ? name : SCM_CADDR (binding); ASSERT_SYNTAX_2 (SCM_SYMBOLP (name), s_bad_variable, name, expr); - ASSERT_SYNTAX_2 (SCM_FALSEP (scm_c_memq (name, variables)), + ASSERT_SYNTAX_2 (scm_is_false (scm_c_memq (name, variables)), s_duplicate_binding, name, expr); variables = scm_cons (name, variables); @@ -1546,7 +1546,7 @@ transform_bindings ( const SCM binding = SCM_CAR (binding_idx); const SCM cdr_binding = SCM_CDR (binding); const SCM name = SCM_CAR (binding); - ASSERT_SYNTAX_2 (SCM_FALSEP (scm_c_memq (name, rvariables)), + ASSERT_SYNTAX_2 (scm_is_false (scm_c_memq (name, rvariables)), s_duplicate_binding, name, expr); rvariables = scm_cons (name, rvariables); rinits = scm_cons (SCM_CAR (cdr_binding), rinits); @@ -2028,7 +2028,7 @@ scm_m_atbind (SCM expr, SCM env) * while the second call wont. */ const SCM variable = SCM_CAR (variable_idx); SCM new_variable = scm_sym2var (variable, top_level, SCM_BOOL_F); - if (SCM_FALSEP (new_variable)) + if (scm_is_false (new_variable)) new_variable = scm_sym2var (variable, top_level, SCM_BOOL_T); SCM_SETCAR (variable_idx, new_variable); } @@ -2408,7 +2408,7 @@ scm_i_unmemocopy_expr (SCM expr, SCM env) const SCM source_properties = scm_whash_lookup (scm_source_whash, expr); const SCM um_expr = unmemoize_expression (expr, env); - if (!SCM_FALSEP (source_properties)) + if (scm_is_true (source_properties)) scm_whash_insert (scm_source_whash, um_expr, source_properties); return um_expr; @@ -2420,7 +2420,7 @@ scm_i_unmemocopy_body (SCM forms, SCM env) const SCM source_properties = scm_whash_lookup (scm_source_whash, forms); const SCM um_forms = unmemoize_exprs (forms, env); - if (!SCM_FALSEP (source_properties)) + if (scm_is_true (source_properties)) scm_whash_insert (scm_source_whash, um_forms, source_properties); return um_forms; @@ -2459,7 +2459,7 @@ scm_m_undefine (SCM expr, SCM env) variable = SCM_CAR (cdr_expr); ASSERT_SYNTAX_2 (SCM_SYMBOLP (variable), s_bad_variable, variable, expr); location = scm_sym2var (variable, scm_env_top_level (env), SCM_BOOL_F); - ASSERT_SYNTAX_2 (!SCM_FALSEP (location) + ASSERT_SYNTAX_2 (scm_is_true (location) && !SCM_UNBNDP (SCM_VARIABLE_REF (location)), "variable already unbound ", variable, expr); SCM_VARIABLE_SET (location, SCM_UNDEFINED); @@ -2493,7 +2493,7 @@ scm_unmemocar (SCM form, SCM env) if (SCM_VARIABLEP (c)) { SCM sym = scm_module_reverse_lookup (scm_env_module (env), c); - if (SCM_FALSEP (sym)) + if (scm_is_false (sym)) sym = sym_three_question_marks; SCM_SETCAR (form, sym); } @@ -2812,7 +2812,7 @@ scm_lookupcar1 (SCM vloc, SCM genv, int check) else top_thunk = SCM_BOOL_F; real_var = scm_sym2var (var, top_thunk, SCM_BOOL_F); - if (SCM_FALSEP (real_var)) + if (scm_is_false (real_var)) goto errout; if (!SCM_NULLP (env) || SCM_UNBNDP (SCM_VARIABLE_REF (real_var))) @@ -2878,7 +2878,7 @@ lazy_memoize_variable (const SCM symbol, const SCM environment) const SCM top_level = scm_env_top_level (environment); const SCM variable = scm_sym2var (symbol, top_level, SCM_BOOL_F); - if (SCM_FALSEP (variable)) + if (scm_is_false (variable)) error_unbound_variable (symbol); else return variable; @@ -2978,7 +2978,7 @@ do { \ if (scm_check_apply_p && SCM_TRAPS_P)\ if (SCM_APPLY_FRAME_P || (SCM_TRACE_P && PROCTRACEP (proc)))\ {\ - SCM tmp, tail = SCM_BOOL(SCM_TRACED_FRAME_P (debug)); \ + SCM tmp, tail = scm_from_bool(SCM_TRACED_FRAME_P (debug)); \ SCM_SET_TRACED_FRAME (debug); \ SCM_TRAPS_P = 0;\ if (SCM_CHEAPTRAPS_P)\ @@ -3229,7 +3229,7 @@ start: || (SCM_BREAKPOINTS_P && scm_c_source_property_breakpoint_p (x))) { SCM stackrep; - SCM tail = SCM_BOOL (SCM_TAILRECP (debug)); + SCM tail = scm_from_bool (SCM_TAILRECP (debug)); SCM_SET_TAILREC (debug); if (SCM_CHEAPTRAPS_P) stackrep = scm_make_debugobj (&debug); @@ -3272,7 +3272,7 @@ dispatch: while (!SCM_NULLP (SCM_CDR (x))) { SCM test_result = EVALCAR (x, env); - if (SCM_FALSEP (test_result) || SCM_NILP (test_result)) + if (scm_is_false (test_result) || SCM_NILP (test_result)) RETURN (SCM_BOOL_F); else x = SCM_CDR (x); @@ -3368,7 +3368,7 @@ dispatch: { const SCM label = SCM_CAR (labels); if (SCM_EQ_P (label, key) - || !SCM_FALSEP (scm_eqv_p (label, key))) + || scm_is_true (scm_eqv_p (label, key))) { x = SCM_CDR (clause); PREP_APPLY (SCM_UNDEFINED, SCM_EOL); @@ -3396,7 +3396,7 @@ dispatch: else { arg1 = EVALCAR (clause, env); - if (!SCM_FALSEP (arg1) && !SCM_NILP (arg1)) + if (scm_is_true (arg1) && !SCM_NILP (arg1)) { x = SCM_CDR (clause); if (SCM_NULLP (x)) @@ -3443,7 +3443,7 @@ dispatch: SCM test_result = EVALCAR (test_form, env); - while (SCM_FALSEP (test_result) || SCM_NILP (test_result)) + while (scm_is_false (test_result) || SCM_NILP (test_result)) { { /* Evaluate body forms. */ @@ -3497,7 +3497,7 @@ dispatch: { SCM test_result = EVALCAR (x, env); x = SCM_CDR (x); /* then expression */ - if (SCM_FALSEP (test_result) || SCM_NILP (test_result)) + if (scm_is_false (test_result) || SCM_NILP (test_result)) { x = SCM_CDR (x); /* else expression */ if (SCM_NULLP (x)) @@ -3572,7 +3572,7 @@ dispatch: while (!SCM_NULLP (SCM_CDR (x))) { SCM val = EVALCAR (x, env); - if (!SCM_FALSEP (val) && !SCM_NILP (val)) + if (scm_is_true (val) && !SCM_NILP (val)) RETURN (val); else x = SCM_CDR (x); @@ -3853,7 +3853,7 @@ dispatch: while (!SCM_NULL_OR_NIL_P (x)) { SCM test_result = EVALCAR (test_form, env); - if (!(SCM_FALSEP (test_result) + if (!(scm_is_false (test_result) || SCM_NULL_OR_NIL_P (test_result))) { if (SCM_EQ_P (SCM_CAR (x), SCM_UNSPECIFIED)) @@ -4409,12 +4409,12 @@ dispatch: while (SCM_NIMP (arg2)); RETURN (arg1); case scm_tc7_rpsubr: - if (SCM_FALSEP (SCM_SUBRF (proc) (arg1, arg2))) + if (scm_is_false (SCM_SUBRF (proc) (arg1, arg2))) RETURN (SCM_BOOL_F); arg1 = SCM_CDDR (debug.info->a.args); do { - if (SCM_FALSEP (SCM_SUBRF (proc) (arg2, SCM_CAR (arg1)))) + if (scm_is_false (SCM_SUBRF (proc) (arg2, SCM_CAR (arg1)))) RETURN (SCM_BOOL_F); arg2 = SCM_CAR (arg1); arg1 = SCM_CDR (arg1); @@ -4471,12 +4471,12 @@ dispatch: while (!SCM_NULLP (x)); RETURN (arg1); case scm_tc7_rpsubr: - if (SCM_FALSEP (SCM_SUBRF (proc) (arg1, arg2))) + if (scm_is_false (SCM_SUBRF (proc) (arg1, arg2))) RETURN (SCM_BOOL_F); do { arg1 = EVALCAR (x, env); - if (SCM_FALSEP (SCM_SUBRF (proc) (arg2, arg1))) + if (scm_is_false (SCM_SUBRF (proc) (arg2, arg1))) RETURN (SCM_BOOL_F); arg2 = arg1; x = SCM_CDR (x); @@ -4893,7 +4893,7 @@ tail: while (SCM_NIMP (args)) { SCM_ASSERT (SCM_CONSP (args), args, SCM_ARG2, "apply"); - if (SCM_FALSEP (SCM_SUBRF (proc) (arg1, SCM_CAR (args)))) + if (scm_is_false (SCM_SUBRF (proc) (arg1, SCM_CAR (args)))) RETURN (SCM_BOOL_F); arg1 = SCM_CAR (args); args = SCM_CDR (args); @@ -5629,7 +5629,7 @@ SCM_DEFINE (scm_promise_p, "promise?", 1, 0, 0, "(@pxref{Delayed evaluation,,,r5rs.info,The Revised^5 Report on Scheme}).") #define FUNC_NAME s_scm_promise_p { - return SCM_BOOL (SCM_TYP16_PREDICATE (scm_tc16_promise, obj)); + return scm_from_bool (SCM_TYP16_PREDICATE (scm_tc16_promise, obj)); } #undef FUNC_NAME @@ -5645,7 +5645,7 @@ SCM_DEFINE (scm_cons_source, "cons-source", 3, 0, 0, z = scm_cons (x, y); /* Copy source properties possibly associated with xorig. */ p = scm_whash_lookup (scm_source_whash, xorig); - if (!SCM_FALSEP (p)) + if (scm_is_true (p)) scm_whash_insert (scm_source_whash, z, p); return z; } @@ -5886,7 +5886,7 @@ SCM_DEFINE (scm_primitive_eval, "primitive-eval", 1, 0, 0, { SCM env; SCM transformer = scm_current_module_transformer (); - if (!SCM_FALSEP (transformer)) + if (scm_is_true (transformer)) exp = scm_call_1 (transformer, exp); env = scm_top_level_env (scm_current_module_lookup_closure ()); return scm_i_eval (exp, env); diff --git a/libguile/evalext.c b/libguile/evalext.c index 0590f48c9..c6e6dea76 100644 --- a/libguile/evalext.c +++ b/libguile/evalext.c @@ -49,7 +49,7 @@ SCM_DEFINE (scm_defined_p, "defined?", 1, 1, 0, { SCM_ASSERT (SCM_CONSP (frames), env, SCM_ARG2, FUNC_NAME); b = SCM_CAR (frames); - if (!SCM_FALSEP (scm_procedure_p (b))) + if (scm_is_true (scm_procedure_p (b))) break; SCM_ASSERT (SCM_CONSP (b), env, SCM_ARG2, FUNC_NAME); for (b = SCM_CAR (b); SCM_NIMP (b); b = SCM_CDR (b)) @@ -70,7 +70,7 @@ SCM_DEFINE (scm_defined_p, "defined?", 1, 1, 0, SCM_BOOL_F); } - return (SCM_FALSEP (var) || SCM_UNBNDP (SCM_VARIABLE_REF (var)) + return (scm_is_false (var) || SCM_UNBNDP (SCM_VARIABLE_REF (var)) ? SCM_BOOL_F : SCM_BOOL_T); } @@ -93,7 +93,7 @@ SCM_DEFINE (scm_self_evaluating_p, "self-evaluating?", 1, 0, 0, return SCM_BOOL_T; case scm_tc3_imm24: /* characters, booleans, other immediates */ - return SCM_BOOL (!SCM_NULLP (obj)); + return scm_from_bool (!SCM_NULLP (obj)); case scm_tc3_cons: switch (SCM_TYP7 (obj)) { diff --git a/libguile/filesys.c b/libguile/filesys.c index 3c58d1f79..69414043e 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -388,7 +388,7 @@ SCM_DEFINE (scm_close, "close", 1, 0, 0, not an error. */ if (rv < 0 && errno != EBADF) SCM_SYSERROR; - return SCM_BOOL (rv >= 0); + return scm_from_bool (rv >= 0); } #undef FUNC_NAME @@ -785,7 +785,7 @@ SCM_DEFINE (scm_directory_stream_p, "directory-stream?", 1, 0, 0, "stream as returned by @code{opendir}.") #define FUNC_NAME s_scm_directory_stream_p { - return SCM_BOOL (SCM_DIRP (obj)); + return scm_from_bool (SCM_DIRP (obj)); } #undef FUNC_NAME @@ -1209,7 +1209,7 @@ SCM_DEFINE (scm_select, "select", 3, 2, 0, timeout.tv_usec = 0; time_ptr = &timeout; } - else if (SCM_UNBNDP (secs) || SCM_FALSEP (secs)) + else if (SCM_UNBNDP (secs) || scm_is_false (secs)) time_ptr = 0; else { diff --git a/libguile/fluids.c b/libguile/fluids.c index 6cae477cc..da4b317e0 100644 --- a/libguile/fluids.c +++ b/libguile/fluids.c @@ -113,7 +113,7 @@ SCM_DEFINE (scm_fluid_p, "fluid?", 1, 0, 0, "@code{#f}.") #define FUNC_NAME s_scm_fluid_p { - return SCM_BOOL(SCM_FLUIDP (obj)); + return scm_from_bool(SCM_FLUIDP (obj)); } #undef FUNC_NAME diff --git a/libguile/fports.c b/libguile/fports.c index e30d7bb8c..3077318e5 100644 --- a/libguile/fports.c +++ b/libguile/fports.c @@ -228,7 +228,7 @@ SCM_DEFINE (scm_file_port_p, "file-port?", 1, 0, 0, "Determine whether @var{obj} is a port that is related to a file.") #define FUNC_NAME s_scm_file_port_p { - return SCM_BOOL (SCM_FPORTP (obj)); + return scm_from_bool (SCM_FPORTP (obj)); } #undef FUNC_NAME diff --git a/libguile/gc.c b/libguile/gc.c index 2eebbb59c..c8709e03b 100644 --- a/libguile/gc.c +++ b/libguile/gc.c @@ -181,7 +181,7 @@ SCM_DEFINE (scm_set_debug_cell_accesses_x, "set-debug-cell-accesses!", 1, 0, 0, "@code{SCM_DEBUG_CELL_ACCESSES} was set to 1.") #define FUNC_NAME s_scm_set_debug_cell_accesses_x { - if (SCM_FALSEP (flag)) + if (scm_is_false (flag)) { scm_debug_cell_accesses_p = 0; } @@ -745,7 +745,7 @@ scm_gc_unprotect_object (SCM obj) handle = scm_hashq_get_handle (scm_protects, obj); - if (SCM_FALSEP (handle)) + if (scm_is_false (handle)) { fprintf (stderr, "scm_unprotect_object called on unprotected object\n"); abort (); @@ -791,7 +791,7 @@ scm_gc_unregister_root (SCM *p) handle = scm_hashv_get_handle (scm_gc_registered_roots, key); - if (SCM_FALSEP (handle)) + if (scm_is_false (handle)) { fprintf (stderr, "scm_gc_unregister_root called on unregistered root\n"); abort (); diff --git a/libguile/gh_data.c b/libguile/gh_data.c index 4db7ea273..e08207ffe 100644 --- a/libguile/gh_data.c +++ b/libguile/gh_data.c @@ -31,7 +31,7 @@ SCM gh_bool2scm (int x) { - return SCM_BOOL(x); + return scm_from_bool(x); } SCM gh_int2scm (int x) @@ -182,7 +182,7 @@ gh_doubles2dvect (const double *d, long n) int gh_scm2bool (SCM obj) { - return (SCM_FALSEP (obj)) ? 0 : 1; + return (scm_is_false (obj)) ? 0 : 1; } unsigned long gh_scm2ulong (SCM obj) diff --git a/libguile/gh_predicates.c b/libguile/gh_predicates.c index cd4290505..655bd8b2c 100644 --- a/libguile/gh_predicates.c +++ b/libguile/gh_predicates.c @@ -24,74 +24,74 @@ int gh_boolean_p (SCM val) { - return (SCM_NFALSEP (scm_boolean_p (val))); + return (scm_is_true (scm_boolean_p (val))); } int gh_symbol_p (SCM val) { - return (SCM_NFALSEP (scm_symbol_p (val))); + return (scm_is_true (scm_symbol_p (val))); } int gh_char_p (SCM val) { - return (SCM_NFALSEP (scm_char_p (val))); + return (scm_is_true (scm_char_p (val))); } int gh_vector_p (SCM val) { - return (SCM_NFALSEP (scm_vector_p (val))); + return (scm_is_true (scm_vector_p (val))); } int gh_pair_p (SCM val) { - return (SCM_NFALSEP (scm_pair_p (val))); + return (scm_is_true (scm_pair_p (val))); } int gh_number_p (SCM val) { - return (SCM_NFALSEP (scm_number_p (val))); + return (scm_is_true (scm_number_p (val))); } int gh_string_p (SCM val) { - return (SCM_NFALSEP (scm_string_p (val))); + return (scm_is_true (scm_string_p (val))); } int gh_procedure_p (SCM val) { - return (SCM_NFALSEP (scm_procedure_p (val))); + return (scm_is_true (scm_procedure_p (val))); } int gh_list_p (SCM val) { - return (SCM_NFALSEP (scm_list_p (val))); + return (scm_is_true (scm_list_p (val))); } int gh_inexact_p (SCM val) { - return (SCM_NFALSEP (scm_inexact_p (val))); + return (scm_is_true (scm_inexact_p (val))); } int gh_exact_p (SCM val) { - return (SCM_NFALSEP (scm_exact_p (val))); + return (scm_is_true (scm_exact_p (val))); } /* the three types of equality */ int gh_eq_p (SCM x, SCM y) { - return (SCM_NFALSEP (scm_eq_p (x, y))); + return (scm_is_true (scm_eq_p (x, y))); } int gh_eqv_p (SCM x, SCM y) { - return (SCM_NFALSEP (scm_eqv_p (x, y))); + return (scm_is_true (scm_eqv_p (x, y))); } int gh_equal_p (SCM x, SCM y) { - return (SCM_NFALSEP (scm_equal_p (x, y))); + return (scm_is_true (scm_equal_p (x, y))); } /* equivalent to (string=? ...), but returns 0 or 1 rather than Scheme @@ -99,7 +99,7 @@ gh_equal_p (SCM x, SCM y) int gh_string_equal_p(SCM s1, SCM s2) { - return (SCM_NFALSEP (scm_string_equal_p(s1, s2))); + return (scm_is_true (scm_string_equal_p(s1, s2))); } /* equivalent to (null? ...), but returns 0 or 1 rather than Scheme @@ -107,7 +107,7 @@ gh_string_equal_p(SCM s1, SCM s2) int gh_null_p(SCM l) { - return (SCM_NFALSEP(scm_null_p(l))); + return (scm_is_true(scm_null_p(l))); } /* diff --git a/libguile/goops.c b/libguile/goops.c index 092e876af..a8c6132e5 100644 --- a/libguile/goops.c +++ b/libguile/goops.c @@ -95,7 +95,7 @@ #define TEST_CHANGE_CLASS(obj, class) \ { \ class = SCM_CLASS_OF (obj); \ - if (!SCM_FALSEP (SCM_OBJ_CLASS_REDEF (obj))) \ + if (scm_is_true (SCM_OBJ_CLASS_REDEF (obj))) \ { \ scm_change_object_class (obj, class, SCM_OBJ_CLASS_REDEF (obj));\ class = SCM_CLASS_OF (obj); \ @@ -182,7 +182,7 @@ filter_cpl (SCM ls) while (!SCM_NULLP (ls)) { SCM el = SCM_CAR (ls); - if (SCM_FALSEP (scm_c_memq (el, res))) + if (scm_is_false (scm_c_memq (el, res))) res = scm_cons (el, res); ls = SCM_CDR (ls); } @@ -221,7 +221,7 @@ remove_duplicate_slots (SCM l, SCM res, SCM slots_already_seen) if (!SCM_SYMBOLP (tmp)) scm_misc_error ("%compute-slots", "bad slot name ~S", scm_list_1 (tmp)); - if (SCM_FALSEP (scm_c_memq (tmp, slots_already_seen))) { + if (scm_is_false (scm_c_memq (tmp, slots_already_seen))) { res = scm_cons (SCM_CAR (l), res); slots_already_seen = scm_cons (tmp, slots_already_seen); } @@ -431,7 +431,7 @@ SCM_DEFINE (scm_sys_initialize_object, "%initialize-object", 2, 0, 0, { /* set slot to its :init-form if it exists */ tmp = SCM_CADAR (get_n_set); - if (!SCM_FALSEP (tmp)) + if (scm_is_true (tmp)) { slot_value = get_slot_value (class, obj, SCM_CAR (get_n_set)); if (SCM_GOOPS_UNBOUNDP (slot_value)) @@ -511,7 +511,7 @@ SCM_DEFINE (scm_sys_prep_layout_x, "%prep-layout!", 1, 0, 0, type = scm_i_get_keyword (k_class, SCM_CDAR (slots), len, SCM_BOOL_F, FUNC_NAME); /* determine slot GC protection and access mode */ - if (SCM_FALSEP (type)) + if (scm_is_false (type)) { p = 'p'; a = 'w'; @@ -822,7 +822,7 @@ SCM_DEFINE (scm_instance_p, "instance?", 1, 0, 0, "Return @code{#t} if @var{obj} is an instance.") #define FUNC_NAME s_scm_instance_p { - return SCM_BOOL (SCM_INSTANCEP (obj)); + return scm_from_bool (SCM_INSTANCEP (obj)); } #undef FUNC_NAME @@ -1160,7 +1160,7 @@ static SCM get_slot_value_using_name (SCM class, SCM obj, SCM slot_name) { SCM slotdef = slot_definition_using_name (class, slot_name); - if (!SCM_FALSEP (slotdef)) + if (scm_is_true (slotdef)) return get_slot_value (class, obj, slotdef); else return CALL_GF3 ("slot-missing", class, obj, slot_name); @@ -1201,7 +1201,7 @@ static SCM set_slot_value_using_name (SCM class, SCM obj, SCM slot_name, SCM value) { SCM slotdef = slot_definition_using_name (class, slot_name); - if (!SCM_FALSEP (slotdef)) + if (scm_is_true (slotdef)) return set_slot_value (class, obj, slotdef, value); else return CALL_GF4 ("slot-missing", class, obj, slot_name, value); @@ -1651,7 +1651,7 @@ SCM_DEFINE (scm_sys_invalidate_method_cache_x, "%invalidate-method-cache!", 1, 0 SCM used_by; SCM_ASSERT (SCM_PUREGENERICP (gf), gf, SCM_ARG1, FUNC_NAME); used_by = SCM_SLOT (gf, scm_si_used_by); - if (!SCM_FALSEP (used_by)) + if (scm_is_true (used_by)) { SCM methods = SCM_SLOT (gf, scm_si_methods); for (; SCM_CONSP (used_by); used_by = SCM_CDR (used_by)) @@ -1674,7 +1674,7 @@ SCM_DEFINE (scm_generic_capability_p, "generic-capability?", 1, 0, 0, "") #define FUNC_NAME s_scm_generic_capability_p { - SCM_ASSERT (!SCM_FALSEP (scm_procedure_p (proc)), + SCM_ASSERT (scm_is_true (scm_procedure_p (proc)), proc, SCM_ARG1, FUNC_NAME); return (scm_subr_p (proc) && SCM_SUBR_GENERIC (proc) ? SCM_BOOL_T @@ -1792,7 +1792,7 @@ static int applicablep (SCM actual, SCM formal) { /* We already know that the cpl is well formed. */ - return !SCM_FALSEP (scm_c_memq (formal, SCM_SLOT (actual, scm_si_cpl))); + return scm_is_true (scm_c_memq (formal, SCM_SLOT (actual, scm_si_cpl))); } static int @@ -2035,7 +2035,7 @@ call_memoize_method (void *a) * the cache miss and locking the mutex. */ SCM cmethod = scm_mcache_lookup_cmethod (x, SCM_CDDR (args)); - if (!SCM_FALSEP (cmethod)) + if (scm_is_true (cmethod)) return cmethod; /*fixme* Use scm_apply */ return CALL_GF3 ("memoize-method!", gf, SCM_CDDR (args), x); @@ -2101,7 +2101,7 @@ SCM_DEFINE (scm_make, "make", 0, 0, 1, if (class == scm_class_accessor) { SCM setter = scm_get_keyword (k_setter, args, SCM_BOOL_F); - if (!SCM_FALSEP (setter)) + if (scm_is_true (setter)) scm_sys_set_object_setter_x (z, setter); } } @@ -2217,7 +2217,7 @@ fix_cpl (SCM c, SCM before, SCM after) SCM cpl = SCM_SLOT (c, scm_si_cpl); SCM ls = scm_c_memq (after, cpl); SCM tail = scm_delq1_x (before, SCM_CDR (ls)); - if (SCM_FALSEP (ls)) + if (scm_is_false (ls)) /* if this condition occurs, fix_cpl should not be applied this way */ abort (); SCM_SETCAR (ls, before); @@ -2465,7 +2465,7 @@ make_class_from_template (char const *template, char const *type_name, SCM super /* Only define name if doesn't already exist. */ if (!SCM_GOOPS_UNBOUNDP (name) - && SCM_FALSEP (scm_call_2 (scm_goops_lookup_closure, name, SCM_BOOL_F))) + && scm_is_false (scm_call_2 (scm_goops_lookup_closure, name, SCM_BOOL_F))) DEFVAR (name, class); return class; } @@ -2490,7 +2490,7 @@ scm_i_inherit_applicable (SCM c) SCM cpl = SCM_SLOT (c, scm_si_cpl); /* patch scm_class_applicable into direct-supers */ SCM top = scm_c_memq (scm_class_top, dsupers); - if (SCM_FALSEP (top)) + if (scm_is_false (top)) dsupers = scm_append (scm_list_2 (dsupers, scm_list_1 (scm_class_applicable))); else @@ -2501,7 +2501,7 @@ scm_i_inherit_applicable (SCM c) SCM_SET_SLOT (c, scm_si_direct_supers, dsupers); /* patch scm_class_applicable into cpl */ top = scm_c_memq (scm_class_top, cpl); - if (SCM_FALSEP (top)) + if (scm_is_false (top)) abort (); else { @@ -2578,7 +2578,7 @@ static SCM make_struct_class (void *closure SCM_UNUSED, SCM vtable, SCM data, SCM prev SCM_UNUSED) { - if (!SCM_FALSEP (SCM_STRUCT_TABLE_NAME (data))) + if (scm_is_true (SCM_STRUCT_TABLE_NAME (data))) SCM_SET_STRUCT_TABLE_CLASS (data, scm_make_extended_class (SCM_SYMBOL_CHARS (SCM_STRUCT_TABLE_NAME (data)), @@ -2784,7 +2784,7 @@ SCM_DEFINE (scm_pure_generic_p, "pure-generic?", 1, 0, 0, "Return @code{#t} if @var{obj} is a pure generic.") #define FUNC_NAME s_scm_pure_generic_p { - return SCM_BOOL (SCM_PUREGENERICP (obj)); + return scm_from_bool (SCM_PUREGENERICP (obj)); } #undef FUNC_NAME diff --git a/libguile/goops.h b/libguile/goops.h index 710abb941..2130d7dbd 100644 --- a/libguile/goops.h +++ b/libguile/goops.h @@ -122,7 +122,7 @@ typedef struct scm_t_method { #define SCM_INSTANCE_HASH(c, i) (SCM_INST (c) [scm_si_hashsets + (i)]) #define SCM_SET_HASHSET(c, i, h) (SCM_INST (c) [scm_si_hashsets + (i)] = (h)) -#define SCM_SUBCLASSP(c1, c2) (!SCM_FALSEP (scm_c_memq (c2, SCM_SLOT (c1, scm_si_cpl)))) +#define SCM_SUBCLASSP(c1, c2) (scm_is_true (scm_c_memq (c2, SCM_SLOT (c1, scm_si_cpl)))) #define SCM_IS_A_P(x, c) \ (SCM_INSTANCEP (x) && SCM_SUBCLASSP (SCM_CLASS_OF (x), c)) diff --git a/libguile/guardians.c b/libguile/guardians.c index 7fe01af7b..01db7dfbb 100644 --- a/libguile/guardians.c +++ b/libguile/guardians.c @@ -209,7 +209,7 @@ guardian_apply (SCM guardian, SCM obj, SCM throw_p) return scm_guard (guardian, obj, (SCM_UNBNDP (throw_p) ? 1 - : !SCM_FALSEP (throw_p))); + : scm_is_true (throw_p))); else return scm_get_one_zombie (guardian); } @@ -229,7 +229,7 @@ scm_guard (SCM guardian, SCM obj, int throw_p) if (GREEDY_P (g)) { - if (!SCM_FALSEP (scm_hashq_get_handle + if (scm_is_true (scm_hashq_get_handle (greedily_guarded_whash, obj))) { SCM_ALLOW_INTS; @@ -268,7 +268,7 @@ scm_get_one_zombie (SCM guardian) if (!TCONC_EMPTYP (g->zombies)) TCONC_OUT (g->zombies, res); - if (!SCM_FALSEP (res) && GREEDY_P (g)) + if (scm_is_true (res) && GREEDY_P (g)) scm_hashq_remove_x (greedily_guarded_whash, res); SCM_ALLOW_INTS; @@ -319,7 +319,7 @@ SCM_DEFINE (scm_make_guardian, "make-guardian", 0, 1, 0, g->flags = 0L; /* [cmm] the UNBNDP check below is redundant but I like it. */ - if (SCM_UNBNDP (greedy_p) || !SCM_FALSEP (greedy_p)) + if (SCM_UNBNDP (greedy_p) || scm_is_true (greedy_p)) SET_GREEDY (g); SCM_NEWSMOB (z, tc16_guardian, g); @@ -339,7 +339,7 @@ SCM_DEFINE (scm_guardian_destroyed_p, "guardian-destroyed?", 1, 0, 0, /* This critical section barrier will be replaced by a mutex. */ SCM_DEFER_INTS; - res = SCM_BOOL (DESTROYED_P (GUARDIAN_DATA (guardian))); + res = scm_from_bool (DESTROYED_P (GUARDIAN_DATA (guardian))); SCM_ALLOW_INTS; @@ -352,7 +352,7 @@ SCM_DEFINE (scm_guardian_greedy_p, "guardian-greedy?", 1, 0, 0, "Return @code{#t} if @var{guardian} is a greedy guardian, otherwise @code{#f}.") #define FUNC_NAME s_scm_guardian_greedy_p { - return SCM_BOOL (GREEDY_P (GUARDIAN_DATA (guardian))); + return scm_from_bool (GREEDY_P (GUARDIAN_DATA (guardian))); } #undef FUNC_NAME diff --git a/libguile/hashtab.c b/libguile/hashtab.c index 44e99630a..ce077a397 100644 --- a/libguile/hashtab.c +++ b/libguile/hashtab.c @@ -389,7 +389,7 @@ SCM_DEFINE (scm_hash_table_p, "hash-table?", 1, 0, 0, "Return @code{#t} if @var{obj} is a hash table.") #define FUNC_NAME s_scm_hash_table_p { - return SCM_BOOL (SCM_HASHTABLE_P (obj)); + return scm_from_bool (SCM_HASHTABLE_P (obj)); } #undef FUNC_NAME @@ -403,7 +403,7 @@ SCM_DEFINE (scm_weak_key_hash_table_p, "weak-key-hash-table?", 1, 0, 0, "nor a weak value hash table.") #define FUNC_NAME s_scm_weak_key_hash_table_p { - return SCM_BOOL (SCM_HASHTABLE_P (obj) && SCM_HASHTABLE_WEAK_KEY_P (obj)); + return scm_from_bool (SCM_HASHTABLE_P (obj) && SCM_HASHTABLE_WEAK_KEY_P (obj)); } #undef FUNC_NAME @@ -413,7 +413,7 @@ SCM_DEFINE (scm_weak_value_hash_table_p, "weak-value-hash-table?", 1, 0, 0, "Return @code{#t} if @var{obj} is a weak value hash table.") #define FUNC_NAME s_scm_weak_value_hash_table_p { - return SCM_BOOL (SCM_HASHTABLE_P (obj) && SCM_HASHTABLE_WEAK_VALUE_P (obj)); + return scm_from_bool (SCM_HASHTABLE_P (obj) && SCM_HASHTABLE_WEAK_VALUE_P (obj)); } #undef FUNC_NAME @@ -423,7 +423,7 @@ SCM_DEFINE (scm_doubly_weak_hash_table_p, "doubly-weak-hash-table?", 1, 0, 0, "Return @code{#t} if @var{obj} is a doubly weak hash table.") #define FUNC_NAME s_scm_doubly_weak_hash_table_p { - return SCM_BOOL (SCM_HASHTABLE_P (obj) && SCM_HASHTABLE_DOUBLY_WEAK_P (obj)); + return scm_from_bool (SCM_HASHTABLE_P (obj) && SCM_HASHTABLE_DOUBLY_WEAK_P (obj)); } #undef FUNC_NAME @@ -473,7 +473,7 @@ scm_hash_fn_create_handle_x (SCM table, SCM obj, SCM init, unsigned long (*hash_ if (k >= SCM_VECTOR_LENGTH (buckets)) scm_out_of_range ("hash_fn_create_handle_x", scm_ulong2num (k)); it = assoc_fn (obj, SCM_VELTS (buckets)[k], closure); - if (!SCM_FALSEP (it)) + if (scm_is_true (it)) return it; else { @@ -542,7 +542,7 @@ scm_hash_fn_remove_x (SCM table, SCM obj, unsigned long (*hash_fn)(), SCM (*asso if (k >= SCM_VECTOR_LENGTH (buckets)) scm_out_of_range ("hash_fn_remove_x", scm_ulong2num (k)); h = assoc_fn (obj, SCM_VELTS (buckets)[k], closure); - if (!SCM_FALSEP (h)) + if (scm_is_true (h)) { SCM_VECTOR_SET (buckets, k, delete_fn (h, SCM_VELTS (buckets)[k])); if (table != buckets) diff --git a/libguile/hooks.c b/libguile/hooks.c index d94901cb9..0804d05ee 100644 --- a/libguile/hooks.c +++ b/libguile/hooks.c @@ -136,7 +136,7 @@ hook_print (SCM hook, SCM port, scm_print_state *pstate) { scm_putc (' ', port); name = scm_procedure_name (SCM_CAR (ls)); - if (!SCM_FALSEP (name)) + if (scm_is_true (name)) scm_iprin1 (name, port, pstate); else scm_putc ('?', port); @@ -177,7 +177,7 @@ SCM_DEFINE (scm_hook_p, "hook?", 1, 0, 0, "Return @code{#t} if @var{x} is a hook, @code{#f} otherwise.") #define FUNC_NAME s_scm_hook_p { - return SCM_BOOL (SCM_HOOKP (x)); + return scm_from_bool (SCM_HOOKP (x)); } #undef FUNC_NAME @@ -189,7 +189,7 @@ SCM_DEFINE (scm_hook_empty_p, "hook-empty?", 1, 0, 0, #define FUNC_NAME s_scm_hook_empty_p { SCM_VALIDATE_HOOK (1, hook); - return SCM_BOOL (SCM_NULLP (SCM_HOOK_PROCEDURES (hook))); + return scm_from_bool (SCM_NULLP (SCM_HOOK_PROCEDURES (hook))); } #undef FUNC_NAME @@ -205,17 +205,17 @@ SCM_DEFINE (scm_add_hook_x, "add-hook!", 2, 1, 0, SCM arity, rest; int n_args; SCM_VALIDATE_HOOK (1, hook); - SCM_ASSERT (!SCM_FALSEP (arity = scm_i_procedure_arity (proc)), + SCM_ASSERT (scm_is_true (arity = scm_i_procedure_arity (proc)), proc, SCM_ARG2, FUNC_NAME); n_args = SCM_HOOK_ARITY (hook); if (SCM_INUM (SCM_CAR (arity)) > n_args - || (SCM_FALSEP (SCM_CADDR (arity)) + || (scm_is_false (SCM_CADDR (arity)) && (SCM_INUM (SCM_CAR (arity)) + SCM_INUM (SCM_CADR (arity)) < n_args))) scm_wrong_type_arg (FUNC_NAME, 2, proc); rest = scm_delq_x (proc, SCM_HOOK_PROCEDURES (hook)); SCM_SET_HOOK_PROCEDURES (hook, - (!SCM_UNBNDP (append_p) && !SCM_FALSEP (append_p) + (!SCM_UNBNDP (append_p) && scm_is_true (append_p) ? scm_append_x (scm_list_2 (rest, scm_list_1 (proc))) : scm_cons (proc, rest))); return SCM_UNSPECIFIED; diff --git a/libguile/init.c b/libguile/init.c index f808c00cb..89f47ea9a 100644 --- a/libguile/init.c +++ b/libguile/init.c @@ -256,7 +256,7 @@ scm_standard_stream_to_port (int fdes, char *mode, char *name) body_data.name = name; port = scm_internal_catch (SCM_BOOL_T, stream_body, &body_data, stream_handler, NULL); - if (SCM_FALSEP (port)) + if (scm_is_false (port)) port = scm_void_port (mode); return port; } @@ -316,7 +316,7 @@ scm_load_startup_files () scm_primitive_load_path (scm_makfrom0str ("ice-9/boot-9.scm")); /* Load the init.scm file. */ - if (SCM_NFALSEP (init_path)) + if (scm_is_true (init_path)) scm_primitive_load (init_path); } } diff --git a/libguile/ioext.c b/libguile/ioext.c index 66e32cb91..59460afa7 100644 --- a/libguile/ioext.c +++ b/libguile/ioext.c @@ -204,7 +204,7 @@ SCM_DEFINE (scm_isatty_p, "isatty?", 1, 0, 0, return SCM_BOOL_F; rv = isatty (SCM_FPORT_FDES (port)); - return SCM_BOOL(rv); + return scm_from_bool(rv); } #undef FUNC_NAME diff --git a/libguile/keywords.c b/libguile/keywords.c index cea6c53b5..fb29bb081 100644 --- a/libguile/keywords.c +++ b/libguile/keywords.c @@ -58,7 +58,7 @@ SCM_DEFINE (scm_make_keyword_from_dash_symbol, "make-keyword-from-dash-symbol", SCM_DEFER_INTS; keyword = scm_hashq_ref (scm_keyword_obarray, symbol, SCM_BOOL_F); - if (SCM_FALSEP (keyword)) + if (scm_is_false (keyword)) { SCM_NEWSMOB (keyword, scm_tc16_keyword, SCM_UNPACK (symbol)); scm_hashq_set_x (scm_keyword_obarray, symbol, keyword); @@ -88,7 +88,7 @@ SCM_DEFINE (scm_keyword_p, "keyword?", 1, 0, 0, "@code{#f}.") #define FUNC_NAME s_scm_keyword_p { - return SCM_BOOL (SCM_KEYWORDP (obj)); + return scm_from_bool (SCM_KEYWORDP (obj)); } #undef FUNC_NAME diff --git a/libguile/list.c b/libguile/list.c index 213613712..74093427f 100644 --- a/libguile/list.c +++ b/libguile/list.c @@ -143,7 +143,7 @@ SCM_DEFINE (scm_null_p, "null?", 1, 0, 0, "Return @code{#t} iff @var{x} is the empty list, else @code{#f}.") #define FUNC_NAME s_scm_null_p { - return SCM_BOOL (SCM_NULL_OR_NIL_P (x)); + return scm_from_bool (SCM_NULL_OR_NIL_P (x)); } #undef FUNC_NAME @@ -153,7 +153,7 @@ SCM_DEFINE (scm_list_p, "list?", 1, 0, 0, "Return @code{#t} iff @var{x} is a proper list, else @code{#f}.") #define FUNC_NAME s_scm_list_p { - return SCM_BOOL (scm_ilength (x) >= 0); + return scm_from_bool (scm_ilength (x) >= 0); } #undef FUNC_NAME @@ -607,7 +607,7 @@ SCM_DEFINE (scm_memv, "memv", 2, 0, 0, SCM_VALIDATE_LIST (2, lst); for (; !SCM_NULL_OR_NIL_P (lst); lst = SCM_CDR (lst)) { - if (! SCM_FALSEP (scm_eqv_p (SCM_CAR (lst), x))) + if (! scm_is_false (scm_eqv_p (SCM_CAR (lst), x))) return lst; } return SCM_BOOL_F; @@ -628,7 +628,7 @@ SCM_DEFINE (scm_member, "member", 2, 0, 0, SCM_VALIDATE_LIST (2, lst); for (; !SCM_NULL_OR_NIL_P (lst); lst = SCM_CDR (lst)) { - if (! SCM_FALSEP (scm_equal_p (SCM_CAR (lst), x))) + if (! scm_is_false (scm_equal_p (SCM_CAR (lst), x))) return lst; } return SCM_BOOL_F; @@ -681,7 +681,7 @@ SCM_DEFINE (scm_delv_x, "delv!", 2, 0, 0, SCM_CONSP (walk); walk = SCM_CDR (walk)) { - if (! SCM_FALSEP (scm_eqv_p (SCM_CAR (walk), item))) + if (! scm_is_false (scm_eqv_p (SCM_CAR (walk), item))) *prev = SCM_CDR (walk); else prev = SCM_CDRLOC (walk); @@ -706,7 +706,7 @@ SCM_DEFINE (scm_delete_x, "delete!", 2, 0, 0, SCM_CONSP (walk); walk = SCM_CDR (walk)) { - if (! SCM_FALSEP (scm_equal_p (SCM_CAR (walk), item))) + if (! scm_is_false (scm_equal_p (SCM_CAR (walk), item))) *prev = SCM_CDR (walk); else prev = SCM_CDRLOC (walk); @@ -802,7 +802,7 @@ SCM_DEFINE (scm_delv1_x, "delv1!", 2, 0, 0, SCM_CONSP (walk); walk = SCM_CDR (walk)) { - if (! SCM_FALSEP (scm_eqv_p (SCM_CAR (walk), item))) + if (! scm_is_false (scm_eqv_p (SCM_CAR (walk), item))) { *prev = SCM_CDR (walk); break; @@ -830,7 +830,7 @@ SCM_DEFINE (scm_delete1_x, "delete1!", 2, 0, 0, SCM_CONSP (walk); walk = SCM_CDR (walk)) { - if (! SCM_FALSEP (scm_equal_p (SCM_CAR (walk), item))) + if (! scm_is_false (scm_equal_p (SCM_CAR (walk), item))) { *prev = SCM_CDR (walk); break; @@ -866,7 +866,7 @@ SCM_DEFINE (scm_filter, "filter", 2, 0, 0, SCM_CONSP (walk); walk = SCM_CDR (walk)) { - if (!SCM_FALSEP (call (pred, SCM_CAR (walk)))) + if (scm_is_true (call (pred, SCM_CAR (walk)))) { *prev = scm_cons (SCM_CAR (walk), SCM_EOL); prev = SCM_CDRLOC (*prev); @@ -892,7 +892,7 @@ SCM_DEFINE (scm_filter_x, "filter!", 2, 0, 0, SCM_CONSP (walk); walk = SCM_CDR (walk)) { - if (!SCM_FALSEP (call (pred, SCM_CAR (walk)))) + if (scm_is_true (call (pred, SCM_CAR (walk)))) prev = SCM_CDRLOC (walk); else *prev = SCM_CDR (walk); diff --git a/libguile/load.c b/libguile/load.c index 71715263b..74eaaca9b 100644 --- a/libguile/load.c +++ b/libguile/load.c @@ -93,11 +93,11 @@ SCM_DEFINE (scm_primitive_load, "primitive-load", 1, 0, 0, { SCM hook = *scm_loc_load_hook; SCM_VALIDATE_STRING (1, filename); - if (!SCM_FALSEP (hook) && !SCM_EQ_P (scm_procedure_p (hook), SCM_BOOL_T)) + if (scm_is_true (hook) && !SCM_EQ_P (scm_procedure_p (hook), SCM_BOOL_T)) SCM_MISC_ERROR ("value of %load-hook is neither a procedure nor #f", SCM_EOL); - if (! SCM_FALSEP (hook)) + if (! scm_is_false (hook)) scm_call_1 (hook, filename); { /* scope */ @@ -211,12 +211,12 @@ SCM_DEFINE (scm_parse_path, "parse-path", 1, 1, 0, "is returned.") #define FUNC_NAME s_scm_parse_path { - SCM_ASSERT (SCM_FALSEP (path) || (SCM_STRINGP (path)), + SCM_ASSERT (scm_is_false (path) || (SCM_STRINGP (path)), path, SCM_ARG1, FUNC_NAME); if (SCM_UNBNDP (tail)) tail = SCM_EOL; - return (SCM_FALSEP (path) + return (scm_is_false (path) ? tail : scm_internal_parse_path (SCM_STRING_CHARS (path), tail)); } @@ -451,7 +451,7 @@ SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 1, 0, 0, full_filename = scm_sys_search_load_path (filename); - if (SCM_FALSEP (full_filename)) + if (scm_is_false (full_filename)) { int absolute = (SCM_STRING_LENGTH (filename) >= 1 #ifdef __MINGW32__ diff --git a/libguile/macros.c b/libguile/macros.c index a7c695567..37d4782cf 100644 --- a/libguile/macros.c +++ b/libguile/macros.c @@ -38,8 +38,8 @@ macro_print (SCM macro, SCM port, scm_print_state *pstate) { SCM code = SCM_MACRO_CODE (macro); if (!SCM_CLOSUREP (code) - || SCM_FALSEP (scm_procedure_p (SCM_PRINT_CLOSURE)) - || SCM_FALSEP (scm_printer_apply (SCM_PRINT_CLOSURE, + || scm_is_false (scm_procedure_p (SCM_PRINT_CLOSURE)) + || scm_is_false (scm_printer_apply (SCM_PRINT_CLOSURE, macro, port, pstate))) { if (!SCM_CLOSUREP (code)) @@ -165,7 +165,7 @@ SCM_DEFINE (scm_macro_p, "macro?", 1, 0, 0, "syntax transformer.") #define FUNC_NAME s_scm_macro_p { - return SCM_BOOL (SCM_SMOB_PREDICATE (scm_tc16_macro, obj)); + return scm_from_bool (SCM_SMOB_PREDICATE (scm_tc16_macro, obj)); } #undef FUNC_NAME diff --git a/libguile/modules.c b/libguile/modules.c index 951ee413e..98f5b8ea6 100644 --- a/libguile/modules.c +++ b/libguile/modules.c @@ -219,7 +219,7 @@ scm_env_top_level (SCM env) while (SCM_CONSP (env)) { SCM car_env = SCM_CAR (env); - if (!SCM_CONSP (car_env) && !SCM_FALSEP (scm_procedure_p (car_env))) + if (!SCM_CONSP (car_env) && scm_is_true (scm_procedure_p (car_env))) return car_env; env = SCM_CDR (env); } @@ -242,14 +242,14 @@ the_root_module () SCM scm_lookup_closure_module (SCM proc) { - if (SCM_FALSEP (proc)) + if (scm_is_false (proc)) return the_root_module (); else if (SCM_EVAL_CLOSURE_P (proc)) return SCM_PACK (SCM_SMOB_DATA (proc)); else { SCM mod = scm_procedure_property (proc, sym_module); - if (SCM_FALSEP (mod)) + if (scm_is_false (mod)) mod = the_root_module (); return mod; } @@ -277,7 +277,7 @@ static SCM module_variable (SCM module, SCM sym) { #define SCM_BOUND_THING_P(b) \ - (!SCM_FALSEP (b)) + (scm_is_true (b)) /* 1. Check module obarray */ SCM b = scm_hashq_ref (SCM_MODULE_OBARRAY (module), sym, SCM_UNDEFINED); @@ -285,7 +285,7 @@ module_variable (SCM module, SCM sym) return b; { SCM binder = SCM_MODULE_BINDER (module); - if (!SCM_FALSEP (binder)) + if (scm_is_true (binder)) /* 2. Custom binder */ { b = scm_call_3 (binder, module, sym, SCM_BOOL_F); @@ -320,7 +320,7 @@ SCM scm_eval_closure_lookup (SCM eclo, SCM sym, SCM definep) { SCM module = SCM_PACK (SCM_SMOB_DATA (eclo)); - if (!SCM_FALSEP (definep)) + if (scm_is_true (definep)) { if (SCM_EVAL_CLOSURE_INTERFACE_P (eclo)) return SCM_BOOL_F; @@ -355,7 +355,7 @@ SCM_DEFINE (scm_standard_interface_eval_closure, SCM scm_module_lookup_closure (SCM module) { - if (SCM_FALSEP (module)) + if (scm_is_false (module)) return SCM_BOOL_F; else return SCM_MODULE_EVAL_CLOSURE (module); @@ -373,7 +373,7 @@ scm_current_module_lookup_closure () SCM scm_module_transformer (SCM module) { - if (SCM_FALSEP (module)) + if (scm_is_false (module)) return SCM_BOOL_F; else return SCM_MODULE_TRANSFORMER (module); @@ -393,7 +393,7 @@ SCM_DEFINE (scm_module_import_interface, "module-import-interface", 2, 0, 0, "") #define FUNC_NAME s_scm_module_import_interface { -#define SCM_BOUND_THING_P(b) (!SCM_FALSEP (b)) +#define SCM_BOUND_THING_P(b) (scm_is_true (b)) SCM uses; SCM_VALIDATE_MODULE (SCM_ARG1, module); /* Search the use list */ @@ -407,7 +407,7 @@ SCM_DEFINE (scm_module_import_interface, "module-import-interface", 2, 0, 0, return _interface; { SCM binder = SCM_MODULE_BINDER (_interface); - if (!SCM_FALSEP (binder)) + if (scm_is_true (binder)) /* 2. Custom binder */ { b = scm_call_3 (binder, _interface, sym, SCM_BOOL_F); @@ -417,7 +417,7 @@ SCM_DEFINE (scm_module_import_interface, "module-import-interface", 2, 0, 0, } /* 3. Search use list recursively. */ _interface = scm_module_import_interface (_interface, sym); - if (!SCM_FALSEP (_interface)) + if (scm_is_true (_interface)) return _interface; uses = SCM_CDR (uses); } @@ -460,14 +460,14 @@ scm_sym2var (SCM sym, SCM proc, SCM definep) { SCM handle; - if (SCM_FALSEP (definep)) + if (scm_is_false (definep)) var = scm_hashq_ref (scm_pre_modules_obarray, sym, SCM_BOOL_F); else { handle = scm_hashq_create_handle_x (scm_pre_modules_obarray, sym, SCM_BOOL_F); var = SCM_CDR (handle); - if (SCM_FALSEP (var)) + if (scm_is_false (var)) { var = scm_make_variable (SCM_UNDEFINED); SCM_SETCDR (handle, var); @@ -475,7 +475,7 @@ scm_sym2var (SCM sym, SCM proc, SCM definep) } } - if (!SCM_FALSEP (var) && !SCM_VARIABLEP (var)) + if (scm_is_true (var) && !SCM_VARIABLEP (var)) SCM_MISC_ERROR ("~S is not bound to a variable", scm_list_1 (sym)); return var; @@ -496,7 +496,7 @@ scm_module_lookup (SCM module, SCM sym) SCM_VALIDATE_MODULE (1, module); var = scm_sym2var (sym, scm_module_lookup_closure (module), SCM_BOOL_F); - if (SCM_FALSEP (var)) + if (scm_is_false (var)) SCM_MISC_ERROR ("unbound variable: ~S", scm_list_1 (sym)); return var; } @@ -513,7 +513,7 @@ scm_lookup (SCM sym) { SCM var = scm_sym2var (sym, scm_current_module_lookup_closure (), SCM_BOOL_F); - if (SCM_FALSEP (var)) + if (scm_is_false (var)) scm_misc_error ("scm_lookup", "unbound variable: ~S", scm_list_1 (sym)); return var; } @@ -559,7 +559,7 @@ scm_module_reverse_lookup (SCM module, SCM variable) SCM obarray; long i, n; - if (SCM_FALSEP (module)) + if (scm_is_false (module)) obarray = scm_pre_modules_obarray; else { @@ -593,7 +593,7 @@ scm_module_reverse_lookup (SCM module, SCM variable) while (SCM_CONSP (uses)) { SCM sym = scm_module_reverse_lookup (SCM_CAR (uses), variable); - if (!SCM_FALSEP (sym)) + if (scm_is_true (sym)) return sym; uses = SCM_CDR (uses); } @@ -620,9 +620,9 @@ SCM scm_system_module_env_p (SCM env) { SCM proc = scm_env_top_level (env); - if (SCM_FALSEP (proc)) + if (scm_is_false (proc)) return SCM_BOOL_T; - return ((!SCM_FALSEP (scm_procedure_property (proc, + return ((scm_is_true (scm_procedure_property (proc, scm_sym_system_module))) ? SCM_BOOL_T : SCM_BOOL_F); diff --git a/libguile/net_db.c b/libguile/net_db.c index 7ae33f037..35abb95f2 100644 --- a/libguile/net_db.c +++ b/libguile/net_db.c @@ -357,7 +357,7 @@ SCM_DEFINE (scm_sethost, "sethost", 0, 1, 0, if (SCM_UNBNDP (stayopen)) endhostent (); else - sethostent (!SCM_FALSEP (stayopen)); + sethostent (scm_is_true (stayopen)); return SCM_UNSPECIFIED; } #undef FUNC_NAME @@ -373,7 +373,7 @@ SCM_DEFINE (scm_setnet, "setnet", 0, 1, 0, if (SCM_UNBNDP (stayopen)) endnetent (); else - setnetent (!SCM_FALSEP (stayopen)); + setnetent (scm_is_true (stayopen)); return SCM_UNSPECIFIED; } #undef FUNC_NAME @@ -389,7 +389,7 @@ SCM_DEFINE (scm_setproto, "setproto", 0, 1, 0, if (SCM_UNBNDP (stayopen)) endprotoent (); else - setprotoent (!SCM_FALSEP (stayopen)); + setprotoent (scm_is_true (stayopen)); return SCM_UNSPECIFIED; } #undef FUNC_NAME @@ -405,7 +405,7 @@ SCM_DEFINE (scm_setserv, "setserv", 0, 1, 0, if (SCM_UNBNDP (stayopen)) endservent (); else - setservent (!SCM_FALSEP (stayopen)); + setservent (scm_is_true (stayopen)); return SCM_UNSPECIFIED; } #undef FUNC_NAME diff --git a/libguile/objects.c b/libguile/objects.c index f655470da..f999a4f37 100644 --- a/libguile/objects.c +++ b/libguile/objects.c @@ -71,7 +71,7 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0, case scm_tc3_imm24: if (SCM_CHARP (x)) return scm_class_char; - else if (SCM_BOOLP (x)) + else if (scm_is_bool (x)) return scm_class_boolean; else if (SCM_NULLP (x)) return scm_class_null; @@ -154,7 +154,7 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0, else if (SCM_OBJ_CLASS_FLAGS (x) & SCM_CLASSF_GOOPS) { /* Goops object */ - if (! SCM_FALSEP (SCM_OBJ_CLASS_REDEF (x))) + if (! scm_is_false (SCM_OBJ_CLASS_REDEF (x))) scm_change_object_class (x, SCM_CLASS_OF (x), /* old */ SCM_OBJ_CLASS_REDEF (x)); /* new */ @@ -164,12 +164,12 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0, { /* ordinary struct */ SCM handle = scm_struct_create_handle (SCM_STRUCT_VTABLE (x)); - if (!SCM_FALSEP (SCM_STRUCT_TABLE_CLASS (SCM_CDR (handle)))) + if (scm_is_true (SCM_STRUCT_TABLE_CLASS (SCM_CDR (handle)))) return SCM_STRUCT_TABLE_CLASS (SCM_CDR (handle)); else { SCM name = SCM_STRUCT_TABLE_NAME (SCM_CDR (handle)); - SCM class = scm_make_extended_class (!SCM_FALSEP (name) + SCM class = scm_make_extended_class (scm_is_true (name) ? SCM_SYMBOL_CHARS (name) : 0, SCM_I_OPERATORP (x)); @@ -297,7 +297,7 @@ SCM scm_mcache_compute_cmethod (SCM cache, SCM args) { SCM cmethod = scm_mcache_lookup_cmethod (cache, args); - if (SCM_FALSEP (cmethod)) + if (scm_is_false (cmethod)) /* No match - memoize */ return scm_memoize_method (cache, args); return cmethod; @@ -342,7 +342,7 @@ SCM_DEFINE (scm_entity_p, "entity?", 1, 0, 0, "Return @code{#t} if @var{obj} is an entity.") #define FUNC_NAME s_scm_entity_p { - return SCM_BOOL(SCM_STRUCTP (obj) && SCM_I_ENTITYP (obj)); + return scm_from_bool(SCM_STRUCTP (obj) && SCM_I_ENTITYP (obj)); } #undef FUNC_NAME @@ -351,7 +351,7 @@ SCM_DEFINE (scm_operator_p, "operator?", 1, 0, 0, "Return @code{#t} if @var{obj} is an operator.") #define FUNC_NAME s_scm_operator_p { - return SCM_BOOL(SCM_STRUCTP (obj) + return scm_from_bool(SCM_STRUCTP (obj) && SCM_I_OPERATORP (obj) && !SCM_I_ENTITYP (obj)); } diff --git a/libguile/options.c b/libguile/options.c index 115d074b0..02357e08e 100644 --- a/libguile/options.c +++ b/libguile/options.c @@ -239,7 +239,7 @@ scm_options (SCM args, scm_t_option options[], unsigned int n, const char *s) else { SCM old_setting; - SCM_ASSERT (!SCM_FALSEP (scm_list_p (args)), args, 1, s); + SCM_ASSERT (scm_is_true (scm_list_p (args)), args, 1, s); old_setting = get_option_setting (options, n); change_option_setting (args, options, n, s); return old_setting; diff --git a/libguile/pairs.c b/libguile/pairs.c index 8d6d36e9b..52abd6c7c 100644 --- a/libguile/pairs.c +++ b/libguile/pairs.c @@ -74,7 +74,7 @@ SCM_DEFINE (scm_pair_p, "pair?", 1, 0, 0, "@code{#f}.") #define FUNC_NAME s_scm_pair_p { - return SCM_BOOL (SCM_CONSP (x)); + return scm_from_bool (SCM_CONSP (x)); } #undef FUNC_NAME diff --git a/libguile/ports.c b/libguile/ports.c index d92aaaa4e..7da3c704f 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -262,7 +262,7 @@ SCM_DEFINE (scm_char_ready_p, "char-ready?", 0, 1, 0, scm_t_ptob_descriptor *ptob = &scm_ptobs[SCM_PTOBNUM (port)]; if (ptob->input_waiting) - return SCM_BOOL(ptob->input_waiting (port)); + return scm_from_bool(ptob->input_waiting (port)); else return SCM_BOOL_T; } @@ -749,7 +749,7 @@ SCM_DEFINE (scm_close_port, "close-port", 1, 0, 0, scm_remove_from_port_table (port); scm_mutex_unlock (&scm_i_port_table_mutex); SCM_CLR_PORT_OPEN_FLAG (port); - return SCM_BOOL (rv >= 0); + return scm_from_bool (rv >= 0); } #undef FUNC_NAME @@ -838,7 +838,7 @@ SCM_DEFINE (scm_input_port_p, "input-port?", 1, 0, 0, "@code{port?}.") #define FUNC_NAME s_scm_input_port_p { - return SCM_BOOL (SCM_INPUT_PORT_P (x)); + return scm_from_bool (SCM_INPUT_PORT_P (x)); } #undef FUNC_NAME @@ -850,7 +850,7 @@ SCM_DEFINE (scm_output_port_p, "output-port?", 1, 0, 0, #define FUNC_NAME s_scm_output_port_p { x = SCM_COERCE_OUTPORT (x); - return SCM_BOOL (SCM_OUTPUT_PORT_P (x)); + return scm_from_bool (SCM_OUTPUT_PORT_P (x)); } #undef FUNC_NAME @@ -861,7 +861,7 @@ SCM_DEFINE (scm_port_p, "port?", 1, 0, 0, "@var{x}))}.") #define FUNC_NAME s_scm_port_p { - return SCM_BOOL (SCM_PORTP (x)); + return scm_from_bool (SCM_PORTP (x)); } #undef FUNC_NAME @@ -872,7 +872,7 @@ SCM_DEFINE (scm_port_closed_p, "port-closed?", 1, 0, 0, #define FUNC_NAME s_scm_port_closed_p { SCM_VALIDATE_PORT (1, port); - return SCM_BOOL (!SCM_OPPORTP (port)); + return scm_from_bool (!SCM_OPPORTP (port)); } #undef FUNC_NAME @@ -882,7 +882,7 @@ SCM_DEFINE (scm_eof_object_p, "eof-object?", 1, 0, 0, "return @code{#f}.") #define FUNC_NAME s_scm_eof_object_p { - return SCM_BOOL(SCM_EOF_OBJECT_P (x)); + return scm_from_bool(SCM_EOF_OBJECT_P (x)); } #undef FUNC_NAME diff --git a/libguile/posix.c b/libguile/posix.c index 6a53599ba..b02098fef 100644 --- a/libguile/posix.c +++ b/libguile/posix.c @@ -310,7 +310,7 @@ SCM_DEFINE (scm_getpwuid, "getpw", 0, 1, 0, struct passwd *entry; SCM result = scm_c_make_vector (7, SCM_UNSPECIFIED); - if (SCM_UNBNDP (user) || SCM_FALSEP (user)) + if (SCM_UNBNDP (user) || scm_is_false (user)) { SCM_SYSCALL (entry = getpwent ()); if (! entry) @@ -357,7 +357,7 @@ SCM_DEFINE (scm_setpwent, "setpw", 0, 1, 0, "@code{endpwent} procedures are implemented on top of this.") #define FUNC_NAME s_scm_setpwent { - if (SCM_UNBNDP (arg) || SCM_FALSEP (arg)) + if (SCM_UNBNDP (arg) || scm_is_false (arg)) endpwent (); else setpwent (); @@ -379,7 +379,7 @@ SCM_DEFINE (scm_getgrgid, "getgr", 0, 1, 0, struct group *entry; SCM result = scm_c_make_vector (4, SCM_UNSPECIFIED); - if (SCM_UNBNDP (name) || SCM_FALSEP (name)) + if (SCM_UNBNDP (name) || scm_is_false (name)) { SCM_SYSCALL (entry = getgrent ()); if (! entry) @@ -414,7 +414,7 @@ SCM_DEFINE (scm_setgrent, "setgr", 0, 1, 0, "@code{endgrent} procedures are implemented on top of this.") #define FUNC_NAME s_scm_setgrent { - if (SCM_UNBNDP (arg) || SCM_FALSEP (arg)) + if (SCM_UNBNDP (arg) || scm_is_false (arg)) endgrent (); else setgrent (); @@ -1220,7 +1220,7 @@ SCM_DEFINE (scm_access, "access?", 2, 0, 0, SCM_VALIDATE_STRING (1, path); SCM_VALIDATE_INUM (2, how); rv = access (SCM_STRING_CHARS (path), SCM_INUM (how)); - return SCM_NEGATE_BOOL(rv); + return scm_from_bool (!rv); } #undef FUNC_NAME diff --git a/libguile/print.c b/libguile/print.c index 7586f2cc6..1974b318c 100644 --- a/libguile/print.c +++ b/libguile/print.c @@ -177,7 +177,7 @@ scm_make_print_state () } scm_i_plugin_mutex_unlock (&print_state_mutex); - return SCM_FALSEP (answer) ? make_print_state () : answer; + return scm_is_false (answer) ? make_print_state () : answer; } void @@ -286,7 +286,7 @@ scm_print_symbol_name (const char *str, size_t len, SCM port) if (len == 0 || str[0] == '\'' || str[0] == '`' || str[0] == ',' || str[0] == ':' || str[len-1] == ':' || (str[0] == '.' && len == 1) || - !SCM_FALSEP (scm_i_mem2number(str, len, 10))) + scm_is_true (scm_i_mem2number(str, len, 10))) { scm_lfwrite ("#{", 2, port); weird = 1; @@ -442,8 +442,8 @@ scm_iprin1 (SCM exp, SCM port, scm_print_state *pstate) print_circref (port, pstate, exp); break; case scm_tcs_closures: - if (SCM_FALSEP (scm_procedure_p (SCM_PRINT_CLOSURE)) - || SCM_FALSEP (scm_printer_apply (SCM_PRINT_CLOSURE, + if (scm_is_false (scm_procedure_p (SCM_PRINT_CLOSURE)) + || scm_is_false (scm_printer_apply (SCM_PRINT_CLOSURE, exp, port, pstate))) { SCM formals = SCM_CLOSURE_FORMALS (exp); @@ -603,7 +603,7 @@ scm_iprin1 (SCM exp, SCM port, scm_print_state *pstate) /* Print gsubrs as primitives */ SCM name = scm_procedure_name (exp); scm_puts ("#revealed) + if (scm_is_true (handle) && !pstate->revealed) { scm_i_plugin_mutex_lock (&print_state_mutex); SCM_SETCDR (handle, print_state_pool); @@ -920,7 +920,7 @@ SCM_DEFINE (scm_simple_format, "simple-format", 2, 0, 1, { destination = port = scm_cur_outp; } - else if (SCM_FALSEP (destination)) + else if (scm_is_false (destination)) { fReturnString = 1; port = scm_mkstrport (SCM_INUM0, diff --git a/libguile/procprop.c b/libguile/procprop.c index 4632182d6..5f30c30b2 100644 --- a/libguile/procprop.c +++ b/libguile/procprop.c @@ -130,7 +130,7 @@ scm_i_procedure_arity (SCM proc) default: return SCM_BOOL_F; } - return scm_list_3 (SCM_MAKINUM (a), SCM_MAKINUM (o), SCM_BOOL(r)); + return scm_list_3 (SCM_MAKINUM (a), SCM_MAKINUM (o), scm_from_bool(r)); } static SCM @@ -138,7 +138,7 @@ scm_stand_in_scm_proc(SCM proc) { SCM answer; answer = scm_assq (proc, scm_stand_in_procs); - if (SCM_FALSEP (answer)) + if (scm_is_false (answer)) { answer = scm_closure (scm_list_2 (SCM_EOL, SCM_BOOL_F), SCM_EOL); scm_stand_in_procs = scm_acons (proc, answer, scm_stand_in_procs); @@ -183,7 +183,7 @@ SCM_DEFINE (scm_procedure_property, "procedure-property", 2, 0, 0, if (SCM_EQ_P (k, scm_sym_arity)) { SCM arity; - SCM_ASSERT (SCM_NFALSEP (arity = scm_i_procedure_arity (p)), + SCM_ASSERT (scm_is_true (arity = scm_i_procedure_arity (p)), p, SCM_ARG1, FUNC_NAME); return arity; } diff --git a/libguile/procs.c b/libguile/procs.c index cc0ee2dac..68da589ac 100644 --- a/libguile/procs.c +++ b/libguile/procs.c @@ -176,7 +176,7 @@ SCM_DEFINE (scm_procedure_p, "procedure?", 1, 0, 0, case scm_tc7_pws: return SCM_BOOL_T; case scm_tc7_smob: - return SCM_BOOL (SCM_SMOB_DESCRIPTOR (obj).apply); + return scm_from_bool (SCM_SMOB_DESCRIPTOR (obj).apply); default: return SCM_BOOL_F; } @@ -189,7 +189,7 @@ SCM_DEFINE (scm_closure_p, "closure?", 1, 0, 0, "Return @code{#t} if @var{obj} is a closure.") #define FUNC_NAME s_scm_closure_p { - return SCM_BOOL (SCM_CLOSUREP (obj)); + return scm_from_bool (SCM_CLOSUREP (obj)); } #undef FUNC_NAME @@ -204,7 +204,7 @@ SCM_DEFINE (scm_thunk_p, "thunk?", 1, 0, 0, switch (SCM_TYP7 (obj)) { case scm_tcs_closures: - return SCM_BOOL (!SCM_CONSP (SCM_CLOSURE_FORMALS (obj))); + return scm_from_bool (!SCM_CONSP (SCM_CLOSURE_FORMALS (obj))); case scm_tc7_subr_0: case scm_tc7_subr_1o: case scm_tc7_lsubr: @@ -284,7 +284,7 @@ SCM_DEFINE (scm_procedure_with_setter_p, "procedure-with-setter?", 1, 0, 0, "associated setter procedure.") #define FUNC_NAME s_scm_procedure_with_setter_p { - return SCM_BOOL(SCM_PROCEDURE_WITH_SETTER_P (obj)); + return scm_from_bool(SCM_PROCEDURE_WITH_SETTER_P (obj)); } #undef FUNC_NAME diff --git a/libguile/properties.c b/libguile/properties.c index e94f1f213..ba0c2a437 100644 --- a/libguile/properties.c +++ b/libguile/properties.c @@ -64,19 +64,19 @@ SCM_DEFINE (scm_primitive_property_ref, "primitive-property-ref", 2, 0, 0, SCM_VALIDATE_CONS (SCM_ARG1, prop); h = scm_hashq_get_handle (scm_properties_whash, obj); - if (!SCM_FALSEP (h)) + if (scm_is_true (h)) { SCM assoc = scm_assq (prop, SCM_CDR (h)); - if (!SCM_FALSEP (assoc)) + if (scm_is_true (assoc)) return SCM_CDR (assoc); } - if (SCM_FALSEP (SCM_CAR (prop))) + if (scm_is_false (SCM_CAR (prop))) return SCM_BOOL_F; else { SCM val = scm_call_2 (SCM_CAR (prop), prop, obj); - if (SCM_FALSEP (h)) + if (scm_is_false (h)) h = scm_hashq_create_handle_x (scm_properties_whash, obj, SCM_EOL); SCM_SETCDR (h, scm_acons (prop, val, SCM_CDR (h))); return val; @@ -114,7 +114,7 @@ SCM_DEFINE (scm_primitive_property_del_x, "primitive-property-del!", 2, 0, 0, SCM h; SCM_VALIDATE_CONS (SCM_ARG1, prop); h = scm_hashq_get_handle (scm_properties_whash, obj); - if (!SCM_FALSEP (h)) + if (scm_is_true (h)) SCM_SETCDR (h, scm_assq_remove_x (SCM_CDR (h), prop)); return SCM_UNSPECIFIED; } diff --git a/libguile/ramap.c b/libguile/ramap.c index c8f194a12..8f057fc0c 100644 --- a/libguile/ramap.c +++ b/libguile/ramap.c @@ -486,7 +486,7 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore SCM_UNUSED) if (1 == inc && (n >= SCM_LONG_BIT || n == SCM_BITVECTOR_LENGTH (ra))) { i = base / SCM_LONG_BIT; - if (SCM_FALSEP (fill)) + if (scm_is_false (fill)) { if (base % SCM_LONG_BIT) /* leading partial word */ ve[i++] &= ~(~0L << (base % SCM_LONG_BIT)); @@ -509,7 +509,7 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore SCM_UNUSED) } else { - if (SCM_FALSEP (fill)) + if (scm_is_false (fill)) for (i = base; n--; i += inc) ve[i / SCM_LONG_BIT] &= ~(1L << (i % SCM_LONG_BIT)); else if (SCM_EQ_P (fill, SCM_BOOL_T)) @@ -837,7 +837,7 @@ scm_ra_eqp (SCM ra0, SCM ras) SCM e1 = SCM_UNDEFINED, e2 = SCM_UNDEFINED; for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2) if (SCM_BITVEC_REF (ra0, i0)) - if (SCM_FALSEP(scm_eq_p (RVREF (ra1, i1, e1), RVREF (ra2, i2, e2)))) + if (scm_is_false(scm_eq_p (RVREF (ra1, i1, e1), RVREF (ra2, i2, e2)))) SCM_BITVEC_CLR (ra0, i0); break; } @@ -897,8 +897,8 @@ ra_compare (SCM ra0, SCM ra1, SCM ra2, int opt) for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2) if (SCM_BITVEC_REF (ra0, i0)) if (opt ? - SCM_NFALSEP (scm_less_p (RVREF (ra1, i1, e1), RVREF (ra2, i2, e2))) : - SCM_FALSEP (scm_less_p (RVREF (ra1, i1, e1), RVREF (ra2, i2, e2)))) + scm_is_true (scm_less_p (RVREF (ra1, i1, e1), RVREF (ra2, i2, e2))) : + scm_is_false (scm_less_p (RVREF (ra1, i1, e1), RVREF (ra2, i2, e2)))) SCM_BITVEC_CLR (ra0, i0); break; } @@ -1323,7 +1323,7 @@ ramap_rp (SCM ra0, SCM proc, SCM ras) default: for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2) if (SCM_BITVEC_REF (ra0, i0)) - if (SCM_FALSEP (SCM_SUBRF (proc) (RVREF (ra1, i1, e1), RVREF (ra2, i2, e2)))) + if (scm_is_false (SCM_SUBRF (proc) (RVREF (ra1, i1, e1), RVREF (ra2, i2, e2)))) SCM_BITVEC_CLR (ra0, i0); break; case scm_tc7_uvect: @@ -1337,7 +1337,7 @@ ramap_rp (SCM ra0, SCM proc, SCM ras) */ SCM n1 = SCM_MAKINUM (((long *) SCM_UNPACK (SCM_CDR (ra1)))[i1]); SCM n2 = SCM_MAKINUM (((long *) SCM_UNPACK (SCM_CDR (ra2)))[i2]); - if (SCM_FALSEP (SCM_SUBRF (proc) (n1, n2))) + if (scm_is_false (SCM_SUBRF (proc) (n1, n2))) SCM_BITVEC_CLR (ra0, i0); } break; @@ -1349,7 +1349,7 @@ ramap_rp (SCM ra0, SCM proc, SCM ras) { SCM_REAL_VALUE (a1) = ((float *) SCM_VELTS (ra1))[i1]; SCM_REAL_VALUE (a2) = ((float *) SCM_VELTS (ra2))[i2]; - if (SCM_FALSEP (SCM_SUBRF (proc) (a1, a2))) + if (scm_is_false (SCM_SUBRF (proc) (a1, a2))) SCM_BITVEC_CLR (ra0, i0); } break; @@ -1363,7 +1363,7 @@ ramap_rp (SCM ra0, SCM proc, SCM ras) { SCM_REAL_VALUE (a1) = ((double *) SCM_VELTS (ra1))[i1]; SCM_REAL_VALUE (a2) = ((double *) SCM_VELTS (ra2))[i2]; - if (SCM_FALSEP (SCM_SUBRF (proc) (a1, a2))) + if (scm_is_false (SCM_SUBRF (proc) (a1, a2))) SCM_BITVEC_CLR (ra0, i0); } break; @@ -1379,7 +1379,7 @@ ramap_rp (SCM ra0, SCM proc, SCM ras) SCM_COMPLEX_IMAG (a1) = ((double *) SCM_VELTS (ra1))[2 * i1 + 1]; SCM_COMPLEX_REAL (a2) = ((double *) SCM_VELTS (ra2))[2 * i2]; SCM_COMPLEX_IMAG (a2) = ((double *) SCM_VELTS (ra2))[2 * i2 + 1]; - if (SCM_FALSEP (SCM_SUBRF (proc) (a1, a2))) + if (scm_is_false (SCM_SUBRF (proc) (a1, a2))) SCM_BITVEC_CLR (ra0, i0); } break; @@ -1518,7 +1518,7 @@ SCM_DEFINE (scm_array_map_x, "array-map!", 2, 0, 1, case scm_tc7_rpsubr: { ra_iproc *p; - if (SCM_FALSEP (scm_array_p (ra0, SCM_BOOL_T))) + if (scm_is_false (scm_array_p (ra0, SCM_BOOL_T))) goto gencase; scm_array_fill_x (ra0, SCM_BOOL_T); for (p = ra_rpsubrs; p->name; p++) @@ -1781,12 +1781,12 @@ raeql_1 (SCM ra0, SCM as_equal, SCM ra1) default: for (; n--; i0 += inc0, i1 += inc1) { - if (SCM_FALSEP (as_equal)) + if (scm_is_false (as_equal)) { - if (SCM_FALSEP (scm_array_equal_p (RVREF (ra0, i0, e0), RVREF (ra1, i1, e1)))) + if (scm_is_false (scm_array_equal_p (RVREF (ra0, i0, e0), RVREF (ra1, i1, e1)))) return 0; } - else if (SCM_FALSEP (scm_equal_p (RVREF (ra0, i0, e0), RVREF (ra1, i1, e1)))) + else if (scm_is_false (scm_equal_p (RVREF (ra0, i0, e0), RVREF (ra1, i1, e1)))) return 0; } return 1; @@ -1942,7 +1942,7 @@ raeql (SCM ra0, SCM as_equal, SCM ra1) SCM scm_raequal (SCM ra0, SCM ra1) { - return SCM_BOOL(raeql (ra0, SCM_BOOL_T, ra1)); + return scm_from_bool(raeql (ra0, SCM_BOOL_T, ra1)); } #if 0 @@ -2007,7 +2007,7 @@ scm_array_equal_p (SCM ra0, SCM ra1) if (!SCM_ARRAYP (ra1)) goto callequal; } - return SCM_BOOL(raeql (ra0, SCM_BOOL_F, ra1)); + return scm_from_bool(raeql (ra0, SCM_BOOL_F, ra1)); } diff --git a/libguile/rdelim.c b/libguile/rdelim.c index 6b0050c25..4e991539f 100644 --- a/libguile/rdelim.c +++ b/libguile/rdelim.c @@ -81,7 +81,7 @@ SCM_DEFINE (scm_read_delimited_x, "%read-delimited!", 3, 3, 0, { if (cdelims[k] == c) { - if (SCM_FALSEP (gobble)) + if (scm_is_false (gobble)) scm_ungetc (c, port); return scm_cons (SCM_MAKE_CHAR (c), diff --git a/libguile/read.c b/libguile/read.c index 0bf4533c0..ebaf1ed29 100644 --- a/libguile/read.c +++ b/libguile/read.c @@ -233,7 +233,7 @@ recsexpr (SCM obj, long line, int column, SCM filename) /* If this sexpr is visible in the read:sharp source, we want to keep that information, so only record non-constant cons cells which haven't previously been read by the reader. */ - if (SCM_FALSEP (scm_whash_lookup (scm_source_whash, obj))) + if (scm_is_false (scm_whash_lookup (scm_source_whash, obj))) { if (SCM_COPY_SOURCE_P) { @@ -381,7 +381,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy) /* Check for user-defined hash procedure first, to allow overriding of builtin hash read syntaxes. */ SCM sharp = scm_get_hash_procedure (c); - if (!SCM_FALSEP (sharp)) + if (scm_is_true (sharp)) { int line = SCM_LINUM (port); int column = SCM_COL (port) - 2; @@ -439,7 +439,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy) case '*': j = scm_read_token (c, tok_buf, port, 0); p = scm_istr2bve (SCM_STRING_CHARS (*tok_buf) + 1, (long) (j - 1)); - if (!SCM_FALSEP (p)) + if (scm_is_true (p)) return p; else goto unkshrp; @@ -482,7 +482,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy) { SCM sharp = scm_get_hash_procedure (c); - if (!SCM_FALSEP (sharp)) + if (scm_is_true (sharp)) { int line = SCM_LINUM (port); int column = SCM_COL (port) - 2; @@ -595,7 +595,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy) goto tok; p = scm_i_mem2number (SCM_STRING_CHARS (*tok_buf), j, 10); - if (!SCM_FALSEP (p)) + if (scm_is_true (p)) return p; if (c == '#') { @@ -858,7 +858,7 @@ SCM_DEFINE (scm_read_hash_extend, "read-hash-extend", 2, 0, 0, SCM prev; SCM_VALIDATE_CHAR (1, chr); - SCM_ASSERT (SCM_FALSEP (proc) + SCM_ASSERT (scm_is_false (proc) || SCM_EQ_P (scm_procedure_p (proc), SCM_BOOL_T), proc, SCM_ARG2, FUNC_NAME); @@ -870,7 +870,7 @@ SCM_DEFINE (scm_read_hash_extend, "read-hash-extend", 2, 0, 0, if (SCM_NULLP (this)) { /* not found, so add it to the beginning. */ - if (!SCM_FALSEP (proc)) + if (scm_is_true (proc)) { *scm_read_hash_procedures = scm_cons (scm_cons (chr, proc), *scm_read_hash_procedures); @@ -880,10 +880,10 @@ SCM_DEFINE (scm_read_hash_extend, "read-hash-extend", 2, 0, 0, if (SCM_EQ_P (chr, SCM_CAAR (this))) { /* already in the alist. */ - if (SCM_FALSEP (proc)) + if (scm_is_false (proc)) { /* remove it. */ - if (SCM_FALSEP (prev)) + if (scm_is_false (prev)) { *scm_read_hash_procedures = SCM_CDR (*scm_read_hash_procedures); diff --git a/libguile/regex-posix.c b/libguile/regex-posix.c index 91529183f..56616fced 100644 --- a/libguile/regex-posix.c +++ b/libguile/regex-posix.c @@ -116,7 +116,7 @@ SCM_DEFINE (scm_regexp_p, "regexp?", 1, 0, 0, "or @code{#f} otherwise.") #define FUNC_NAME s_scm_regexp_p { - return SCM_BOOL(SCM_RGXP (obj)); + return scm_from_bool(SCM_RGXP (obj)); } #undef FUNC_NAME diff --git a/libguile/scmsigs.c b/libguile/scmsigs.c index 0e554428e..296cd4e10 100644 --- a/libguile/scmsigs.c +++ b/libguile/scmsigs.c @@ -153,7 +153,7 @@ scm_delq_spine_x (SCM cell, SCM list) prev = s; s = SCM_CDR (s); } - if (SCM_FALSEP (prev)) + if (scm_is_false (prev)) return SCM_CDR (cell); else { @@ -184,7 +184,7 @@ really_install_handler (void *data) /* Make sure we have a cell. */ cell = SCM_VECTOR_REF (signal_handler_cells, signum); - if (SCM_FALSEP (cell)) + if (scm_is_false (cell)) { cell = scm_cons (SCM_BOOL_F, SCM_EOL); SCM_VECTOR_SET (signal_handler_cells, signum, cell); @@ -195,12 +195,12 @@ really_install_handler (void *data) if (!SCM_EQ_P (thread, old_thread)) { scm_root_state *r; - if (!SCM_FALSEP (old_thread)) + if (scm_is_true (old_thread)) { r = scm_i_thread_root (old_thread); r->signal_asyncs = scm_delq_spine_x (cell, r->signal_asyncs); } - if (!SCM_FALSEP (thread)) + if (scm_is_true (thread)) { r = scm_i_thread_root (thread); SCM_SETCDR (cell, r->signal_asyncs); @@ -214,7 +214,7 @@ really_install_handler (void *data) } /* Set the new handler. */ - if (SCM_FALSEP (handler)) + if (scm_is_false (handler)) { SCM_VECTOR_SET (*signal_handlers, signum, SCM_BOOL_F); SCM_VECTOR_SET (signal_cell_handlers, signum, SCM_BOOL_F); @@ -232,7 +232,7 @@ really_install_handler (void *data) following code will install the new handler, so we have no problem. */ - if (!SCM_FALSEP (SCM_CAR (cell))) + if (scm_is_true (SCM_CAR (cell))) SCM_SETCAR (cell, SCM_VECTOR_REF (signal_cell_handlers, signum)); /* Phfew. That should be it. */ @@ -346,7 +346,7 @@ SCM_DEFINE (scm_sigaction_for_thread, "sigaction", 1, 3, 0, else SCM_OUT_OF_RANGE (2, handler); } - else if (SCM_FALSEP (handler)) + else if (scm_is_false (handler)) { /* restore the default handler. */ #ifdef HAVE_SIGACTION diff --git a/libguile/script.c b/libguile/script.c index b56de0f8d..537faeaac 100644 --- a/libguile/script.c +++ b/libguile/script.c @@ -605,7 +605,7 @@ scm_compile_shell_switches (int argc, char **argv) scm_set_program_arguments (argc ? argc - i : 0, argv + i, argv0); /* If the --emacs switch was set, now is when we process it. */ - scm_c_define ("use-emacs-interface", SCM_BOOL (use_emacs_interface)); + scm_c_define ("use-emacs-interface", scm_from_bool (use_emacs_interface)); /* Handle the `-e' switch, if it was specified. */ if (!SCM_NULLP (entry_point)) diff --git a/libguile/simpos.c b/libguile/simpos.c index 356d78673..ee17fbd3e 100644 --- a/libguile/simpos.c +++ b/libguile/simpos.c @@ -68,7 +68,7 @@ SCM_DEFINE (scm_system, "system", 0, 1, 0, if (SCM_UNBNDP (cmd)) { rv = system (NULL); - return SCM_BOOL(rv); + return scm_from_bool(rv); } SCM_VALIDATE_STRING (1, cmd); errno = 0; diff --git a/libguile/sort.c b/libguile/sort.c index 7ef9a8873..cf4c885ad 100644 --- a/libguile/sort.c +++ b/libguile/sort.c @@ -135,13 +135,13 @@ quicksort (SCM *const base_ptr, size_t nr_elems, scm_t_trampoline_2 cmp, SCM les size_t mid = lo + (hi - lo) / 2; - if (!SCM_FALSEP ((*cmp) (less, base_ptr[mid], base_ptr[lo]))) + if (scm_is_true ((*cmp) (less, base_ptr[mid], base_ptr[lo]))) SWAP (base_ptr[mid], base_ptr[lo]); - if (!SCM_FALSEP ((*cmp) (less, base_ptr[hi], base_ptr[mid]))) + if (scm_is_true ((*cmp) (less, base_ptr[hi], base_ptr[mid]))) SWAP (base_ptr[mid], base_ptr[hi]); else goto jump_over; - if (!SCM_FALSEP ((*cmp) (less, base_ptr[mid], base_ptr[lo]))) + if (scm_is_true ((*cmp) (less, base_ptr[mid], base_ptr[lo]))) SWAP (base_ptr[mid], base_ptr[lo]); jump_over:; @@ -153,7 +153,7 @@ quicksort (SCM *const base_ptr, size_t nr_elems, scm_t_trampoline_2 cmp, SCM les that this algorithm runs much faster than others. */ do { - while (!SCM_FALSEP ((*cmp) (less, base_ptr[left], base_ptr[mid]))) + while (scm_is_true ((*cmp) (less, base_ptr[left], base_ptr[mid]))) { left++; /* The comparison predicate may be buggy */ @@ -161,7 +161,7 @@ quicksort (SCM *const base_ptr, size_t nr_elems, scm_t_trampoline_2 cmp, SCM les scm_misc_error (NULL, s_buggy_less, SCM_EOL); } - while (!SCM_FALSEP ((*cmp) (less, base_ptr[mid], base_ptr[right]))) + while (scm_is_true ((*cmp) (less, base_ptr[mid], base_ptr[right]))) { right--; /* The comparison predicate may be buggy */ @@ -233,7 +233,7 @@ quicksort (SCM *const base_ptr, size_t nr_elems, scm_t_trampoline_2 cmp, SCM les and the operation speeds up insertion sort's inner loop. */ for (run = tmp + 1; run <= thresh; run++) - if (!SCM_FALSEP ((*cmp) (less, base_ptr[run], base_ptr[tmp]))) + if (scm_is_true ((*cmp) (less, base_ptr[run], base_ptr[tmp]))) tmp = run; if (tmp != 0) @@ -245,7 +245,7 @@ quicksort (SCM *const base_ptr, size_t nr_elems, scm_t_trampoline_2 cmp, SCM les while (++run <= end) { tmp = run - 1; - while (!SCM_FALSEP ((*cmp) (less, base_ptr[run], base_ptr[tmp]))) + while (scm_is_true ((*cmp) (less, base_ptr[run], base_ptr[tmp]))) { /* The comparison predicate may be buggy */ if (tmp == 0) @@ -343,7 +343,7 @@ SCM_DEFINE (scm_sorted_p, "sorted?", 2, 0, 0, j = len - 1; while (j > 0) { - if (!SCM_FALSEP ((*cmp) (less, SCM_CAR (rest), item))) + if (scm_is_true ((*cmp) (less, SCM_CAR (rest), item))) return SCM_BOOL_F; else { @@ -363,7 +363,7 @@ SCM_DEFINE (scm_sorted_p, "sorted?", 2, 0, 0, j = len - 1; while (j > 0) { - if (!SCM_FALSEP ((*cmp) (less, vp[1], vp[0]))) + if (scm_is_true ((*cmp) (less, vp[1], vp[0]))) return SCM_BOOL_F; else { @@ -409,7 +409,7 @@ SCM_DEFINE (scm_merge, "merge", 3, 0, 0, SCM_VALIDATE_NONEMPTYLIST_COPYLEN (1, alist, alen); SCM_VALIDATE_NONEMPTYLIST_COPYLEN (2, blist, blen); - if (!SCM_FALSEP ((*cmp) (less, SCM_CAR (blist), SCM_CAR (alist)))) + if (scm_is_true ((*cmp) (less, SCM_CAR (blist), SCM_CAR (alist)))) { build = scm_cons (SCM_CAR (blist), SCM_EOL); blist = SCM_CDR (blist); @@ -424,7 +424,7 @@ SCM_DEFINE (scm_merge, "merge", 3, 0, 0, last = build; while ((alen > 0) && (blen > 0)) { - if (!SCM_FALSEP ((*cmp) (less, SCM_CAR (blist), SCM_CAR (alist)))) + if (scm_is_true ((*cmp) (less, SCM_CAR (blist), SCM_CAR (alist)))) { SCM_SETCDR (last, scm_cons (SCM_CAR (blist), SCM_EOL)); blist = SCM_CDR (blist); @@ -461,7 +461,7 @@ scm_merge_list_x (SCM alist, SCM blist, return alist; else { - if (!SCM_FALSEP ((*cmp) (less, SCM_CAR (blist), SCM_CAR (alist)))) + if (scm_is_true ((*cmp) (less, SCM_CAR (blist), SCM_CAR (alist)))) { build = blist; blist = SCM_CDR (blist); @@ -476,7 +476,7 @@ scm_merge_list_x (SCM alist, SCM blist, last = build; while ((alen > 0) && (blen > 0)) { - if (!SCM_FALSEP ((*cmp) (less, SCM_CAR (blist), SCM_CAR (alist)))) + if (scm_is_true ((*cmp) (less, SCM_CAR (blist), SCM_CAR (alist)))) { SCM_SETCDR (last, blist); blist = SCM_CDR (blist); @@ -551,7 +551,7 @@ scm_merge_list_step (SCM * seq, scm_t_trampoline_2 cmp, SCM less, long n) SCM y = SCM_CAR (SCM_CDR (*seq)); *seq = SCM_CDR (rest); SCM_SETCDR (rest, SCM_EOL); - if (!SCM_FALSEP ((*cmp) (less, y, x))) + if (scm_is_true ((*cmp) (less, y, x))) { SCM_SETCAR (p, y); SCM_SETCAR (rest, x); @@ -668,7 +668,7 @@ scm_merge_vector_x (SCM vec, */ register SCM *vp = SCM_WRITABLE_VELTS(vec); - if (!SCM_FALSEP ((*cmp) (less, vp[i2], vp[i1]))) + if (scm_is_true ((*cmp) (less, vp[i2], vp[i1]))) temp[it] = vp[i2++]; else temp[it] = vp[i1++]; diff --git a/libguile/srcprop.c b/libguile/srcprop.c index 7eee11f1c..0c74f84bd 100644 --- a/libguile/srcprop.c +++ b/libguile/srcprop.c @@ -143,7 +143,7 @@ scm_srcprops_to_plist (SCM obj) plist = scm_acons (scm_sym_filename, SRCPROPFNAME (obj), plist); plist = scm_acons (scm_sym_column, SCM_MAKINUM (SRCPROPCOL (obj)), plist); plist = scm_acons (scm_sym_line, SCM_MAKINUM (SRCPROPLINE (obj)), plist); - plist = scm_acons (scm_sym_breakpoint, SCM_BOOL (SRCPROPBRK (obj)), plist); + plist = scm_acons (scm_sym_breakpoint, scm_from_bool (SRCPROPBRK (obj)), plist); return plist; } @@ -202,7 +202,7 @@ SCM_DEFINE (scm_source_property, "source-property", 2, 0, 0, p = scm_hashq_ref (scm_source_whash, obj, SCM_EOL); if (!SRCPROPSP (p)) goto plist; - if (SCM_EQ_P (scm_sym_breakpoint, key)) p = SCM_BOOL (SRCPROPBRK (p)); + if (SCM_EQ_P (scm_sym_breakpoint, key)) p = scm_from_bool (SRCPROPBRK (p)); else if (SCM_EQ_P (scm_sym_line, key)) p = SCM_MAKINUM (SRCPROPLINE (p)); else if (SCM_EQ_P (scm_sym_column, key)) p = SCM_MAKINUM (SRCPROPCOL (p)); else if (SCM_EQ_P (scm_sym_filename, key)) p = SRCPROPFNAME (p); @@ -243,7 +243,7 @@ SCM_DEFINE (scm_set_source_property_x, "set-source-property!", 3, 0, 0, { if (SRCPROPSP (p)) { - if (SCM_FALSEP (datum)) + if (scm_is_false (datum)) CLEARSRCPROPBRK (p); else SETSRCPROPBRK (p); @@ -252,7 +252,7 @@ SCM_DEFINE (scm_set_source_property_x, "set-source-property!", 3, 0, 0, { SCM sp = scm_make_srcprops (0, 0, SCM_UNDEFINED, SCM_UNDEFINED, p); SCM_WHASHSET (scm_source_whash, h, sp); - if (SCM_FALSEP (datum)) + if (scm_is_false (datum)) CLEARSRCPROPBRK (sp); else SETSRCPROPBRK (sp); diff --git a/libguile/srcprop.h b/libguile/srcprop.h index bd6918bf4..47c05ffb2 100644 --- a/libguile/srcprop.h +++ b/libguile/srcprop.h @@ -35,7 +35,7 @@ #define scm_whash_handle SCM #define scm_whash_get_handle(whash, key) scm_hash_fn_get_handle (whash, key, scm_ihashq, scm_sloppy_assq, 0) -#define SCM_WHASHFOUNDP(h) (!SCM_FALSEP (h)) +#define SCM_WHASHFOUNDP(h) (scm_is_true (h)) #define SCM_WHASHREF(whash, handle) SCM_CDR (handle) #define SCM_WHASHSET(whash, handle, obj) SCM_SETCDR (handle, obj) #define scm_whash_create_handle(whash, key) scm_hash_fn_create_handle_x (whash, key, SCM_UNSPECIFIED, scm_ihashq, scm_sloppy_assq, 0) @@ -88,7 +88,7 @@ typedef struct scm_t_srcprops_chunk #define SETSRCPROPLINE(p, l) SETSRCPROPPOS (p, l, SRCPROPCOL (p)) #define SETSRCPROPCOL(p, c) SETSRCPROPPOS (p, SRCPROPLINE (p), c) -#define PROCTRACEP(x) (!SCM_FALSEP (scm_procedure_property (x, scm_sym_trace))) +#define PROCTRACEP(x) (scm_is_true (scm_procedure_property (x, scm_sym_trace))) SCM_API SCM scm_sym_filename; SCM_API SCM scm_sym_copy; diff --git a/libguile/stacks.c b/libguile/stacks.c index 6db780f46..d6a8ad838 100644 --- a/libguile/stacks.c +++ b/libguile/stacks.c @@ -205,7 +205,7 @@ do { \ && SCM_EQ_P (SCM_MEMOIZED_EXP (iframe->source), applybody)) \ { \ iframe->source = SCM_BOOL_F; \ - if (SCM_FALSEP (iframe->proc)) \ + if (scm_is_false (iframe->proc)) \ { \ --iframe; \ ++n; \ @@ -332,7 +332,7 @@ narrow_stack (SCM stack, long inner, SCM inner_key, long outer, SCM outer_key) SCM m = s->frames[i].source; if (SCM_MEMOIZEDP (m) && !SCM_IMP (SCM_MEMOIZED_ENV (m)) - && SCM_FALSEP (scm_system_module_env_p (SCM_MEMOIZED_ENV (m)))) + && scm_is_false (scm_system_module_env_p (SCM_MEMOIZED_ENV (m)))) { /* Back up in order to include any non-source frames */ while (i > 0) @@ -342,8 +342,8 @@ narrow_stack (SCM stack, long inner, SCM inner_key, long outer, SCM outer_key) break; m = s->frames[i - 1].proc; - if (!SCM_FALSEP (scm_procedure_p (m)) - && !SCM_FALSEP (scm_procedure_property + if (scm_is_true (scm_procedure_p (m)) + && scm_is_true (scm_procedure_property (m, scm_sym_system_procedure))) break; @@ -384,7 +384,7 @@ SCM_DEFINE (scm_stack_p, "stack?", 1, 0, 0, "Return @code{#t} if @var{obj} is a calling stack.") #define FUNC_NAME s_scm_stack_p { - return SCM_BOOL(SCM_STACKP (obj)); + return scm_from_bool(SCM_STACKP (obj)); } #undef FUNC_NAME @@ -577,7 +577,7 @@ SCM_DEFINE (scm_frame_p, "frame?", 1, 0, 0, "Return @code{#t} if @var{obj} is a stack frame.") #define FUNC_NAME s_scm_frame_p { - return SCM_BOOL(SCM_FRAMEP (obj)); + return scm_from_bool(SCM_FRAMEP (obj)); } #undef FUNC_NAME @@ -706,7 +706,7 @@ SCM_DEFINE (scm_frame_real_p, "frame-real?", 1, 0, 0, #define FUNC_NAME s_scm_frame_real_p { SCM_VALIDATE_FRAME (1, frame); - return SCM_BOOL(SCM_FRAME_REAL_P (frame)); + return scm_from_bool(SCM_FRAME_REAL_P (frame)); } #undef FUNC_NAME @@ -716,7 +716,7 @@ SCM_DEFINE (scm_frame_procedure_p, "frame-procedure?", 1, 0, 0, #define FUNC_NAME s_scm_frame_procedure_p { SCM_VALIDATE_FRAME (1, frame); - return SCM_BOOL(SCM_FRAME_PROC_P (frame)); + return scm_from_bool(SCM_FRAME_PROC_P (frame)); } #undef FUNC_NAME @@ -726,7 +726,7 @@ SCM_DEFINE (scm_frame_evaluating_args_p, "frame-evaluating-args?", 1, 0, 0, #define FUNC_NAME s_scm_frame_evaluating_args_p { SCM_VALIDATE_FRAME (1, frame); - return SCM_BOOL(SCM_FRAME_EVAL_ARGS_P (frame)); + return scm_from_bool(SCM_FRAME_EVAL_ARGS_P (frame)); } #undef FUNC_NAME @@ -736,7 +736,7 @@ SCM_DEFINE (scm_frame_overflow_p, "frame-overflow?", 1, 0, 0, #define FUNC_NAME s_scm_frame_overflow_p { SCM_VALIDATE_FRAME (1, frame); - return SCM_BOOL(SCM_FRAME_OVERFLOW_P (frame)); + return scm_from_bool(SCM_FRAME_OVERFLOW_P (frame)); } #undef FUNC_NAME diff --git a/libguile/stime.c b/libguile/stime.c index 568f577c2..1b6d5331e 100644 --- a/libguile/stime.c +++ b/libguile/stime.c @@ -457,7 +457,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_FALSEP (velts[10]) || SCM_STRINGP (velts[10]), + SCM_ASSERT (scm_is_false (velts[10]) || SCM_STRINGP (velts[10]), sbd_time, pos, subr); lt->tm_sec = SCM_INUM (velts[0]); @@ -471,7 +471,7 @@ bdtime2c (SCM sbd_time, struct tm *lt, int pos, const char *subr) lt->tm_isdst = SCM_INUM (velts[8]); #ifdef HAVE_TM_ZONE lt->tm_gmtoff = SCM_INUM (velts[9]); - if (SCM_FALSEP (velts[10])) + if (scm_is_false (velts[10])) lt->tm_zone = NULL; else lt->tm_zone = SCM_STRING_CHARS (velts[10]); @@ -619,7 +619,7 @@ SCM_DEFINE (scm_strftime, "strftime", 2, 0, 0, SCM *velts = (SCM *) SCM_VELTS (stime); int have_zone = 0; - if (!SCM_FALSEP (velts[10]) && *SCM_STRING_CHARS (velts[10]) != 0) + if (scm_is_true (velts[10]) && *SCM_STRING_CHARS (velts[10]) != 0) { /* it's not required that the TZ setting be correct, just that it has the right name. so try something like TZ=EST0. diff --git a/libguile/strings.c b/libguile/strings.c index d38959413..8bde1bd09 100644 --- a/libguile/strings.c +++ b/libguile/strings.c @@ -37,7 +37,7 @@ SCM_DEFINE (scm_string_p, "string?", 1, 0, 0, "Return @code{#t} if @var{obj} is a string, else @code{#f}.") #define FUNC_NAME s_scm_string_p { - return SCM_BOOL (SCM_STRINGP (obj)); + return scm_from_bool (SCM_STRINGP (obj)); } #undef FUNC_NAME diff --git a/libguile/strop.c b/libguile/strop.c index cb844a3a2..8950a482d 100644 --- a/libguile/strop.c +++ b/libguile/strop.c @@ -60,7 +60,7 @@ scm_i_index (SCM *str, SCM chr, int direction, SCM sub_start, SCM_ASSERT (SCM_STRINGP (*str), *str, SCM_ARG1, why); SCM_ASSERT (SCM_CHARP (chr), chr, SCM_ARG2, why); - if (SCM_FALSEP (sub_start)) + if (scm_is_false (sub_start)) sub_start = SCM_MAKINUM (0); SCM_ASSERT (SCM_INUMP (sub_start), sub_start, SCM_ARG3, why); @@ -68,7 +68,7 @@ scm_i_index (SCM *str, SCM chr, int direction, SCM sub_start, if (lower < 0 || lower > SCM_STRING_LENGTH (*str)) scm_out_of_range (why, sub_start); - if (SCM_FALSEP (sub_end)) + if (scm_is_false (sub_end)) sub_end = SCM_MAKINUM (SCM_STRING_LENGTH (*str)); SCM_ASSERT (SCM_INUMP (sub_end), sub_end, SCM_ARG4, why); @@ -227,7 +227,7 @@ SCM_DEFINE (scm_string_null_p, "string-null?", 1, 0, 0, #define FUNC_NAME s_scm_string_null_p { SCM_VALIDATE_STRING (1, str); - return SCM_BOOL (SCM_STRING_LENGTH (str) == 0); + return scm_from_bool (SCM_STRING_LENGTH (str) == 0); } #undef FUNC_NAME @@ -394,7 +394,7 @@ string_capitalize_x (SCM str) len = SCM_STRING_LENGTH(str); sz = SCM_STRING_UCHARS (str); for(i=0; i 0) return SCM_BOOL_F; } - return SCM_BOOL (length1 < length2); + return scm_from_bool (length1 < length2); } @@ -147,7 +147,7 @@ SCM_DEFINE1 (scm_string_leq_p, "string<=?", scm_tc7_rpsubr, SCM_VALIDATE_STRING (1, s1); SCM_VALIDATE_STRING (2, s2); - return SCM_BOOL_NOT (string_less_p (s2, s1)); + return scm_not (string_less_p (s2, s1)); } #undef FUNC_NAME @@ -175,7 +175,7 @@ SCM_DEFINE1 (scm_string_geq_p, "string>=?", scm_tc7_rpsubr, SCM_VALIDATE_STRING (1, s1); SCM_VALIDATE_STRING (2, s2); - return SCM_BOOL_NOT (string_less_p (s1, s2)); + return scm_not (string_less_p (s1, s2)); } #undef FUNC_NAME @@ -200,7 +200,7 @@ string_ci_less_p (SCM s1, SCM s2) if (c > 0) return SCM_BOOL_F; } - return SCM_BOOL (length1 < length2); + return scm_from_bool (length1 < length2); } @@ -229,7 +229,7 @@ SCM_DEFINE1 (scm_string_ci_leq_p, "string-ci<=?", scm_tc7_rpsubr, SCM_VALIDATE_STRING (1, s1); SCM_VALIDATE_STRING (2, s2); - return SCM_BOOL_NOT (string_ci_less_p (s2, s1)); + return scm_not (string_ci_less_p (s2, s1)); } #undef FUNC_NAME @@ -259,7 +259,7 @@ SCM_DEFINE1 (scm_string_ci_geq_p, "string-ci>=?", scm_tc7_rpsubr, SCM_VALIDATE_STRING (1, s1); SCM_VALIDATE_STRING (2, s2); - return SCM_BOOL_NOT (string_ci_less_p (s1, s2)); + return scm_not (string_ci_less_p (s1, s2)); } #undef FUNC_NAME diff --git a/libguile/struct.c b/libguile/struct.c index b41fd1e08..5a4fe9cbe 100644 --- a/libguile/struct.c +++ b/libguile/struct.c @@ -222,7 +222,7 @@ SCM_DEFINE (scm_struct_p, "struct?", 1, 0, 0, "@code{#f}.") #define FUNC_NAME s_scm_struct_p { - return SCM_BOOL(SCM_STRUCTP (x)); + return scm_from_bool(SCM_STRUCTP (x)); } #undef FUNC_NAME @@ -248,7 +248,7 @@ SCM_DEFINE (scm_struct_vtable_p, "struct-vtable?", 1, 0, 0, mem = SCM_STRUCT_DATA (x); - return SCM_BOOL (SCM_SYMBOLP (SCM_PACK (mem[scm_vtable_index_layout]))); + return scm_from_bool (SCM_SYMBOLP (SCM_PACK (mem[scm_vtable_index_layout]))); } #undef FUNC_NAME @@ -726,7 +726,7 @@ scm_struct_create_handle (SCM obj) scm_struct_ihashq, scm_sloppy_assq, 0); - if (SCM_FALSEP (SCM_CDR (handle))) + if (scm_is_false (SCM_CDR (handle))) SCM_SETCDR (handle, scm_cons (SCM_BOOL_F, SCM_BOOL_F)); return handle; } @@ -760,14 +760,14 @@ SCM_DEFINE (scm_set_struct_vtable_name_x, "set-struct-vtable-name!", 2, 0, 0, void scm_print_struct (SCM exp, SCM port, scm_print_state *pstate) { - if (SCM_NFALSEP (scm_procedure_p (SCM_STRUCT_PRINTER (exp)))) + if (scm_is_true (scm_procedure_p (SCM_STRUCT_PRINTER (exp)))) scm_printer_apply (SCM_STRUCT_PRINTER (exp), exp, port, pstate); else { SCM vtable = SCM_STRUCT_VTABLE (exp); SCM name = scm_struct_vtable_name (vtable); scm_puts ("#<", port); - if (SCM_NFALSEP (name)) + if (scm_is_true (name)) scm_display (name, port); else scm_puts ("struct", port); diff --git a/libguile/symbols.c b/libguile/symbols.c index c84030179..d76888fe0 100644 --- a/libguile/symbols.c +++ b/libguile/symbols.c @@ -162,7 +162,7 @@ SCM_DEFINE (scm_symbol_p, "symbol?", 1, 0, 0, "@code{#f}.") #define FUNC_NAME s_scm_symbol_p { - return SCM_BOOL (SCM_SYMBOLP (obj)); + return scm_from_bool (SCM_SYMBOLP (obj)); } #undef FUNC_NAME @@ -173,7 +173,7 @@ SCM_DEFINE (scm_symbol_interned_p, "symbol-interned?", 1, 0, 0, #define FUNC_NAME s_scm_symbol_interned_p { SCM_VALIDATE_SYMBOL (1, symbol); - return SCM_BOOL (SCM_SYMBOL_INTERNED_P (symbol)); + return scm_from_bool (SCM_SYMBOL_INTERNED_P (symbol)); } #undef FUNC_NAME diff --git a/libguile/threads.c b/libguile/threads.c index 32d7daad2..11e3fdd39 100644 --- a/libguile/threads.c +++ b/libguile/threads.c @@ -428,8 +428,8 @@ SCM_DEFINE (scm_call_with_new_thread, "call-with-new-thread", 2, 0, 0, "All the evaluation rules for dynamic roots apply to threads.") #define FUNC_NAME s_scm_call_with_new_thread { - SCM_ASSERT (SCM_NFALSEP (scm_thunk_p (thunk)), thunk, SCM_ARG1, FUNC_NAME); - SCM_ASSERT (SCM_NFALSEP (scm_procedure_p (handler)), handler, SCM_ARG2, + SCM_ASSERT (scm_is_true (scm_thunk_p (thunk)), thunk, SCM_ARG1, FUNC_NAME); + SCM_ASSERT (scm_is_true (scm_procedure_p (handler)), handler, SCM_ARG2, FUNC_NAME); return create_thread ((scm_t_catch_body) scm_call_0, thunk, @@ -443,7 +443,7 @@ SCM_DEFINE (scm_yield, "yield", 0, 0, 0, "Move the calling thread to the end of the scheduling queue.") #define FUNC_NAME s_scm_yield { - return SCM_BOOL (scm_thread_yield ()); + return scm_from_bool (scm_thread_yield ()); } #undef FUNC_NAME @@ -592,7 +592,7 @@ fair_mutex_unlock (fair_mutex *m) else { SCM next = dequeue (m->waiting); - if (!SCM_FALSEP (next)) + if (scm_is_true (next)) { m->owner = next; unblock (SCM_THREAD_DATA (next)); @@ -667,7 +667,7 @@ fair_cond_signal (fair_cond *c) { SCM th; scm_i_plugin_mutex_lock (&c->lock); - if (!SCM_FALSEP (th = dequeue (c->waiting))) + if (scm_is_true (th = dequeue (c->waiting))) unblock (SCM_THREAD_DATA (th)); scm_i_plugin_mutex_unlock (&c->lock); return 0; @@ -678,7 +678,7 @@ fair_cond_broadcast (fair_cond *c) { SCM th; scm_i_plugin_mutex_lock (&c->lock); - while (!SCM_FALSEP (th = dequeue (c->waiting))) + while (scm_is_true (th = dequeue (c->waiting))) unblock (SCM_THREAD_DATA (th)); scm_i_plugin_mutex_unlock (&c->lock); return 0; @@ -1172,7 +1172,7 @@ SCM_DEFINE (scm_thread_exited_p, "thread-exited?", 1, 0, 0, "Return @code{#t} iff @var{thread} has exited.\n") #define FUNC_NAME s_scm_thread_exited_p { - return SCM_BOOL (scm_c_thread_exited_p (thread)); + return scm_from_bool (scm_c_thread_exited_p (thread)); } #undef FUNC_NAME diff --git a/libguile/throw.c b/libguile/throw.c index f278350af..c40000bdd 100644 --- a/libguile/throw.c +++ b/libguile/throw.c @@ -374,7 +374,7 @@ scm_exit_status (SCM args) if (SCM_INUMP (cqa)) return (SCM_INUM (cqa)); - else if (SCM_FALSEP (cqa)) + else if (scm_is_false (cqa)) return 1; } return 0; @@ -395,7 +395,7 @@ handler_message (void *handler_data, SCM tag, SCM args) SCM parts = SCM_CADDR (args); SCM rest = SCM_CDDDR (args); - if (SCM_BACKTRACE_P && SCM_NFALSEP (stack)) + if (SCM_BACKTRACE_P && scm_is_true (stack)) { scm_puts ("Backtrace:\n", p); scm_display_backtrace (stack, p, SCM_UNDEFINED, SCM_UNDEFINED); @@ -444,7 +444,7 @@ handler_message (void *handler_data, SCM tag, SCM args) SCM scm_handle_by_message (void *handler_data, SCM tag, SCM args) { - if (SCM_NFALSEP (scm_eq_p (tag, scm_str2symbol ("quit")))) + if (scm_is_true (scm_eq_p (tag, scm_str2symbol ("quit")))) { exit (scm_exit_status (args)); } diff --git a/libguile/unif.c b/libguile/unif.c index 912186d4a..5268062da 100644 --- a/libguile/unif.c +++ b/libguile/unif.c @@ -263,7 +263,7 @@ SCM_DEFINE (scm_array_p, "array?", 1, 1, 0, v = SCM_ARRAY_V (v); } if (nprot) - return SCM_BOOL(nprot); + return scm_from_bool(nprot); else { int protp = 0; @@ -316,7 +316,7 @@ SCM_DEFINE (scm_array_p, "array?", 1, 1, 0, /* no default */ ; } - return SCM_BOOL(protp); + return scm_from_bool(protp); } } #undef FUNC_NAME @@ -1038,7 +1038,7 @@ tail: { unsigned long int length = SCM_INUM (scm_uniform_vector_length (v)); SCM_ASRTGO (SCM_NULLP (args) && SCM_INUMP (ind), wna); - return SCM_BOOL(pos >= 0 && pos < length); + return scm_from_bool(pos >= 0 && pos < length); } } } @@ -1269,7 +1269,7 @@ SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1, case scm_tc7_smob: /* enclosed */ goto badarg1; case scm_tc7_bvect: - if (SCM_FALSEP (obj)) + if (scm_is_false (obj)) SCM_BITVEC_CLR(v, pos); else if (SCM_EQ_P (obj, SCM_BOOL_T)) SCM_BITVEC_SET(v, pos); @@ -1762,7 +1762,7 @@ SCM_DEFINE (scm_bit_count, "bit-count", 2, 0, 0, unsigned long int count = 0; unsigned long int i = (SCM_BITVECTOR_LENGTH (bitvector) - 1) / SCM_LONG_BIT; unsigned long int w = SCM_UNPACK (SCM_VELTS (bitvector)[i]); - if (SCM_FALSEP (b)) { + if (scm_is_false (b)) { w = ~w; }; w <<= SCM_LONG_BIT - 1 - ((SCM_BITVECTOR_LENGTH (bitvector) - 1) % SCM_LONG_BIT); @@ -1776,7 +1776,7 @@ SCM_DEFINE (scm_bit_count, "bit-count", 2, 0, 0, } else { --i; w = SCM_UNPACK (SCM_VELTS (bitvector)[i]); - if (SCM_FALSEP (b)) { + if (scm_is_false (b)) { w = ~w; } } @@ -1813,7 +1813,7 @@ SCM_DEFINE (scm_bit_position, "bit-position", 3, 0, 0, lenw = (SCM_BITVECTOR_LENGTH (v) - 1) / SCM_LONG_BIT; /* watch for part words */ i = pos / SCM_LONG_BIT; w = SCM_UNPACK (SCM_VELTS (v)[i]); - if (SCM_FALSEP (item)) + if (scm_is_false (item)) w = ~w; xbits = (pos % SCM_LONG_BIT); pos -= xbits; @@ -1847,7 +1847,7 @@ SCM_DEFINE (scm_bit_position, "bit-position", 3, 0, 0, break; pos += SCM_LONG_BIT; w = SCM_UNPACK (SCM_VELTS (v)[i]); - if (SCM_FALSEP (item)) + if (scm_is_false (item)) w = ~w; } return SCM_BOOL_F; @@ -1894,7 +1894,7 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0, badarg2:SCM_WRONG_TYPE_ARG (2, kv); case scm_tc7_uvect: vlen = SCM_BITVECTOR_LENGTH (v); - if (SCM_FALSEP (obj)) + if (scm_is_false (obj)) for (i = SCM_UVECTOR_LENGTH (kv); i;) { k = SCM_UNPACK (SCM_VELTS (kv)[--i]); @@ -1915,7 +1915,7 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0, break; case scm_tc7_bvect: SCM_ASSERT (SCM_BITVECTOR_LENGTH (v) == SCM_BITVECTOR_LENGTH (kv), v, SCM_ARG1, FUNC_NAME); - if (SCM_FALSEP (obj)) + if (scm_is_false (obj)) for (k = (SCM_BITVECTOR_LENGTH (v) + SCM_LONG_BIT - 1) / SCM_LONG_BIT; k--;) SCM_BITVECTOR_BASE (v) [k] &= ~SCM_BITVECTOR_BASE (kv) [k]; else if (SCM_EQ_P (obj, SCM_BOOL_T)) @@ -1964,7 +1964,7 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0, SCM_WRONG_TYPE_ARG (2, kv); case scm_tc7_uvect: vlen = SCM_BITVECTOR_LENGTH (v); - if (SCM_FALSEP (obj)) + if (scm_is_false (obj)) for (i = SCM_UVECTOR_LENGTH (kv); i;) { k = SCM_UNPACK (SCM_VELTS (kv)[--i]); @@ -1989,7 +1989,7 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0, SCM_ASSERT (SCM_BITVECTOR_LENGTH (v) == SCM_BITVECTOR_LENGTH (kv), v, SCM_ARG1, FUNC_NAME); if (0 == SCM_BITVECTOR_LENGTH (v)) return SCM_INUM0; - SCM_ASRTGO (SCM_BOOLP (obj), badarg3); + SCM_ASRTGO (scm_is_bool (obj), badarg3); fObj = SCM_EQ_P (obj, SCM_BOOL_T); i = (SCM_BITVECTOR_LENGTH (v) - 1) / SCM_LONG_BIT; k = SCM_UNPACK (SCM_VELTS (kv)[i]) & (fObj ? SCM_UNPACK (SCM_VELTS (v)[i]) : ~ SCM_UNPACK (SCM_VELTS (v)[i])); @@ -2116,9 +2116,9 @@ SCM_DEFINE (scm_array_to_list, "array->list", 1, 0, 0, register unsigned long mask; for (k = (SCM_BITVECTOR_LENGTH (v) - 1) / SCM_LONG_BIT; k > 0; k--) for (mask = 1UL << (SCM_LONG_BIT - 1); mask; mask >>= 1) - res = scm_cons (SCM_BOOL(((long *) data)[k] & mask), res); + res = scm_cons (scm_from_bool(((long *) data)[k] & mask), res); for (mask = 1L << ((SCM_BITVECTOR_LENGTH (v) % SCM_LONG_BIT) - 1); mask; mask >>= 1) - res = scm_cons (SCM_BOOL(((long *) data)[k] & mask), res); + res = scm_cons (scm_from_bool(((long *) data)[k] & mask), res); return res; } case scm_tc7_byvect: diff --git a/libguile/validate.h b/libguile/validate.h index e3dd57411..99a63deda 100644 --- a/libguile/validate.h +++ b/libguile/validate.h @@ -135,11 +135,14 @@ #define SCM_VALIDATE_NIM(pos, scm) SCM_MAKE_VALIDATE_MSG (pos, scm, NIMP, "non-immediate") -#define SCM_VALIDATE_BOOL(pos, flag) SCM_MAKE_VALIDATE_MSG(pos, flag, BOOLP, "boolean") +#define SCM_VALIDATE_BOOL(pos, flag) \ + do { \ + SCM_ASSERT_TYPE (scm_is_bool (flag), flag, pos, FUNC_NAME, "boolean"); \ + } while (0) #define SCM_VALIDATE_BOOL_COPY(pos, flag, cvar) \ do { \ - SCM_ASSERT (SCM_BOOLP (flag), flag, pos, FUNC_NAME); \ + SCM_ASSERT (scm_is_bool (flag), flag, pos, FUNC_NAME); \ cvar = SCM_EQ_P (flag, SCM_BOOL_T) ? 1 : 0; \ } while (0) @@ -358,7 +361,7 @@ #define SCM_VALIDATE_THUNK(pos, thunk) \ do { \ - SCM_ASSERT (!SCM_FALSEP (scm_thunk_p (thunk)), thunk, pos, FUNC_NAME); \ + SCM_ASSERT (scm_is_true (scm_thunk_p (thunk)), thunk, pos, FUNC_NAME); \ } while (0) #define SCM_VALIDATE_SYMBOL(pos, sym) SCM_MAKE_VALIDATE_MSG (pos, sym, SYMBOLP, "symbol") @@ -427,7 +430,7 @@ #define SCM_VALIDATE_ARRAY(pos, v) \ do { \ SCM_ASSERT (!SCM_IMP (v) \ - && !SCM_FALSEP (scm_array_p (v, SCM_UNDEFINED)), \ + && scm_is_true (scm_array_p (v, SCM_UNDEFINED)), \ v, pos, FUNC_NAME); \ } while (0) @@ -444,7 +447,7 @@ #define SCM_VALIDATE_VTABLE(pos, v) \ do { \ - SCM_ASSERT (!SCM_IMP (v) && !SCM_FALSEP (scm_struct_vtable_p (v)), \ + SCM_ASSERT (!SCM_IMP (v) && scm_is_true (scm_struct_vtable_p (v)), \ v, pos, FUNC_NAME); \ } while (0) diff --git a/libguile/variable.c b/libguile/variable.c index a3d06024d..c63d1dbf4 100644 --- a/libguile/variable.c +++ b/libguile/variable.c @@ -73,7 +73,7 @@ SCM_DEFINE (scm_variable_p, "variable?", 1, 0, 0, "return @code{#f}.") #define FUNC_NAME s_scm_variable_p { - return SCM_BOOL (SCM_VARIABLEP (obj)); + return scm_from_bool (SCM_VARIABLEP (obj)); } #undef FUNC_NAME @@ -114,7 +114,7 @@ SCM_DEFINE (scm_variable_bound_p, "variable-bound?", 1, 0, 0, #define FUNC_NAME s_scm_variable_bound_p { SCM_VALIDATE_VARIABLE (1, var); - return SCM_BOOL (SCM_VARIABLE_REF (var) != SCM_UNDEFINED); + return scm_from_bool (SCM_VARIABLE_REF (var) != SCM_UNDEFINED); } #undef FUNC_NAME diff --git a/libguile/vectors.c b/libguile/vectors.c index efcd98405..894a8320e 100644 --- a/libguile/vectors.c +++ b/libguile/vectors.c @@ -35,7 +35,7 @@ SCM_DEFINE (scm_vector_p, "vector?", 1, 0, 0, "@code{#f}.") #define FUNC_NAME s_scm_vector_p { - return SCM_BOOL (SCM_VECTORP (obj)); + return scm_from_bool (SCM_VECTORP (obj)); } #undef FUNC_NAME @@ -245,7 +245,7 @@ scm_vector_equal_p(SCM x, SCM y) { long i; for(i = SCM_VECTOR_LENGTH (x) - 1; i >= 0; i--) - if (SCM_FALSEP (scm_equal_p (SCM_VELTS (x)[i], SCM_VELTS (y)[i]))) + if (scm_is_false (scm_equal_p (SCM_VELTS (x)[i], SCM_VELTS (y)[i]))) return SCM_BOOL_F; return SCM_BOOL_T; } diff --git a/libguile/vports.c b/libguile/vports.c index a693d5323..7841cbe8a 100644 --- a/libguile/vports.c +++ b/libguile/vports.c @@ -65,7 +65,7 @@ sf_flush (SCM port) { SCM f = SCM_VELTS (stream)[2]; - if (!SCM_FALSEP (f)) + if (scm_is_true (f)) scm_call_0 (f); } } @@ -91,7 +91,7 @@ sf_fill_input (SCM port) SCM ans; ans = scm_call_0 (SCM_VELTS (p)[3]); /* get char. */ - if (SCM_FALSEP (ans) || SCM_EOF_OBJECT_P (ans)) + if (scm_is_false (ans) || SCM_EOF_OBJECT_P (ans)) return EOF; SCM_ASSERT (SCM_CHARP (ans), ans, SCM_ARG1, "sf_fill_input"); { @@ -110,11 +110,11 @@ sf_close (SCM port) { SCM p = SCM_PACK (SCM_STREAM (port)); SCM f = SCM_VELTS (p)[4]; - if (SCM_FALSEP (f)) + if (scm_is_false (f)) return 0; f = scm_call_0 (f); errno = 0; - return SCM_FALSEP (f) ? EOF : 0; + return scm_is_false (f) ? EOF : 0; } @@ -125,7 +125,7 @@ sf_input_waiting (SCM port) if (SCM_VECTOR_LENGTH (p) >= 6) { SCM f = SCM_VELTS (p)[5]; - if (SCM_NFALSEP (f)) + if (scm_is_true (f)) return scm_num2int (scm_call_0 (f), SCM_ARGn, NULL); } /* Default is such that char-ready? for soft ports returns #t, as it diff --git a/libguile/weaks.c b/libguile/weaks.c index a39b587ff..99ff92b55 100644 --- a/libguile/weaks.c +++ b/libguile/weaks.c @@ -173,7 +173,7 @@ SCM_DEFINE (scm_weak_vector_p, "weak-vector?", 1, 0, 0, "weak hashes are also weak vectors.") #define FUNC_NAME s_scm_weak_vector_p { - return SCM_BOOL (SCM_WVECTP (obj) && !SCM_IS_WHVEC (obj)); + return scm_from_bool (SCM_WVECTP (obj) && !SCM_IS_WHVEC (obj)); } #undef FUNC_NAME @@ -230,7 +230,7 @@ SCM_DEFINE (scm_weak_key_alist_vector_p, "weak-key-alist-vector?", 1, 0, 0, "nor a weak value hash table.") #define FUNC_NAME s_scm_weak_key_alist_vector_p { - return SCM_BOOL (SCM_WVECTP (obj) && SCM_IS_WHVEC (obj)); + return scm_from_bool (SCM_WVECTP (obj) && SCM_IS_WHVEC (obj)); } #undef FUNC_NAME @@ -240,7 +240,7 @@ SCM_DEFINE (scm_weak_value_alist_vector_p, "weak-value-alist-vector?", 1, 0, 0, "Return @code{#t} if @var{obj} is a weak value hash table.") #define FUNC_NAME s_scm_weak_value_alist_vector_p { - return SCM_BOOL (SCM_WVECTP (obj) && SCM_IS_WHVEC_V (obj)); + return scm_from_bool (SCM_WVECTP (obj) && SCM_IS_WHVEC_V (obj)); } #undef FUNC_NAME @@ -250,7 +250,7 @@ SCM_DEFINE (scm_doubly_weak_alist_vector_p, "doubly-weak-alist-vector?", 1, 0, 0 "Return @code{#t} if @var{obj} is a doubly weak hash table.") #define FUNC_NAME s_scm_doubly_weak_alist_vector_p { - return SCM_BOOL (SCM_WVECTP (obj) && SCM_IS_WHVEC_B (obj)); + return scm_from_bool (SCM_WVECTP (obj) && SCM_IS_WHVEC_B (obj)); } #undef FUNC_NAME -- 2.20.1