summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/ChangeLog24
-rw-r--r--libguile/alist.c8
-rw-r--r--libguile/async.c2
-rw-r--r--libguile/backtrace.c28
-rw-r--r--libguile/chars.c34
-rw-r--r--libguile/convert.i.c8
-rw-r--r--libguile/coop-pthreads.c12
-rw-r--r--libguile/coop-threads.c8
-rw-r--r--libguile/debug.c12
-rw-r--r--libguile/debug.h6
-rw-r--r--libguile/deprecated.c46
-rw-r--r--libguile/deprecation.c2
-rw-r--r--libguile/dynl.c2
-rw-r--r--libguile/dynwind.c2
-rw-r--r--libguile/environments.c24
-rw-r--r--libguile/eq.c26
-rw-r--r--libguile/error.c8
-rw-r--r--libguile/eval.c74
-rw-r--r--libguile/evalext.c6
-rw-r--r--libguile/filesys.c6
-rw-r--r--libguile/fluids.c2
-rw-r--r--libguile/fports.c2
-rw-r--r--libguile/gc.c6
-rw-r--r--libguile/gh_data.c4
-rw-r--r--libguile/gh_predicates.c32
-rw-r--r--libguile/goops.c38
-rw-r--r--libguile/goops.h2
-rw-r--r--libguile/guardians.c12
-rw-r--r--libguile/hashtab.c12
-rw-r--r--libguile/hooks.c12
-rw-r--r--libguile/init.c4
-rw-r--r--libguile/ioext.c2
-rw-r--r--libguile/keywords.c4
-rw-r--r--libguile/list.c20
-rw-r--r--libguile/load.c10
-rw-r--r--libguile/macros.c6
-rw-r--r--libguile/modules.c40
-rw-r--r--libguile/net_db.c8
-rw-r--r--libguile/objects.c14
-rw-r--r--libguile/options.c2
-rw-r--r--libguile/pairs.c2
-rw-r--r--libguile/ports.c14
-rw-r--r--libguile/posix.c10
-rw-r--r--libguile/print.c18
-rw-r--r--libguile/procprop.c6
-rw-r--r--libguile/procs.c8
-rw-r--r--libguile/properties.c10
-rw-r--r--libguile/ramap.c32
-rw-r--r--libguile/rdelim.c2
-rw-r--r--libguile/read.c18
-rw-r--r--libguile/regex-posix.c2
-rw-r--r--libguile/scmsigs.c14
-rw-r--r--libguile/script.c2
-rw-r--r--libguile/simpos.c2
-rw-r--r--libguile/sort.c30
-rw-r--r--libguile/srcprop.c8
-rw-r--r--libguile/srcprop.h4
-rw-r--r--libguile/stacks.c20
-rw-r--r--libguile/stime.c6
-rw-r--r--libguile/strings.c2
-rw-r--r--libguile/strop.c8
-rw-r--r--libguile/strorder.c12
-rw-r--r--libguile/struct.c10
-rw-r--r--libguile/symbols.c4
-rw-r--r--libguile/threads.c14
-rw-r--r--libguile/throw.c6
-rw-r--r--libguile/unif.c28
-rw-r--r--libguile/validate.h13
-rw-r--r--libguile/variable.c4
-rw-r--r--libguile/vectors.c4
-rw-r--r--libguile/vports.c10
-rw-r--r--libguile/weaks.c8
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 <marius.vollmer@uni-dortmund.de>
+
+ * 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 <marius.vollmer@uni-dortmund.de>
* 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 ("<unnamed port>", 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 ("<stdin>", 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
@@ -67,7 +67,7 @@ SCM_DEFINE1 (scm_char_leq_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
@@ -79,7 +79,7 @@ SCM_DEFINE1 (scm_char_gr_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
@@ -127,7 +127,7 @@ SCM_DEFINE1 (scm_char_ci_leq_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
@@ -139,7 +139,7 @@ SCM_DEFINE1 (scm_char_ci_gr_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 ("#<primitive-procedure", port);
- if (!SCM_FALSEP (name))
+ if (scm_is_true (name))
{
scm_putc (' ', port);
scm_puts (SCM_SYMBOL_CHARS (name), port);
@@ -622,7 +622,7 @@ scm_iprin1 (SCM exp, SCM port, scm_print_state *pstate)
scm_puts ("#<procedure-with-setter", port);
{
SCM name = scm_procedure_name (exp);
- if (!SCM_FALSEP (name))
+ if (scm_is_true (name))
{
scm_putc (' ', port);
scm_display (name, port);
@@ -686,7 +686,7 @@ scm_prin1 (SCM exp, SCM port, int writingp)
print_state_pool = SCM_CDR (print_state_pool);
}
scm_i_plugin_mutex_unlock (&print_state_mutex);
- if (SCM_FALSEP (handle))
+ if (scm_is_false (handle))
handle = scm_list_1 (make_print_state ());
pstate_scm = SCM_CAR (handle);
}
@@ -700,7 +700,7 @@ scm_prin1 (SCM exp, SCM port, int writingp)
/* Return print state to pool if it has been created above and
hasn't escaped to Scheme. */
- if (!SCM_FALSEP (handle) && !pstate->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<len; i++) {
- if (!SCM_FALSEP (scm_char_alphabetic_p (SCM_MAKE_CHAR (sz[i])))) {
+ if (scm_is_true (scm_char_alphabetic_p (SCM_MAKE_CHAR (sz[i])))) {
if(!in_word) {
sz[i] = scm_c_upcase(sz[i]);
in_word = 1;
diff --git a/libguile/strorder.c b/libguile/strorder.c
index 11224dba9..ac19d7370 100644
--- a/libguile/strorder.c
+++ b/libguile/strorder.c
@@ -120,7 +120,7 @@ string_less_p (SCM s1, SCM s2)
if (c > 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