mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-17 01:00:20 +02:00
* 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.
This commit is contained in:
parent
9c293a3d2f
commit
7888309be8
72 changed files with 469 additions and 432 deletions
|
@ -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>
|
2004-07-05 Marius Vollmer <marius.vollmer@uni-dortmund.de>
|
||||||
|
|
||||||
* boolean.h, boolean.c (scm_is_true, scm_is_false, scm_from_bool,
|
* boolean.h, boolean.c (scm_is_true, scm_is_false, scm_from_bool,
|
||||||
|
|
|
@ -71,7 +71,7 @@ SCM_DEFINE (scm_sloppy_assv, "sloppy-assv", 2, 0, 0,
|
||||||
{
|
{
|
||||||
SCM tmp = SCM_CAR (alist);
|
SCM tmp = SCM_CAR (alist);
|
||||||
if (SCM_CONSP (tmp)
|
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 tmp;
|
||||||
}
|
}
|
||||||
return SCM_BOOL_F;
|
return SCM_BOOL_F;
|
||||||
|
@ -89,7 +89,7 @@ SCM_DEFINE (scm_sloppy_assoc, "sloppy-assoc", 2, 0, 0,
|
||||||
{
|
{
|
||||||
SCM tmp = SCM_CAR (alist);
|
SCM tmp = SCM_CAR (alist);
|
||||||
if (SCM_CONSP (tmp)
|
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 tmp;
|
||||||
}
|
}
|
||||||
return SCM_BOOL_F;
|
return SCM_BOOL_F;
|
||||||
|
@ -139,7 +139,7 @@ SCM_DEFINE (scm_assv, "assv", 2, 0, 0,
|
||||||
SCM tmp = SCM_CAR (ls);
|
SCM tmp = SCM_CAR (ls);
|
||||||
SCM_ASSERT_TYPE (SCM_CONSP (tmp), alist, SCM_ARG2, FUNC_NAME,
|
SCM_ASSERT_TYPE (SCM_CONSP (tmp), alist, SCM_ARG2, FUNC_NAME,
|
||||||
"association list");
|
"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;
|
return tmp;
|
||||||
}
|
}
|
||||||
SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (ls), alist, SCM_ARG2, FUNC_NAME,
|
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 tmp = SCM_CAR (ls);
|
||||||
SCM_ASSERT_TYPE (SCM_CONSP (tmp), alist, SCM_ARG2, FUNC_NAME,
|
SCM_ASSERT_TYPE (SCM_CONSP (tmp), alist, SCM_ARG2, FUNC_NAME,
|
||||||
"association list");
|
"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;
|
return tmp;
|
||||||
}
|
}
|
||||||
SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (ls), alist, SCM_ARG2, FUNC_NAME,
|
SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (ls), alist, SCM_ARG2, FUNC_NAME,
|
||||||
|
|
|
@ -162,7 +162,7 @@ scm_async_click ()
|
||||||
for (asyncs = scm_root->signal_asyncs; !SCM_NULLP(asyncs);
|
for (asyncs = scm_root->signal_asyncs; !SCM_NULLP(asyncs);
|
||||||
asyncs = SCM_CDR (asyncs))
|
asyncs = SCM_CDR (asyncs))
|
||||||
{
|
{
|
||||||
if (!SCM_FALSEP (SCM_CAR (asyncs)))
|
if (scm_is_true (SCM_CAR (asyncs)))
|
||||||
{
|
{
|
||||||
SCM proc = SCM_CAR (asyncs);
|
SCM proc = SCM_CAR (asyncs);
|
||||||
SCM_SETCAR (asyncs, SCM_BOOL_F);
|
SCM_SETCAR (asyncs, SCM_BOOL_F);
|
||||||
|
|
|
@ -89,7 +89,7 @@ display_header (SCM source, SCM port)
|
||||||
else
|
else
|
||||||
scm_puts ("<unnamed port>", port);
|
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_putc (':', port);
|
||||||
scm_intprint (SCM_INUM (line) + 1, 10, port);
|
scm_intprint (SCM_INUM (line) + 1, 10, port);
|
||||||
|
@ -116,7 +116,7 @@ struct display_error_message_data {
|
||||||
static SCM
|
static SCM
|
||||||
display_error_message (struct display_error_message_data *d)
|
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);
|
scm_simple_format (d->port, d->message, d->args);
|
||||||
else
|
else
|
||||||
scm_display (d->message, d->port);
|
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);
|
current_frame = scm_stack_ref (a->stack, SCM_INUM0);
|
||||||
source = SCM_FRAME_SOURCE (current_frame);
|
source = SCM_FRAME_SOURCE (current_frame);
|
||||||
prev_frame = SCM_FRAME_PREV (current_frame);
|
prev_frame = SCM_FRAME_PREV (current_frame);
|
||||||
if (!SCM_MEMOIZEDP (source) && !SCM_FALSEP (prev_frame))
|
if (!SCM_MEMOIZEDP (source) && scm_is_true (prev_frame))
|
||||||
source = SCM_FRAME_SOURCE (prev_frame);
|
source = SCM_FRAME_SOURCE (prev_frame);
|
||||||
if (!SCM_SYMBOLP (pname) && !SCM_STRINGP (pname) && SCM_FRAME_PROC_P (current_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))
|
&& 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)
|
display_application (SCM frame, int indentation, SCM sport, SCM port, scm_print_state *pstate)
|
||||||
{
|
{
|
||||||
SCM proc = SCM_FRAME_PROC (frame);
|
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_procedure_name (proc)
|
||||||
: SCM_BOOL_F);
|
: SCM_BOOL_F);
|
||||||
display_frame_expr ("[",
|
display_frame_expr ("[",
|
||||||
scm_cons (!SCM_FALSEP (name) ? name : proc,
|
scm_cons (scm_is_true (name) ? name : proc,
|
||||||
SCM_FRAME_ARGS (frame)),
|
SCM_FRAME_ARGS (frame)),
|
||||||
SCM_FRAME_EVAL_ARGS_P (frame) ? " ..." : "]",
|
SCM_FRAME_EVAL_ARGS_P (frame) ? " ..." : "]",
|
||||||
indentation,
|
indentation,
|
||||||
|
@ -500,8 +500,8 @@ display_backtrace_file (frame, last_file, port, pstate)
|
||||||
*last_file = file;
|
*last_file = file;
|
||||||
|
|
||||||
scm_puts ("In ", port);
|
scm_puts ("In ", port);
|
||||||
if (SCM_FALSEP (file))
|
if (scm_is_false (file))
|
||||||
if (SCM_FALSEP (line))
|
if (scm_is_false (line))
|
||||||
scm_puts ("unknown file", port);
|
scm_puts ("unknown file", port);
|
||||||
else
|
else
|
||||||
scm_puts ("current input", port);
|
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_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);
|
scm_putc ('?', port);
|
||||||
else
|
else
|
||||||
scm_puts ("<stdin>", port);
|
scm_puts ("<stdin>", port);
|
||||||
|
@ -544,7 +544,7 @@ display_backtrace_file_and_line (SCM frame, SCM port, scm_print_state *pstate)
|
||||||
|
|
||||||
scm_putc (':', port);
|
scm_putc (':', port);
|
||||||
}
|
}
|
||||||
else if (!SCM_FALSEP (line))
|
else if (scm_is_true (line))
|
||||||
{
|
{
|
||||||
int i, j=0;
|
int i, j=0;
|
||||||
for (i = SCM_INUM (line)+1; i > 0; i = i/10, j++)
|
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);
|
indent (4-j, port);
|
||||||
}
|
}
|
||||||
|
|
||||||
if (SCM_FALSEP (line))
|
if (scm_is_false (line))
|
||||||
scm_puts (" ?", port);
|
scm_puts (" ?", port);
|
||||||
else
|
else
|
||||||
scm_intprint (SCM_INUM (line) + 1, 10, port);
|
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 */
|
/* 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);
|
display_backtrace_file_and_line (frame, port, pstate);
|
||||||
|
|
||||||
/* Check size of frame number. */
|
/* Check size of frame number. */
|
||||||
|
@ -772,7 +772,7 @@ SCM_DEFINE (scm_backtrace, "backtrace", 0, 0, 0,
|
||||||
{
|
{
|
||||||
SCM the_last_stack =
|
SCM the_last_stack =
|
||||||
scm_fluid_ref (SCM_VARIABLE_REF (scm_the_last_stack_fluid_var));
|
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_newline (scm_cur_outp);
|
||||||
scm_puts ("Backtrace:\n", 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_UNDEFINED);
|
SCM_UNDEFINED);
|
||||||
scm_newline (scm_cur_outp);
|
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_BACKTRACE_P)
|
||||||
{
|
{
|
||||||
scm_puts ("Type \"(debug-enable 'backtrace)\" if you would like "
|
scm_puts ("Type \"(debug-enable 'backtrace)\" if you would like "
|
||||||
|
|
|
@ -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}.")
|
"Return @code{#t} iff @var{x} is a character, else @code{#f}.")
|
||||||
#define FUNC_NAME s_scm_char_p
|
#define FUNC_NAME s_scm_char_p
|
||||||
{
|
{
|
||||||
return SCM_BOOL(SCM_CHARP(x));
|
return scm_from_bool (SCM_CHARP(x));
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#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 (1, x);
|
||||||
SCM_VALIDATE_CHAR (2, y);
|
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
|
#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 (1, x);
|
||||||
SCM_VALIDATE_CHAR (2, y);
|
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
|
#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 (1, x);
|
||||||
SCM_VALIDATE_CHAR (2, y);
|
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
|
#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 (1, x);
|
||||||
SCM_VALIDATE_CHAR (2, y);
|
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
|
#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 (1, x);
|
||||||
SCM_VALIDATE_CHAR (2, y);
|
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
|
#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 (1, x);
|
||||||
SCM_VALIDATE_CHAR (2, y);
|
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
|
#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 (1, x);
|
||||||
SCM_VALIDATE_CHAR (2, y);
|
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
|
#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 (1, x);
|
||||||
SCM_VALIDATE_CHAR (2, y);
|
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
|
#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 (1, x);
|
||||||
SCM_VALIDATE_CHAR (2, y);
|
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
|
#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 (1, x);
|
||||||
SCM_VALIDATE_CHAR (2, y);
|
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
|
#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
|
#define FUNC_NAME s_scm_char_alphabetic_p
|
||||||
{
|
{
|
||||||
SCM_VALIDATE_CHAR (1, chr);
|
SCM_VALIDATE_CHAR (1, chr);
|
||||||
return SCM_BOOL(isalpha(SCM_CHAR(chr)));
|
return scm_from_bool (isalpha(SCM_CHAR(chr)));
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#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
|
#define FUNC_NAME s_scm_char_numeric_p
|
||||||
{
|
{
|
||||||
SCM_VALIDATE_CHAR (1, chr);
|
SCM_VALIDATE_CHAR (1, chr);
|
||||||
return SCM_BOOL(isdigit(SCM_CHAR(chr)));
|
return scm_from_bool (isdigit(SCM_CHAR(chr)));
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#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
|
#define FUNC_NAME s_scm_char_whitespace_p
|
||||||
{
|
{
|
||||||
SCM_VALIDATE_CHAR (1, chr);
|
SCM_VALIDATE_CHAR (1, chr);
|
||||||
return SCM_BOOL(isspace(SCM_CHAR(chr)));
|
return scm_from_bool (isspace(SCM_CHAR(chr)));
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#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
|
#define FUNC_NAME s_scm_char_upper_case_p
|
||||||
{
|
{
|
||||||
SCM_VALIDATE_CHAR (1, chr);
|
SCM_VALIDATE_CHAR (1, chr);
|
||||||
return SCM_BOOL(isupper(SCM_CHAR(chr)));
|
return scm_from_bool (isupper(SCM_CHAR(chr)));
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#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
|
#define FUNC_NAME s_scm_char_lower_case_p
|
||||||
{
|
{
|
||||||
SCM_VALIDATE_CHAR (1, chr);
|
SCM_VALIDATE_CHAR (1, chr);
|
||||||
return SCM_BOOL(islower(SCM_CHAR(chr)));
|
return scm_from_bool (islower(SCM_CHAR(chr)));
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#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
|
#define FUNC_NAME s_scm_char_is_both_p
|
||||||
{
|
{
|
||||||
SCM_VALIDATE_CHAR (1, chr);
|
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
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
|
|
@ -10,15 +10,15 @@ SCM2CTYPES (SCM obj, CTYPE *data)
|
||||||
long i, n;
|
long i, n;
|
||||||
SCM val;
|
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);
|
obj, SCM_ARG1, FUNC_NAME);
|
||||||
|
|
||||||
/* list conversion */
|
/* 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 */
|
/* traverse the given list and validate the range of each member */
|
||||||
SCM list = obj;
|
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);
|
val = SCM_CAR (list);
|
||||||
#if SIZEOF_CTYPE && SIZEOF_CTYPE < SIZEOF_SCM_T_BITS
|
#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 */
|
/* traverse the list once more and convert each member */
|
||||||
list = obj;
|
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);
|
val = SCM_CAR (list);
|
||||||
if (SCM_INUMP (val))
|
if (SCM_INUMP (val))
|
||||||
|
|
|
@ -549,7 +549,7 @@ scm_call_with_new_thread (SCM argl)
|
||||||
if (!SCM_CONSP (args))
|
if (!SCM_CONSP (args))
|
||||||
SCM_WRONG_NUM_ARGS ();
|
SCM_WRONG_NUM_ARGS ();
|
||||||
thunk = SCM_CAR (args);
|
thunk = SCM_CAR (args);
|
||||||
SCM_ASSERT (SCM_NFALSEP (scm_thunk_p (thunk)),
|
SCM_ASSERT (scm_is_true (scm_thunk_p (thunk)),
|
||||||
thunk,
|
thunk,
|
||||||
SCM_ARG1,
|
SCM_ARG1,
|
||||||
s_call_with_new_thread);
|
s_call_with_new_thread);
|
||||||
|
@ -557,7 +557,7 @@ scm_call_with_new_thread (SCM argl)
|
||||||
if (!SCM_CONSP (args))
|
if (!SCM_CONSP (args))
|
||||||
SCM_WRONG_NUM_ARGS ();
|
SCM_WRONG_NUM_ARGS ();
|
||||||
handler = SCM_CAR (args);
|
handler = SCM_CAR (args);
|
||||||
SCM_ASSERT (SCM_NFALSEP (scm_procedure_p (handler)),
|
SCM_ASSERT (scm_is_true (scm_procedure_p (handler)),
|
||||||
handler,
|
handler,
|
||||||
SCM_ARG2,
|
SCM_ARG2,
|
||||||
s_call_with_new_thread);
|
s_call_with_new_thread);
|
||||||
|
@ -677,7 +677,7 @@ scm_unlock_mutex (SCM mx)
|
||||||
else
|
else
|
||||||
{
|
{
|
||||||
SCM next = dequeue (m->waiting);
|
SCM next = dequeue (m->waiting);
|
||||||
if (!SCM_FALSEP (next))
|
if (scm_is_true (next))
|
||||||
{
|
{
|
||||||
m->owner = next;
|
m->owner = next;
|
||||||
unblock (SCM_THREAD_DATA (next));
|
unblock (SCM_THREAD_DATA (next));
|
||||||
|
@ -763,7 +763,7 @@ scm_timed_wait_condition_variable (SCM cv, SCM mx, SCM t)
|
||||||
else
|
else
|
||||||
res = timed_block (&waittime);
|
res = timed_block (&waittime);
|
||||||
scm_lock_mutex (mx);
|
scm_lock_mutex (mx);
|
||||||
return SCM_BOOL (res);
|
return scm_from_bool (res);
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
@ -778,7 +778,7 @@ scm_signal_condition_variable (SCM cv)
|
||||||
SCM_ARG1,
|
SCM_ARG1,
|
||||||
s_signal_condition_variable);
|
s_signal_condition_variable);
|
||||||
c = SCM_CONDVAR_DATA (cv);
|
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));
|
unblock (SCM_THREAD_DATA (th));
|
||||||
return SCM_BOOL_T;
|
return SCM_BOOL_T;
|
||||||
}
|
}
|
||||||
|
@ -795,7 +795,7 @@ scm_broadcast_condition_variable (SCM cv)
|
||||||
SCM_ARG1,
|
SCM_ARG1,
|
||||||
s_signal_condition_variable);
|
s_signal_condition_variable);
|
||||||
c = SCM_CONDVAR_DATA (cv);
|
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));
|
unblock (SCM_THREAD_DATA (th));
|
||||||
return SCM_BOOL_T;
|
return SCM_BOOL_T;
|
||||||
}
|
}
|
||||||
|
|
|
@ -220,7 +220,7 @@ scm_call_with_new_thread (SCM argl)
|
||||||
if (!SCM_CONSP (args))
|
if (!SCM_CONSP (args))
|
||||||
SCM_WRONG_NUM_ARGS ();
|
SCM_WRONG_NUM_ARGS ();
|
||||||
thunk = SCM_CAR (args);
|
thunk = SCM_CAR (args);
|
||||||
SCM_ASSERT (SCM_NFALSEP (scm_thunk_p (thunk)),
|
SCM_ASSERT (scm_is_true (scm_thunk_p (thunk)),
|
||||||
thunk,
|
thunk,
|
||||||
SCM_ARG1,
|
SCM_ARG1,
|
||||||
s_call_with_new_thread);
|
s_call_with_new_thread);
|
||||||
|
@ -228,7 +228,7 @@ scm_call_with_new_thread (SCM argl)
|
||||||
if (!SCM_CONSP (args))
|
if (!SCM_CONSP (args))
|
||||||
SCM_WRONG_NUM_ARGS ();
|
SCM_WRONG_NUM_ARGS ();
|
||||||
handler = SCM_CAR (args);
|
handler = SCM_CAR (args);
|
||||||
SCM_ASSERT (SCM_NFALSEP (scm_procedure_p (handler)),
|
SCM_ASSERT (scm_is_true (scm_procedure_p (handler)),
|
||||||
handler,
|
handler,
|
||||||
SCM_ARG2,
|
SCM_ARG2,
|
||||||
s_call_with_new_thread);
|
s_call_with_new_thread);
|
||||||
|
@ -452,7 +452,7 @@ SCM
|
||||||
scm_try_mutex (SCM m)
|
scm_try_mutex (SCM m)
|
||||||
{
|
{
|
||||||
SCM_ASSERT (SCM_MUTEXP (m), m, SCM_ARG1, s_lock_mutex);
|
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
|
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);
|
SCM_VALIDATE_UINT_COPY (3, t, waittime.tv_sec);
|
||||||
waittime.tv_nsec = 0;
|
waittime.tv_nsec = 0;
|
||||||
}
|
}
|
||||||
return SCM_BOOL(
|
return scm_from_bool(
|
||||||
coop_condition_variable_timed_wait_mutex (cv, mx, &waittime));
|
coop_condition_variable_timed_wait_mutex (cv, mx, &waittime));
|
||||||
}
|
}
|
||||||
else
|
else
|
||||||
|
|
|
@ -134,7 +134,7 @@ SCM_DEFINE (scm_memoized_p, "memoized?", 1, 0, 0,
|
||||||
"Return @code{#t} if @var{obj} is memoized.")
|
"Return @code{#t} if @var{obj} is memoized.")
|
||||||
#define FUNC_NAME s_scm_memoized_p
|
#define FUNC_NAME s_scm_memoized_p
|
||||||
{
|
{
|
||||||
return SCM_BOOL(SCM_MEMOIZEDP (obj));
|
return scm_from_bool(SCM_MEMOIZEDP (obj));
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
@ -301,10 +301,10 @@ SCM_DEFINE (scm_procedure_name, "procedure-name", 1, 0, 0,
|
||||||
#if 0
|
#if 0
|
||||||
/* Source property scm_sym_procname not implemented yet... */
|
/* Source property scm_sym_procname not implemented yet... */
|
||||||
SCM name = scm_source_property (SCM_CAR (SCM_CLOSURE_BODY (proc)), scm_sym_procname);
|
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);
|
name = scm_procedure_property (proc, scm_sym_name);
|
||||||
#endif
|
#endif
|
||||||
if (SCM_FALSEP (name) && SCM_CLOSUREP (proc))
|
if (scm_is_false (name) && SCM_CLOSUREP (proc))
|
||||||
name = scm_reverse_lookup (SCM_ENV (proc), proc);
|
name = scm_reverse_lookup (SCM_ENV (proc), proc);
|
||||||
return name;
|
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 body = SCM_CLOSURE_BODY (proc);
|
||||||
const SCM src = scm_source_property (body, scm_sym_copy);
|
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);
|
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:
|
case scm_tc7_pws:
|
||||||
{
|
{
|
||||||
SCM src = scm_procedure_property (proc, scm_sym_source);
|
SCM src = scm_procedure_property (proc, scm_sym_source);
|
||||||
if (!SCM_FALSEP (src))
|
if (scm_is_true (src))
|
||||||
return src;
|
return src;
|
||||||
proc = SCM_PROCEDURE (proc);
|
proc = SCM_PROCEDURE (proc);
|
||||||
goto again;
|
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.")
|
"Return @code{#t} if @var{obj} is a debug object.")
|
||||||
#define FUNC_NAME s_scm_debug_object_p
|
#define FUNC_NAME s_scm_debug_object_p
|
||||||
{
|
{
|
||||||
return SCM_BOOL(SCM_DEBUGOBJP (obj));
|
return scm_from_bool(SCM_DEBUGOBJP (obj));
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
|
|
@ -68,11 +68,11 @@ SCM_API int scm_check_exit_p;
|
||||||
#define SCM_RESET_DEBUG_MODE \
|
#define SCM_RESET_DEBUG_MODE \
|
||||||
do {\
|
do {\
|
||||||
scm_check_entry_p = (SCM_ENTER_FRAME_P || SCM_BREAKPOINTS_P)\
|
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_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_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_debug_mode_p = SCM_DEVAL_P\
|
||||||
|| scm_check_entry_p || scm_check_apply_p || scm_check_exit_p;\
|
|| scm_check_entry_p || scm_check_apply_p || scm_check_exit_p;\
|
||||||
} while (0)
|
} while (0)
|
||||||
|
|
|
@ -429,7 +429,7 @@ scm_create_hook (const char *name, int n_args)
|
||||||
("'scm_create_hook' is deprecated. "
|
("'scm_create_hook' is deprecated. "
|
||||||
"Use 'scm_make_hook' and 'scm_c_define' instead.");
|
"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);
|
scm_c_define (name, hook);
|
||||||
return scm_permanent_object (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))
|
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;
|
||||||
}
|
}
|
||||||
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))
|
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;
|
||||||
}
|
}
|
||||||
return lst;
|
return lst;
|
||||||
|
@ -712,7 +712,7 @@ scm_sym2ovcell (SCM sym, SCM obarray)
|
||||||
"Use hashtables instead.");
|
"Use hashtables instead.");
|
||||||
|
|
||||||
answer = scm_sym2ovcell_soft (sym, obarray);
|
answer = scm_sym2ovcell_soft (sym, obarray);
|
||||||
if (!SCM_FALSEP (answer))
|
if (scm_is_true (answer))
|
||||||
return answer;
|
return answer;
|
||||||
SCM_MISC_ERROR ("uninterned symbol: ~S", scm_list_1 (sym));
|
SCM_MISC_ERROR ("uninterned symbol: ~S", scm_list_1 (sym));
|
||||||
return SCM_UNSPECIFIED; /* not reached */
|
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. "
|
scm_c_issue_deprecation_warning ("`scm_intern_obarray_soft' is deprecated. "
|
||||||
"Use hashtables instead.");
|
"Use hashtables instead.");
|
||||||
|
|
||||||
if (SCM_FALSEP (obarray))
|
if (scm_is_false (obarray))
|
||||||
{
|
{
|
||||||
if (softness)
|
if (softness)
|
||||||
return SCM_BOOL_F;
|
return SCM_BOOL_F;
|
||||||
|
@ -826,14 +826,14 @@ SCM_DEFINE (scm_string_to_obarray_symbol, "string->obarray-symbol", 2, 1, 0,
|
||||||
int softness;
|
int softness;
|
||||||
|
|
||||||
SCM_VALIDATE_STRING (2, s);
|
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. "
|
scm_c_issue_deprecation_warning ("`string->obarray-symbol' is deprecated. "
|
||||||
"Use hashtables instead.");
|
"Use hashtables instead.");
|
||||||
|
|
||||||
softness = (!SCM_UNBNDP (softp) && !SCM_FALSEP(softp));
|
softness = (!SCM_UNBNDP (softp) && scm_is_true(softp));
|
||||||
/* iron out some screwy calling conventions */
|
/* iron out some screwy calling conventions */
|
||||||
if (SCM_FALSEP (o))
|
if (scm_is_false (o))
|
||||||
{
|
{
|
||||||
/* nothing interesting to do here. */
|
/* nothing interesting to do here. */
|
||||||
return scm_string_to_symbol (s);
|
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),
|
SCM_STRING_LENGTH (s),
|
||||||
o,
|
o,
|
||||||
softness);
|
softness);
|
||||||
if (SCM_FALSEP (vcell))
|
if (scm_is_false (vcell))
|
||||||
return vcell;
|
return vcell;
|
||||||
answer = SCM_CAR (vcell);
|
answer = SCM_CAR (vcell);
|
||||||
return answer;
|
return answer;
|
||||||
|
@ -861,7 +861,7 @@ SCM_DEFINE (scm_intern_symbol, "intern-symbol", 2, 0, 0,
|
||||||
{
|
{
|
||||||
size_t hval;
|
size_t hval;
|
||||||
SCM_VALIDATE_SYMBOL (2,s);
|
SCM_VALIDATE_SYMBOL (2,s);
|
||||||
if (SCM_FALSEP (o))
|
if (scm_is_false (o))
|
||||||
return SCM_UNSPECIFIED;
|
return SCM_UNSPECIFIED;
|
||||||
|
|
||||||
scm_c_issue_deprecation_warning ("`intern-symbol' is deprecated. "
|
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.");
|
"Use hashtables instead.");
|
||||||
|
|
||||||
SCM_VALIDATE_SYMBOL (2,s);
|
SCM_VALIDATE_SYMBOL (2,s);
|
||||||
if (SCM_FALSEP (o))
|
if (scm_is_false (o))
|
||||||
return SCM_BOOL_F;
|
return SCM_BOOL_F;
|
||||||
SCM_VALIDATE_VECTOR (1,o);
|
SCM_VALIDATE_VECTOR (1,o);
|
||||||
hval = SCM_SYMBOL_HASH (s) % SCM_VECTOR_LENGTH (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))
|
if (SCM_EQ_P (SCM_CAR (sym), s))
|
||||||
{
|
{
|
||||||
/* Found the symbol to unintern. */
|
/* Found the symbol to unintern. */
|
||||||
if (SCM_FALSEP (lsym_follow))
|
if (scm_is_false (lsym_follow))
|
||||||
SCM_VECTOR_SET (o, hval, lsym);
|
SCM_VECTOR_SET (o, hval, lsym);
|
||||||
else
|
else
|
||||||
SCM_SETCDR (lsym_follow, SCM_CDR(lsym));
|
SCM_SETCDR (lsym_follow, SCM_CDR(lsym));
|
||||||
|
@ -952,7 +952,7 @@ SCM_DEFINE (scm_symbol_binding, "symbol-binding", 2, 0, 0,
|
||||||
"Use hashtables instead.");
|
"Use hashtables instead.");
|
||||||
|
|
||||||
SCM_VALIDATE_SYMBOL (2,s);
|
SCM_VALIDATE_SYMBOL (2,s);
|
||||||
if (SCM_FALSEP (o))
|
if (scm_is_false (o))
|
||||||
return scm_variable_ref (scm_lookup (s));
|
return scm_variable_ref (scm_lookup (s));
|
||||||
SCM_VALIDATE_VECTOR (1,o);
|
SCM_VALIDATE_VECTOR (1,o);
|
||||||
vcell = scm_sym2ovcell (s, o);
|
vcell = scm_sym2ovcell (s, o);
|
||||||
|
@ -973,7 +973,7 @@ SCM_DEFINE (scm_symbol_interned_p, "symbol-interned?", 2, 0, 0,
|
||||||
"Use hashtables instead.");
|
"Use hashtables instead.");
|
||||||
|
|
||||||
SCM_VALIDATE_SYMBOL (2,s);
|
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);
|
SCM var = scm_sym2var (s, SCM_BOOL_F, SCM_BOOL_F);
|
||||||
if (var != 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.");
|
"Use hashtables instead.");
|
||||||
|
|
||||||
SCM_VALIDATE_SYMBOL (2,s);
|
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);
|
SCM var = scm_sym2var (s, SCM_BOOL_F, SCM_BOOL_F);
|
||||||
if (SCM_VARIABLEP(var) && !SCM_UNBNDP(SCM_VARIABLE_REF(var)))
|
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);
|
SCM_VALIDATE_VECTOR (1,o);
|
||||||
vcell = scm_sym2ovcell_soft (s, 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
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
@ -1032,7 +1032,7 @@ SCM_DEFINE (scm_symbol_set_x, "symbol-set!", 3, 0, 0,
|
||||||
"Use the module system instead.");
|
"Use the module system instead.");
|
||||||
|
|
||||||
SCM_VALIDATE_SYMBOL (2,s);
|
SCM_VALIDATE_SYMBOL (2,s);
|
||||||
if (SCM_FALSEP (o))
|
if (scm_is_false (o))
|
||||||
{
|
{
|
||||||
scm_define (s, v);
|
scm_define (s, v);
|
||||||
return SCM_UNSPECIFIED;
|
return SCM_UNSPECIFIED;
|
||||||
|
@ -1089,7 +1089,7 @@ SCM_DEFINE (scm_gentemp, "gentemp", 0, 2, 0,
|
||||||
FUNC_NAME);
|
FUNC_NAME);
|
||||||
do
|
do
|
||||||
n_digits = scm_iint2str (gentemp_counter++, 10, &name[len]);
|
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,
|
len + n_digits,
|
||||||
obarray,
|
obarray,
|
||||||
1)));
|
1)));
|
||||||
|
@ -1105,6 +1105,16 @@ SCM_DEFINE (scm_gentemp, "gentemp", 0, 2, 0,
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#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
|
void
|
||||||
scm_i_init_deprecated ()
|
scm_i_init_deprecated ()
|
||||||
{
|
{
|
||||||
|
|
|
@ -142,7 +142,7 @@ SCM_DEFINE(scm_include_deprecated_features,
|
||||||
"in public interfaces.")
|
"in public interfaces.")
|
||||||
#define FUNC_NAME s_scm_include_deprecated_features
|
#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
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
|
|
@ -163,7 +163,7 @@ SCM_DEFINE (scm_dynamic_object_p, "dynamic-object?", 1, 0, 0,
|
||||||
"or @code{#f} otherwise.")
|
"or @code{#f} otherwise.")
|
||||||
#define FUNC_NAME s_scm_dynamic_object_p
|
#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
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
|
|
@ -98,7 +98,7 @@ SCM_DEFINE (scm_dynamic_wind, "dynamic-wind", 3, 0, 0,
|
||||||
#define FUNC_NAME s_scm_dynamic_wind
|
#define FUNC_NAME s_scm_dynamic_wind
|
||||||
{
|
{
|
||||||
SCM ans;
|
SCM ans;
|
||||||
SCM_ASSERT (SCM_NFALSEP (scm_thunk_p (out_guard)),
|
SCM_ASSERT (scm_is_true (scm_thunk_p (out_guard)),
|
||||||
out_guard,
|
out_guard,
|
||||||
SCM_ARG3, FUNC_NAME);
|
SCM_ARG3, FUNC_NAME);
|
||||||
scm_call_0 (in_guard);
|
scm_call_0 (in_guard);
|
||||||
|
|
|
@ -106,7 +106,7 @@ SCM_DEFINE (scm_environment_p, "environment?", 1, 0, 0,
|
||||||
"otherwise.")
|
"otherwise.")
|
||||||
#define FUNC_NAME s_scm_environment_p
|
#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
|
#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_ENVIRONMENT_P (env), env, SCM_ARG1, FUNC_NAME);
|
||||||
SCM_ASSERT (SCM_SYMBOLP (sym), sym, SCM_ARG2, 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
|
#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_ENVIRONMENT_P (env), env, SCM_ARG1, FUNC_NAME);
|
||||||
SCM_ASSERT (SCM_SYMBOLP (sym), sym, SCM_ARG2, 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))
|
if (!SCM_IMP (location))
|
||||||
return location;
|
return location;
|
||||||
else if (SCM_UNBNDP (location))
|
else if (SCM_UNBNDP (location))
|
||||||
|
@ -921,7 +921,7 @@ leaf_environment_undefine (SCM env, SCM sym)
|
||||||
SCM obarray = LEAF_ENVIRONMENT (env)->obarray;
|
SCM obarray = LEAF_ENVIRONMENT (env)->obarray;
|
||||||
SCM removed = obarray_remove (obarray, sym);
|
SCM removed = obarray_remove (obarray, sym);
|
||||||
|
|
||||||
if (!SCM_FALSEP (removed))
|
if (scm_is_true (removed))
|
||||||
core_environments_broadcast (env);
|
core_environments_broadcast (env);
|
||||||
|
|
||||||
return SCM_ENVIRONMENT_SUCCESS;
|
return SCM_ENVIRONMENT_SUCCESS;
|
||||||
|
@ -1037,7 +1037,7 @@ SCM_DEFINE (scm_leaf_environment_p, "leaf-environment?", 1, 0, 0,
|
||||||
"otherwise.")
|
"otherwise.")
|
||||||
#define FUNC_NAME s_scm_leaf_environment_p
|
#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
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
@ -1439,7 +1439,7 @@ SCM_DEFINE (scm_eval_environment_p, "eval-environment?", 1, 0, 0,
|
||||||
"otherwise.")
|
"otherwise.")
|
||||||
#define FUNC_NAME s_scm_eval_environment_p
|
#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
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
@ -1851,7 +1851,7 @@ SCM_DEFINE (scm_import_environment_p, "import-environment?", 1, 0, 0,
|
||||||
"@code{#f} otherwise.")
|
"@code{#f} otherwise.")
|
||||||
#define FUNC_NAME s_scm_import_environment_p
|
#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
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
@ -1946,7 +1946,7 @@ export_environment_ref (SCM env, SCM sym)
|
||||||
struct export_environment *body = EXPORT_ENVIRONMENT (env);
|
struct export_environment *body = EXPORT_ENVIRONMENT (env);
|
||||||
SCM entry = scm_assq (sym, body->signature);
|
SCM entry = scm_assq (sym, body->signature);
|
||||||
|
|
||||||
if (SCM_FALSEP (entry))
|
if (scm_is_false (entry))
|
||||||
return SCM_UNDEFINED;
|
return SCM_UNDEFINED;
|
||||||
else
|
else
|
||||||
return SCM_ENVIRONMENT_REF (body->private, sym);
|
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);
|
struct export_environment *body = EXPORT_ENVIRONMENT (env);
|
||||||
SCM entry = scm_assq (sym, body->signature);
|
SCM entry = scm_assq (sym, body->signature);
|
||||||
|
|
||||||
if (SCM_FALSEP (entry))
|
if (scm_is_false (entry))
|
||||||
{
|
{
|
||||||
return SCM_UNDEFINED;
|
return SCM_UNDEFINED;
|
||||||
}
|
}
|
||||||
|
@ -2021,7 +2021,7 @@ export_environment_cell (SCM env, SCM sym, int for_write)
|
||||||
struct export_environment *body = EXPORT_ENVIRONMENT (env);
|
struct export_environment *body = EXPORT_ENVIRONMENT (env);
|
||||||
SCM entry = scm_assq (sym, body->signature);
|
SCM entry = scm_assq (sym, body->signature);
|
||||||
|
|
||||||
if (SCM_FALSEP (entry))
|
if (scm_is_false (entry))
|
||||||
{
|
{
|
||||||
return SCM_UNDEFINED;
|
return SCM_UNDEFINED;
|
||||||
}
|
}
|
||||||
|
@ -2177,7 +2177,7 @@ SCM_DEFINE (scm_export_environment_p, "export-environment?", 1, 0, 0,
|
||||||
"@code{#f} otherwise.")
|
"@code{#f} otherwise.")
|
||||||
#define FUNC_NAME s_scm_export_environment_p
|
#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
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
|
|
@ -47,7 +47,7 @@ SCM_DEFINE1 (scm_eq_p, "eq?", scm_tc7_rpsubr,
|
||||||
"@code{eqv?}.")
|
"@code{eqv?}.")
|
||||||
#define FUNC_NAME s_scm_eq_p
|
#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
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
@ -90,12 +90,12 @@ SCM_PRIMITIVE_GENERIC_1 (scm_eqv_p, "eqv?", scm_tc7_rpsubr,
|
||||||
if (SCM_INEXACTP (x))
|
if (SCM_INEXACTP (x))
|
||||||
{
|
{
|
||||||
if (SCM_REALP (x))
|
if (SCM_REALP (x))
|
||||||
return SCM_BOOL (SCM_COMPLEXP (y)
|
return scm_from_bool (SCM_COMPLEXP (y)
|
||||||
&& real_eqv (SCM_REAL_VALUE (x),
|
&& real_eqv (SCM_REAL_VALUE (x),
|
||||||
SCM_COMPLEX_REAL (y))
|
SCM_COMPLEX_REAL (y))
|
||||||
&& SCM_COMPLEX_IMAG (y) == 0.0);
|
&& SCM_COMPLEX_IMAG (y) == 0.0);
|
||||||
else
|
else
|
||||||
return SCM_BOOL (SCM_REALP (y)
|
return scm_from_bool (SCM_REALP (y)
|
||||||
&& real_eqv (SCM_COMPLEX_REAL (x),
|
&& real_eqv (SCM_COMPLEX_REAL (x),
|
||||||
SCM_REAL_VALUE (y))
|
SCM_REAL_VALUE (y))
|
||||||
&& SCM_COMPLEX_IMAG (x) == 0.0);
|
&& 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_NUMP (x))
|
||||||
{
|
{
|
||||||
if (SCM_BIGP (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)) {
|
} 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)) {
|
} else if (SCM_FRACTIONP (x)) {
|
||||||
return scm_i_fraction_equalp (x, y);
|
return scm_i_fraction_equalp (x, y);
|
||||||
} else { /* complex */
|
} 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))
|
SCM_COMPLEX_REAL (y))
|
||||||
&& real_eqv (SCM_COMPLEX_IMAG (x),
|
&& real_eqv (SCM_COMPLEX_IMAG (x),
|
||||||
SCM_COMPLEX_IMAG (y)));
|
SCM_COMPLEX_IMAG (y)));
|
||||||
|
@ -149,7 +149,7 @@ SCM_PRIMITIVE_GENERIC_1 (scm_equal_p, "equal?", scm_tc7_rpsubr,
|
||||||
return SCM_BOOL_F;
|
return SCM_BOOL_F;
|
||||||
if (SCM_CONSP (x) && SCM_CONSP (y))
|
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;
|
return SCM_BOOL_F;
|
||||||
x = SCM_CDR(x);
|
x = SCM_CDR(x);
|
||||||
y = SCM_CDR(y);
|
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_INEXACTP (x) && SCM_INEXACTP (y))
|
||||||
{
|
{
|
||||||
if (SCM_REALP (x))
|
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_REAL_VALUE (x) == SCM_COMPLEX_REAL (y)
|
||||||
&& SCM_COMPLEX_IMAG (y) == 0.0);
|
&& SCM_COMPLEX_IMAG (y) == 0.0);
|
||||||
else
|
else
|
||||||
return SCM_BOOL (SCM_REALP (y)
|
return scm_from_bool (SCM_REALP (y)
|
||||||
&& SCM_COMPLEX_REAL (x) == SCM_REAL_VALUE (y)
|
&& SCM_COMPLEX_REAL (x) == SCM_REAL_VALUE (y)
|
||||||
&& SCM_COMPLEX_IMAG (x) == 0.0);
|
&& 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)))
|
else if ((SCM_FRACTIONP (x)) && (SCM_INEXACTP (y)))
|
||||||
{
|
{
|
||||||
if (SCM_REALP (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
|
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);
|
&& SCM_COMPLEX_IMAG (y) == 0.0);
|
||||||
}
|
}
|
||||||
else if ((SCM_FRACTIONP (y)) && (SCM_INEXACTP (x)))
|
else if ((SCM_FRACTIONP (y)) && (SCM_INEXACTP (x)))
|
||||||
{
|
{
|
||||||
if (SCM_REALP (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
|
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);
|
&& SCM_COMPLEX_IMAG (x) == 0.0);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -102,7 +102,7 @@ SCM_DEFINE (scm_error_scm, "scm-error", 5, 0, 0,
|
||||||
|
|
||||||
SCM_VALIDATE_SYMBOL (1, key);
|
SCM_VALIDATE_SYMBOL (1, key);
|
||||||
|
|
||||||
if (SCM_FALSEP (subr))
|
if (scm_is_false (subr))
|
||||||
{
|
{
|
||||||
szSubr = NULL;
|
szSubr = NULL;
|
||||||
}
|
}
|
||||||
|
@ -116,7 +116,7 @@ SCM_DEFINE (scm_error_scm, "scm-error", 5, 0, 0,
|
||||||
szSubr = SCM_STRING_CHARS (subr);
|
szSubr = SCM_STRING_CHARS (subr);
|
||||||
}
|
}
|
||||||
|
|
||||||
if (SCM_FALSEP (message))
|
if (scm_is_false (message))
|
||||||
{
|
{
|
||||||
szMessage = NULL;
|
szMessage = NULL;
|
||||||
}
|
}
|
||||||
|
@ -163,7 +163,7 @@ scm_syserror (const char *subr)
|
||||||
subr,
|
subr,
|
||||||
"~A",
|
"~A",
|
||||||
scm_cons (scm_makfrom0str (SCM_I_STRERROR (save_errno)), SCM_EOL),
|
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
|
void
|
||||||
|
@ -173,7 +173,7 @@ scm_syserror_msg (const char *subr, const char *message, SCM args, int eno)
|
||||||
subr,
|
subr,
|
||||||
message,
|
message,
|
||||||
args,
|
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");
|
SCM_GLOBAL_SYMBOL (scm_num_overflow_key, "numerical-overflow");
|
||||||
|
|
|
@ -266,7 +266,7 @@ syntax_error (const char* const msg, const SCM form, const SCM expr)
|
||||||
linenr = scm_source_property (form, scm_sym_line);
|
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);
|
filename = scm_source_property (expr, scm_sym_filename);
|
||||||
linenr = scm_source_property (expr, scm_sym_line);
|
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_UNBNDP (expr))
|
||||||
{
|
{
|
||||||
if (!SCM_FALSEP (filename))
|
if (scm_is_true (filename))
|
||||||
{
|
{
|
||||||
format = "In file ~S, line ~S: ~A ~S in expression ~S.";
|
format = "In file ~S, line ~S: ~A ~S in expression ~S.";
|
||||||
args = scm_list_5 (filename, linenr, msg_string, form, expr);
|
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.";
|
format = "In line ~S: ~A ~S in expression ~S.";
|
||||||
args = scm_list_4 (linenr, msg_string, form, expr);
|
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
|
else
|
||||||
{
|
{
|
||||||
if (!SCM_FALSEP (filename))
|
if (scm_is_true (filename))
|
||||||
{
|
{
|
||||||
format = "In file ~S, line ~S: ~A ~S.";
|
format = "In file ~S, line ~S: ~A ~S.";
|
||||||
args = scm_list_4 (filename, linenr, msg_string, form);
|
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.";
|
format = "In line ~S: ~A ~S.";
|
||||||
args = scm_list_3 (linenr, msg_string, form);
|
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);
|
SCM_VALIDATE_INUM (2, binding);
|
||||||
return SCM_MAKE_ILOC (SCM_INUM (frame),
|
return SCM_MAKE_ILOC (SCM_INUM (frame),
|
||||||
SCM_INUM (binding),
|
SCM_INUM (binding),
|
||||||
!SCM_FALSEP (cdrp));
|
scm_is_true (cdrp));
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#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.")
|
"Return @code{#t} if @var{obj} is an iloc.")
|
||||||
#define FUNC_NAME s_scm_dbg_iloc_p
|
#define FUNC_NAME s_scm_dbg_iloc_p
|
||||||
{
|
{
|
||||||
return SCM_BOOL (SCM_ILOCP (obj));
|
return scm_from_bool (SCM_ILOCP (obj));
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
@ -450,7 +450,7 @@ static SCM
|
||||||
lookup_global_symbol (const SCM symbol, const SCM top_level)
|
lookup_global_symbol (const SCM symbol, const SCM top_level)
|
||||||
{
|
{
|
||||||
const SCM variable = scm_sym2var (symbol, top_level, SCM_BOOL_F);
|
const SCM variable = scm_sym2var (symbol, top_level, SCM_BOOL_F);
|
||||||
if (SCM_FALSEP (variable))
|
if (scm_is_false (variable))
|
||||||
return SCM_UNDEFINED;
|
return SCM_UNDEFINED;
|
||||||
else
|
else
|
||||||
return variable;
|
return variable;
|
||||||
|
@ -555,7 +555,7 @@ unmemoize_expression (const SCM expr, const SCM env)
|
||||||
else if (SCM_VARIABLEP (expr))
|
else if (SCM_VARIABLEP (expr))
|
||||||
{
|
{
|
||||||
const SCM sym = scm_module_reverse_lookup (scm_env_module (env), 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))
|
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))
|
for (; !SCM_NULLP (all_labels); all_labels = SCM_CDR (all_labels))
|
||||||
{
|
{
|
||||||
const SCM label = SCM_CAR (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);
|
s_duplicate_case_label, label, expr);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -1207,7 +1207,7 @@ scm_m_define (SCM expr, SCM env)
|
||||||
tmp = SCM_MACRO_CODE (tmp);
|
tmp = SCM_MACRO_CODE (tmp);
|
||||||
if (SCM_CLOSUREP (tmp)
|
if (SCM_CLOSUREP (tmp)
|
||||||
/* Only the first definition determines the name. */
|
/* 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);
|
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 init = SCM_CADR (binding);
|
||||||
const SCM step = (length == 2) ? name : SCM_CADDR (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_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);
|
s_duplicate_binding, name, expr);
|
||||||
|
|
||||||
variables = scm_cons (name, variables);
|
variables = scm_cons (name, variables);
|
||||||
|
@ -1546,7 +1546,7 @@ transform_bindings (
|
||||||
const SCM binding = SCM_CAR (binding_idx);
|
const SCM binding = SCM_CAR (binding_idx);
|
||||||
const SCM cdr_binding = SCM_CDR (binding);
|
const SCM cdr_binding = SCM_CDR (binding);
|
||||||
const SCM name = SCM_CAR (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);
|
s_duplicate_binding, name, expr);
|
||||||
rvariables = scm_cons (name, rvariables);
|
rvariables = scm_cons (name, rvariables);
|
||||||
rinits = scm_cons (SCM_CAR (cdr_binding), rinits);
|
rinits = scm_cons (SCM_CAR (cdr_binding), rinits);
|
||||||
|
@ -2028,7 +2028,7 @@ scm_m_atbind (SCM expr, SCM env)
|
||||||
* while the second call wont. */
|
* while the second call wont. */
|
||||||
const SCM variable = SCM_CAR (variable_idx);
|
const SCM variable = SCM_CAR (variable_idx);
|
||||||
SCM new_variable = scm_sym2var (variable, top_level, SCM_BOOL_F);
|
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);
|
new_variable = scm_sym2var (variable, top_level, SCM_BOOL_T);
|
||||||
SCM_SETCAR (variable_idx, new_variable);
|
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 source_properties = scm_whash_lookup (scm_source_whash, expr);
|
||||||
const SCM um_expr = unmemoize_expression (expr, env);
|
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);
|
scm_whash_insert (scm_source_whash, um_expr, source_properties);
|
||||||
|
|
||||||
return um_expr;
|
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 source_properties = scm_whash_lookup (scm_source_whash, forms);
|
||||||
const SCM um_forms = unmemoize_exprs (forms, env);
|
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);
|
scm_whash_insert (scm_source_whash, um_forms, source_properties);
|
||||||
|
|
||||||
return um_forms;
|
return um_forms;
|
||||||
|
@ -2459,7 +2459,7 @@ scm_m_undefine (SCM expr, SCM env)
|
||||||
variable = SCM_CAR (cdr_expr);
|
variable = SCM_CAR (cdr_expr);
|
||||||
ASSERT_SYNTAX_2 (SCM_SYMBOLP (variable), s_bad_variable, variable, expr);
|
ASSERT_SYNTAX_2 (SCM_SYMBOLP (variable), s_bad_variable, variable, expr);
|
||||||
location = scm_sym2var (variable, scm_env_top_level (env), SCM_BOOL_F);
|
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)),
|
&& !SCM_UNBNDP (SCM_VARIABLE_REF (location)),
|
||||||
"variable already unbound ", variable, expr);
|
"variable already unbound ", variable, expr);
|
||||||
SCM_VARIABLE_SET (location, SCM_UNDEFINED);
|
SCM_VARIABLE_SET (location, SCM_UNDEFINED);
|
||||||
|
@ -2493,7 +2493,7 @@ scm_unmemocar (SCM form, SCM env)
|
||||||
if (SCM_VARIABLEP (c))
|
if (SCM_VARIABLEP (c))
|
||||||
{
|
{
|
||||||
SCM sym = scm_module_reverse_lookup (scm_env_module (env), 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;
|
sym = sym_three_question_marks;
|
||||||
SCM_SETCAR (form, sym);
|
SCM_SETCAR (form, sym);
|
||||||
}
|
}
|
||||||
|
@ -2812,7 +2812,7 @@ scm_lookupcar1 (SCM vloc, SCM genv, int check)
|
||||||
else
|
else
|
||||||
top_thunk = SCM_BOOL_F;
|
top_thunk = SCM_BOOL_F;
|
||||||
real_var = scm_sym2var (var, 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;
|
goto errout;
|
||||||
|
|
||||||
if (!SCM_NULLP (env) || SCM_UNBNDP (SCM_VARIABLE_REF (real_var)))
|
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 top_level = scm_env_top_level (environment);
|
||||||
const SCM variable = scm_sym2var (symbol, top_level, SCM_BOOL_F);
|
const SCM variable = scm_sym2var (symbol, top_level, SCM_BOOL_F);
|
||||||
|
|
||||||
if (SCM_FALSEP (variable))
|
if (scm_is_false (variable))
|
||||||
error_unbound_variable (symbol);
|
error_unbound_variable (symbol);
|
||||||
else
|
else
|
||||||
return variable;
|
return variable;
|
||||||
|
@ -2978,7 +2978,7 @@ do { \
|
||||||
if (scm_check_apply_p && SCM_TRAPS_P)\
|
if (scm_check_apply_p && SCM_TRAPS_P)\
|
||||||
if (SCM_APPLY_FRAME_P || (SCM_TRACE_P && PROCTRACEP (proc)))\
|
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_SET_TRACED_FRAME (debug); \
|
||||||
SCM_TRAPS_P = 0;\
|
SCM_TRAPS_P = 0;\
|
||||||
if (SCM_CHEAPTRAPS_P)\
|
if (SCM_CHEAPTRAPS_P)\
|
||||||
|
@ -3229,7 +3229,7 @@ start:
|
||||||
|| (SCM_BREAKPOINTS_P && scm_c_source_property_breakpoint_p (x)))
|
|| (SCM_BREAKPOINTS_P && scm_c_source_property_breakpoint_p (x)))
|
||||||
{
|
{
|
||||||
SCM stackrep;
|
SCM stackrep;
|
||||||
SCM tail = SCM_BOOL (SCM_TAILRECP (debug));
|
SCM tail = scm_from_bool (SCM_TAILRECP (debug));
|
||||||
SCM_SET_TAILREC (debug);
|
SCM_SET_TAILREC (debug);
|
||||||
if (SCM_CHEAPTRAPS_P)
|
if (SCM_CHEAPTRAPS_P)
|
||||||
stackrep = scm_make_debugobj (&debug);
|
stackrep = scm_make_debugobj (&debug);
|
||||||
|
@ -3272,7 +3272,7 @@ dispatch:
|
||||||
while (!SCM_NULLP (SCM_CDR (x)))
|
while (!SCM_NULLP (SCM_CDR (x)))
|
||||||
{
|
{
|
||||||
SCM test_result = EVALCAR (x, env);
|
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);
|
RETURN (SCM_BOOL_F);
|
||||||
else
|
else
|
||||||
x = SCM_CDR (x);
|
x = SCM_CDR (x);
|
||||||
|
@ -3368,7 +3368,7 @@ dispatch:
|
||||||
{
|
{
|
||||||
const SCM label = SCM_CAR (labels);
|
const SCM label = SCM_CAR (labels);
|
||||||
if (SCM_EQ_P (label, key)
|
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);
|
x = SCM_CDR (clause);
|
||||||
PREP_APPLY (SCM_UNDEFINED, SCM_EOL);
|
PREP_APPLY (SCM_UNDEFINED, SCM_EOL);
|
||||||
|
@ -3396,7 +3396,7 @@ dispatch:
|
||||||
else
|
else
|
||||||
{
|
{
|
||||||
arg1 = EVALCAR (clause, env);
|
arg1 = EVALCAR (clause, env);
|
||||||
if (!SCM_FALSEP (arg1) && !SCM_NILP (arg1))
|
if (scm_is_true (arg1) && !SCM_NILP (arg1))
|
||||||
{
|
{
|
||||||
x = SCM_CDR (clause);
|
x = SCM_CDR (clause);
|
||||||
if (SCM_NULLP (x))
|
if (SCM_NULLP (x))
|
||||||
|
@ -3443,7 +3443,7 @@ dispatch:
|
||||||
|
|
||||||
SCM test_result = EVALCAR (test_form, env);
|
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. */
|
/* Evaluate body forms. */
|
||||||
|
@ -3497,7 +3497,7 @@ dispatch:
|
||||||
{
|
{
|
||||||
SCM test_result = EVALCAR (x, env);
|
SCM test_result = EVALCAR (x, env);
|
||||||
x = SCM_CDR (x); /* then expression */
|
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 */
|
x = SCM_CDR (x); /* else expression */
|
||||||
if (SCM_NULLP (x))
|
if (SCM_NULLP (x))
|
||||||
|
@ -3572,7 +3572,7 @@ dispatch:
|
||||||
while (!SCM_NULLP (SCM_CDR (x)))
|
while (!SCM_NULLP (SCM_CDR (x)))
|
||||||
{
|
{
|
||||||
SCM val = EVALCAR (x, env);
|
SCM val = EVALCAR (x, env);
|
||||||
if (!SCM_FALSEP (val) && !SCM_NILP (val))
|
if (scm_is_true (val) && !SCM_NILP (val))
|
||||||
RETURN (val);
|
RETURN (val);
|
||||||
else
|
else
|
||||||
x = SCM_CDR (x);
|
x = SCM_CDR (x);
|
||||||
|
@ -3853,7 +3853,7 @@ dispatch:
|
||||||
while (!SCM_NULL_OR_NIL_P (x))
|
while (!SCM_NULL_OR_NIL_P (x))
|
||||||
{
|
{
|
||||||
SCM test_result = EVALCAR (test_form, env);
|
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)))
|
|| SCM_NULL_OR_NIL_P (test_result)))
|
||||||
{
|
{
|
||||||
if (SCM_EQ_P (SCM_CAR (x), SCM_UNSPECIFIED))
|
if (SCM_EQ_P (SCM_CAR (x), SCM_UNSPECIFIED))
|
||||||
|
@ -4409,12 +4409,12 @@ dispatch:
|
||||||
while (SCM_NIMP (arg2));
|
while (SCM_NIMP (arg2));
|
||||||
RETURN (arg1);
|
RETURN (arg1);
|
||||||
case scm_tc7_rpsubr:
|
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);
|
RETURN (SCM_BOOL_F);
|
||||||
arg1 = SCM_CDDR (debug.info->a.args);
|
arg1 = SCM_CDDR (debug.info->a.args);
|
||||||
do
|
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);
|
RETURN (SCM_BOOL_F);
|
||||||
arg2 = SCM_CAR (arg1);
|
arg2 = SCM_CAR (arg1);
|
||||||
arg1 = SCM_CDR (arg1);
|
arg1 = SCM_CDR (arg1);
|
||||||
|
@ -4471,12 +4471,12 @@ dispatch:
|
||||||
while (!SCM_NULLP (x));
|
while (!SCM_NULLP (x));
|
||||||
RETURN (arg1);
|
RETURN (arg1);
|
||||||
case scm_tc7_rpsubr:
|
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);
|
RETURN (SCM_BOOL_F);
|
||||||
do
|
do
|
||||||
{
|
{
|
||||||
arg1 = EVALCAR (x, env);
|
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);
|
RETURN (SCM_BOOL_F);
|
||||||
arg2 = arg1;
|
arg2 = arg1;
|
||||||
x = SCM_CDR (x);
|
x = SCM_CDR (x);
|
||||||
|
@ -4893,7 +4893,7 @@ tail:
|
||||||
while (SCM_NIMP (args))
|
while (SCM_NIMP (args))
|
||||||
{
|
{
|
||||||
SCM_ASSERT (SCM_CONSP (args), args, SCM_ARG2, "apply");
|
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);
|
RETURN (SCM_BOOL_F);
|
||||||
arg1 = SCM_CAR (args);
|
arg1 = SCM_CAR (args);
|
||||||
args = SCM_CDR (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}).")
|
"(@pxref{Delayed evaluation,,,r5rs.info,The Revised^5 Report on Scheme}).")
|
||||||
#define FUNC_NAME s_scm_promise_p
|
#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
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
@ -5645,7 +5645,7 @@ SCM_DEFINE (scm_cons_source, "cons-source", 3, 0, 0,
|
||||||
z = scm_cons (x, y);
|
z = scm_cons (x, y);
|
||||||
/* Copy source properties possibly associated with xorig. */
|
/* Copy source properties possibly associated with xorig. */
|
||||||
p = scm_whash_lookup (scm_source_whash, 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);
|
scm_whash_insert (scm_source_whash, z, p);
|
||||||
return z;
|
return z;
|
||||||
}
|
}
|
||||||
|
@ -5886,7 +5886,7 @@ SCM_DEFINE (scm_primitive_eval, "primitive-eval", 1, 0, 0,
|
||||||
{
|
{
|
||||||
SCM env;
|
SCM env;
|
||||||
SCM transformer = scm_current_module_transformer ();
|
SCM transformer = scm_current_module_transformer ();
|
||||||
if (!SCM_FALSEP (transformer))
|
if (scm_is_true (transformer))
|
||||||
exp = scm_call_1 (transformer, exp);
|
exp = scm_call_1 (transformer, exp);
|
||||||
env = scm_top_level_env (scm_current_module_lookup_closure ());
|
env = scm_top_level_env (scm_current_module_lookup_closure ());
|
||||||
return scm_i_eval (exp, env);
|
return scm_i_eval (exp, env);
|
||||||
|
|
|
@ -49,7 +49,7 @@ SCM_DEFINE (scm_defined_p, "defined?", 1, 1, 0,
|
||||||
{
|
{
|
||||||
SCM_ASSERT (SCM_CONSP (frames), env, SCM_ARG2, FUNC_NAME);
|
SCM_ASSERT (SCM_CONSP (frames), env, SCM_ARG2, FUNC_NAME);
|
||||||
b = SCM_CAR (frames);
|
b = SCM_CAR (frames);
|
||||||
if (!SCM_FALSEP (scm_procedure_p (b)))
|
if (scm_is_true (scm_procedure_p (b)))
|
||||||
break;
|
break;
|
||||||
SCM_ASSERT (SCM_CONSP (b), env, SCM_ARG2, FUNC_NAME);
|
SCM_ASSERT (SCM_CONSP (b), env, SCM_ARG2, FUNC_NAME);
|
||||||
for (b = SCM_CAR (b); SCM_NIMP (b); b = SCM_CDR (b))
|
for (b = SCM_CAR (b); SCM_NIMP (b); b = SCM_CDR (b))
|
||||||
|
@ -70,7 +70,7 @@ SCM_DEFINE (scm_defined_p, "defined?", 1, 1, 0,
|
||||||
SCM_BOOL_F);
|
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_F
|
||||||
: SCM_BOOL_T);
|
: SCM_BOOL_T);
|
||||||
}
|
}
|
||||||
|
@ -93,7 +93,7 @@ SCM_DEFINE (scm_self_evaluating_p, "self-evaluating?", 1, 0, 0,
|
||||||
return SCM_BOOL_T;
|
return SCM_BOOL_T;
|
||||||
case scm_tc3_imm24:
|
case scm_tc3_imm24:
|
||||||
/* characters, booleans, other immediates */
|
/* characters, booleans, other immediates */
|
||||||
return SCM_BOOL (!SCM_NULLP (obj));
|
return scm_from_bool (!SCM_NULLP (obj));
|
||||||
case scm_tc3_cons:
|
case scm_tc3_cons:
|
||||||
switch (SCM_TYP7 (obj))
|
switch (SCM_TYP7 (obj))
|
||||||
{
|
{
|
||||||
|
|
|
@ -388,7 +388,7 @@ SCM_DEFINE (scm_close, "close", 1, 0, 0,
|
||||||
not an error. */
|
not an error. */
|
||||||
if (rv < 0 && errno != EBADF)
|
if (rv < 0 && errno != EBADF)
|
||||||
SCM_SYSERROR;
|
SCM_SYSERROR;
|
||||||
return SCM_BOOL (rv >= 0);
|
return scm_from_bool (rv >= 0);
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
@ -785,7 +785,7 @@ SCM_DEFINE (scm_directory_stream_p, "directory-stream?", 1, 0, 0,
|
||||||
"stream as returned by @code{opendir}.")
|
"stream as returned by @code{opendir}.")
|
||||||
#define FUNC_NAME s_scm_directory_stream_p
|
#define FUNC_NAME s_scm_directory_stream_p
|
||||||
{
|
{
|
||||||
return SCM_BOOL (SCM_DIRP (obj));
|
return scm_from_bool (SCM_DIRP (obj));
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
@ -1209,7 +1209,7 @@ SCM_DEFINE (scm_select, "select", 3, 2, 0,
|
||||||
timeout.tv_usec = 0;
|
timeout.tv_usec = 0;
|
||||||
time_ptr = &timeout;
|
time_ptr = &timeout;
|
||||||
}
|
}
|
||||||
else if (SCM_UNBNDP (secs) || SCM_FALSEP (secs))
|
else if (SCM_UNBNDP (secs) || scm_is_false (secs))
|
||||||
time_ptr = 0;
|
time_ptr = 0;
|
||||||
else
|
else
|
||||||
{
|
{
|
||||||
|
|
|
@ -113,7 +113,7 @@ SCM_DEFINE (scm_fluid_p, "fluid?", 1, 0, 0,
|
||||||
"@code{#f}.")
|
"@code{#f}.")
|
||||||
#define FUNC_NAME s_scm_fluid_p
|
#define FUNC_NAME s_scm_fluid_p
|
||||||
{
|
{
|
||||||
return SCM_BOOL(SCM_FLUIDP (obj));
|
return scm_from_bool(SCM_FLUIDP (obj));
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
|
|
@ -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.")
|
"Determine whether @var{obj} is a port that is related to a file.")
|
||||||
#define FUNC_NAME s_scm_file_port_p
|
#define FUNC_NAME s_scm_file_port_p
|
||||||
{
|
{
|
||||||
return SCM_BOOL (SCM_FPORTP (obj));
|
return scm_from_bool (SCM_FPORTP (obj));
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
|
|
@ -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.")
|
"@code{SCM_DEBUG_CELL_ACCESSES} was set to 1.")
|
||||||
#define FUNC_NAME s_scm_set_debug_cell_accesses_x
|
#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;
|
scm_debug_cell_accesses_p = 0;
|
||||||
}
|
}
|
||||||
|
@ -745,7 +745,7 @@ scm_gc_unprotect_object (SCM obj)
|
||||||
|
|
||||||
handle = scm_hashq_get_handle (scm_protects, 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");
|
fprintf (stderr, "scm_unprotect_object called on unprotected object\n");
|
||||||
abort ();
|
abort ();
|
||||||
|
@ -791,7 +791,7 @@ scm_gc_unregister_root (SCM *p)
|
||||||
|
|
||||||
handle = scm_hashv_get_handle (scm_gc_registered_roots, key);
|
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");
|
fprintf (stderr, "scm_gc_unregister_root called on unregistered root\n");
|
||||||
abort ();
|
abort ();
|
||||||
|
|
|
@ -31,7 +31,7 @@
|
||||||
SCM
|
SCM
|
||||||
gh_bool2scm (int x)
|
gh_bool2scm (int x)
|
||||||
{
|
{
|
||||||
return SCM_BOOL(x);
|
return scm_from_bool(x);
|
||||||
}
|
}
|
||||||
SCM
|
SCM
|
||||||
gh_int2scm (int x)
|
gh_int2scm (int x)
|
||||||
|
@ -182,7 +182,7 @@ gh_doubles2dvect (const double *d, long n)
|
||||||
int
|
int
|
||||||
gh_scm2bool (SCM obj)
|
gh_scm2bool (SCM obj)
|
||||||
{
|
{
|
||||||
return (SCM_FALSEP (obj)) ? 0 : 1;
|
return (scm_is_false (obj)) ? 0 : 1;
|
||||||
}
|
}
|
||||||
unsigned long
|
unsigned long
|
||||||
gh_scm2ulong (SCM obj)
|
gh_scm2ulong (SCM obj)
|
||||||
|
|
|
@ -24,74 +24,74 @@
|
||||||
int
|
int
|
||||||
gh_boolean_p (SCM val)
|
gh_boolean_p (SCM val)
|
||||||
{
|
{
|
||||||
return (SCM_NFALSEP (scm_boolean_p (val)));
|
return (scm_is_true (scm_boolean_p (val)));
|
||||||
}
|
}
|
||||||
int
|
int
|
||||||
gh_symbol_p (SCM val)
|
gh_symbol_p (SCM val)
|
||||||
{
|
{
|
||||||
return (SCM_NFALSEP (scm_symbol_p (val)));
|
return (scm_is_true (scm_symbol_p (val)));
|
||||||
}
|
}
|
||||||
int
|
int
|
||||||
gh_char_p (SCM val)
|
gh_char_p (SCM val)
|
||||||
{
|
{
|
||||||
return (SCM_NFALSEP (scm_char_p (val)));
|
return (scm_is_true (scm_char_p (val)));
|
||||||
}
|
}
|
||||||
int
|
int
|
||||||
gh_vector_p (SCM val)
|
gh_vector_p (SCM val)
|
||||||
{
|
{
|
||||||
return (SCM_NFALSEP (scm_vector_p (val)));
|
return (scm_is_true (scm_vector_p (val)));
|
||||||
}
|
}
|
||||||
int
|
int
|
||||||
gh_pair_p (SCM val)
|
gh_pair_p (SCM val)
|
||||||
{
|
{
|
||||||
return (SCM_NFALSEP (scm_pair_p (val)));
|
return (scm_is_true (scm_pair_p (val)));
|
||||||
}
|
}
|
||||||
int
|
int
|
||||||
gh_number_p (SCM val)
|
gh_number_p (SCM val)
|
||||||
{
|
{
|
||||||
return (SCM_NFALSEP (scm_number_p (val)));
|
return (scm_is_true (scm_number_p (val)));
|
||||||
}
|
}
|
||||||
int
|
int
|
||||||
gh_string_p (SCM val)
|
gh_string_p (SCM val)
|
||||||
{
|
{
|
||||||
return (SCM_NFALSEP (scm_string_p (val)));
|
return (scm_is_true (scm_string_p (val)));
|
||||||
}
|
}
|
||||||
int
|
int
|
||||||
gh_procedure_p (SCM val)
|
gh_procedure_p (SCM val)
|
||||||
{
|
{
|
||||||
return (SCM_NFALSEP (scm_procedure_p (val)));
|
return (scm_is_true (scm_procedure_p (val)));
|
||||||
}
|
}
|
||||||
int
|
int
|
||||||
gh_list_p (SCM val)
|
gh_list_p (SCM val)
|
||||||
{
|
{
|
||||||
return (SCM_NFALSEP (scm_list_p (val)));
|
return (scm_is_true (scm_list_p (val)));
|
||||||
}
|
}
|
||||||
int
|
int
|
||||||
gh_inexact_p (SCM val)
|
gh_inexact_p (SCM val)
|
||||||
{
|
{
|
||||||
return (SCM_NFALSEP (scm_inexact_p (val)));
|
return (scm_is_true (scm_inexact_p (val)));
|
||||||
}
|
}
|
||||||
int
|
int
|
||||||
gh_exact_p (SCM val)
|
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 */
|
/* the three types of equality */
|
||||||
int
|
int
|
||||||
gh_eq_p (SCM x, SCM y)
|
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
|
int
|
||||||
gh_eqv_p (SCM x, SCM y)
|
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
|
int
|
||||||
gh_equal_p (SCM x, SCM y)
|
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
|
/* equivalent to (string=? ...), but returns 0 or 1 rather than Scheme
|
||||||
|
@ -99,7 +99,7 @@ gh_equal_p (SCM x, SCM y)
|
||||||
int
|
int
|
||||||
gh_string_equal_p(SCM s1, SCM s2)
|
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
|
/* equivalent to (null? ...), but returns 0 or 1 rather than Scheme
|
||||||
|
@ -107,7 +107,7 @@ gh_string_equal_p(SCM s1, SCM s2)
|
||||||
int
|
int
|
||||||
gh_null_p(SCM l)
|
gh_null_p(SCM l)
|
||||||
{
|
{
|
||||||
return (SCM_NFALSEP(scm_null_p(l)));
|
return (scm_is_true(scm_null_p(l)));
|
||||||
}
|
}
|
||||||
|
|
||||||
/*
|
/*
|
||||||
|
|
|
@ -95,7 +95,7 @@
|
||||||
#define TEST_CHANGE_CLASS(obj, class) \
|
#define TEST_CHANGE_CLASS(obj, class) \
|
||||||
{ \
|
{ \
|
||||||
class = SCM_CLASS_OF (obj); \
|
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));\
|
scm_change_object_class (obj, class, SCM_OBJ_CLASS_REDEF (obj));\
|
||||||
class = SCM_CLASS_OF (obj); \
|
class = SCM_CLASS_OF (obj); \
|
||||||
|
@ -182,7 +182,7 @@ filter_cpl (SCM ls)
|
||||||
while (!SCM_NULLP (ls))
|
while (!SCM_NULLP (ls))
|
||||||
{
|
{
|
||||||
SCM el = SCM_CAR (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);
|
res = scm_cons (el, res);
|
||||||
ls = SCM_CDR (ls);
|
ls = SCM_CDR (ls);
|
||||||
}
|
}
|
||||||
|
@ -221,7 +221,7 @@ remove_duplicate_slots (SCM l, SCM res, SCM slots_already_seen)
|
||||||
if (!SCM_SYMBOLP (tmp))
|
if (!SCM_SYMBOLP (tmp))
|
||||||
scm_misc_error ("%compute-slots", "bad slot name ~S", scm_list_1 (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);
|
res = scm_cons (SCM_CAR (l), res);
|
||||||
slots_already_seen = scm_cons (tmp, slots_already_seen);
|
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 */
|
/* set slot to its :init-form if it exists */
|
||||||
tmp = SCM_CADAR (get_n_set);
|
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));
|
slot_value = get_slot_value (class, obj, SCM_CAR (get_n_set));
|
||||||
if (SCM_GOOPS_UNBOUNDP (slot_value))
|
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),
|
type = scm_i_get_keyword (k_class, SCM_CDAR (slots),
|
||||||
len, SCM_BOOL_F, FUNC_NAME);
|
len, SCM_BOOL_F, FUNC_NAME);
|
||||||
/* determine slot GC protection and access mode */
|
/* determine slot GC protection and access mode */
|
||||||
if (SCM_FALSEP (type))
|
if (scm_is_false (type))
|
||||||
{
|
{
|
||||||
p = 'p';
|
p = 'p';
|
||||||
a = 'w';
|
a = 'w';
|
||||||
|
@ -822,7 +822,7 @@ SCM_DEFINE (scm_instance_p, "instance?", 1, 0, 0,
|
||||||
"Return @code{#t} if @var{obj} is an instance.")
|
"Return @code{#t} if @var{obj} is an instance.")
|
||||||
#define FUNC_NAME s_scm_instance_p
|
#define FUNC_NAME s_scm_instance_p
|
||||||
{
|
{
|
||||||
return SCM_BOOL (SCM_INSTANCEP (obj));
|
return scm_from_bool (SCM_INSTANCEP (obj));
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
@ -1160,7 +1160,7 @@ static SCM
|
||||||
get_slot_value_using_name (SCM class, SCM obj, SCM slot_name)
|
get_slot_value_using_name (SCM class, SCM obj, SCM slot_name)
|
||||||
{
|
{
|
||||||
SCM slotdef = slot_definition_using_name (class, 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);
|
return get_slot_value (class, obj, slotdef);
|
||||||
else
|
else
|
||||||
return CALL_GF3 ("slot-missing", class, obj, slot_name);
|
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)
|
set_slot_value_using_name (SCM class, SCM obj, SCM slot_name, SCM value)
|
||||||
{
|
{
|
||||||
SCM slotdef = slot_definition_using_name (class, slot_name);
|
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);
|
return set_slot_value (class, obj, slotdef, value);
|
||||||
else
|
else
|
||||||
return CALL_GF4 ("slot-missing", class, obj, slot_name, value);
|
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 used_by;
|
||||||
SCM_ASSERT (SCM_PUREGENERICP (gf), gf, SCM_ARG1, FUNC_NAME);
|
SCM_ASSERT (SCM_PUREGENERICP (gf), gf, SCM_ARG1, FUNC_NAME);
|
||||||
used_by = SCM_SLOT (gf, scm_si_used_by);
|
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);
|
SCM methods = SCM_SLOT (gf, scm_si_methods);
|
||||||
for (; SCM_CONSP (used_by); used_by = SCM_CDR (used_by))
|
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
|
#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);
|
proc, SCM_ARG1, FUNC_NAME);
|
||||||
return (scm_subr_p (proc) && SCM_SUBR_GENERIC (proc)
|
return (scm_subr_p (proc) && SCM_SUBR_GENERIC (proc)
|
||||||
? SCM_BOOL_T
|
? SCM_BOOL_T
|
||||||
|
@ -1792,7 +1792,7 @@ static int
|
||||||
applicablep (SCM actual, SCM formal)
|
applicablep (SCM actual, SCM formal)
|
||||||
{
|
{
|
||||||
/* We already know that the cpl is well formed. */
|
/* 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
|
static int
|
||||||
|
@ -2035,7 +2035,7 @@ call_memoize_method (void *a)
|
||||||
* the cache miss and locking the mutex.
|
* the cache miss and locking the mutex.
|
||||||
*/
|
*/
|
||||||
SCM cmethod = scm_mcache_lookup_cmethod (x, SCM_CDDR (args));
|
SCM cmethod = scm_mcache_lookup_cmethod (x, SCM_CDDR (args));
|
||||||
if (!SCM_FALSEP (cmethod))
|
if (scm_is_true (cmethod))
|
||||||
return cmethod;
|
return cmethod;
|
||||||
/*fixme* Use scm_apply */
|
/*fixme* Use scm_apply */
|
||||||
return CALL_GF3 ("memoize-method!", gf, SCM_CDDR (args), x);
|
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)
|
if (class == scm_class_accessor)
|
||||||
{
|
{
|
||||||
SCM setter = scm_get_keyword (k_setter, args, SCM_BOOL_F);
|
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);
|
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 cpl = SCM_SLOT (c, scm_si_cpl);
|
||||||
SCM ls = scm_c_memq (after, cpl);
|
SCM ls = scm_c_memq (after, cpl);
|
||||||
SCM tail = scm_delq1_x (before, SCM_CDR (ls));
|
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 */
|
/* if this condition occurs, fix_cpl should not be applied this way */
|
||||||
abort ();
|
abort ();
|
||||||
SCM_SETCAR (ls, before);
|
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. */
|
/* Only define name if doesn't already exist. */
|
||||||
if (!SCM_GOOPS_UNBOUNDP (name)
|
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);
|
DEFVAR (name, class);
|
||||||
return class;
|
return class;
|
||||||
}
|
}
|
||||||
|
@ -2490,7 +2490,7 @@ scm_i_inherit_applicable (SCM c)
|
||||||
SCM cpl = SCM_SLOT (c, scm_si_cpl);
|
SCM cpl = SCM_SLOT (c, scm_si_cpl);
|
||||||
/* patch scm_class_applicable into direct-supers */
|
/* patch scm_class_applicable into direct-supers */
|
||||||
SCM top = scm_c_memq (scm_class_top, dsupers);
|
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,
|
dsupers = scm_append (scm_list_2 (dsupers,
|
||||||
scm_list_1 (scm_class_applicable)));
|
scm_list_1 (scm_class_applicable)));
|
||||||
else
|
else
|
||||||
|
@ -2501,7 +2501,7 @@ scm_i_inherit_applicable (SCM c)
|
||||||
SCM_SET_SLOT (c, scm_si_direct_supers, dsupers);
|
SCM_SET_SLOT (c, scm_si_direct_supers, dsupers);
|
||||||
/* patch scm_class_applicable into cpl */
|
/* patch scm_class_applicable into cpl */
|
||||||
top = scm_c_memq (scm_class_top, cpl);
|
top = scm_c_memq (scm_class_top, cpl);
|
||||||
if (SCM_FALSEP (top))
|
if (scm_is_false (top))
|
||||||
abort ();
|
abort ();
|
||||||
else
|
else
|
||||||
{
|
{
|
||||||
|
@ -2578,7 +2578,7 @@ static SCM
|
||||||
make_struct_class (void *closure SCM_UNUSED,
|
make_struct_class (void *closure SCM_UNUSED,
|
||||||
SCM vtable, SCM data, SCM prev 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_SET_STRUCT_TABLE_CLASS (data,
|
||||||
scm_make_extended_class
|
scm_make_extended_class
|
||||||
(SCM_SYMBOL_CHARS (SCM_STRUCT_TABLE_NAME (data)),
|
(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.")
|
"Return @code{#t} if @var{obj} is a pure generic.")
|
||||||
#define FUNC_NAME s_scm_pure_generic_p
|
#define FUNC_NAME s_scm_pure_generic_p
|
||||||
{
|
{
|
||||||
return SCM_BOOL (SCM_PUREGENERICP (obj));
|
return scm_from_bool (SCM_PUREGENERICP (obj));
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
|
|
@ -122,7 +122,7 @@ typedef struct scm_t_method {
|
||||||
#define SCM_INSTANCE_HASH(c, i) (SCM_INST (c) [scm_si_hashsets + (i)])
|
#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_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) \
|
#define SCM_IS_A_P(x, c) \
|
||||||
(SCM_INSTANCEP (x) && SCM_SUBCLASSP (SCM_CLASS_OF (x), c))
|
(SCM_INSTANCEP (x) && SCM_SUBCLASSP (SCM_CLASS_OF (x), c))
|
||||||
|
|
||||||
|
|
|
@ -209,7 +209,7 @@ guardian_apply (SCM guardian, SCM obj, SCM throw_p)
|
||||||
return scm_guard (guardian, obj,
|
return scm_guard (guardian, obj,
|
||||||
(SCM_UNBNDP (throw_p)
|
(SCM_UNBNDP (throw_p)
|
||||||
? 1
|
? 1
|
||||||
: !SCM_FALSEP (throw_p)));
|
: scm_is_true (throw_p)));
|
||||||
else
|
else
|
||||||
return scm_get_one_zombie (guardian);
|
return scm_get_one_zombie (guardian);
|
||||||
}
|
}
|
||||||
|
@ -229,7 +229,7 @@ scm_guard (SCM guardian, SCM obj, int throw_p)
|
||||||
|
|
||||||
if (GREEDY_P (g))
|
if (GREEDY_P (g))
|
||||||
{
|
{
|
||||||
if (!SCM_FALSEP (scm_hashq_get_handle
|
if (scm_is_true (scm_hashq_get_handle
|
||||||
(greedily_guarded_whash, obj)))
|
(greedily_guarded_whash, obj)))
|
||||||
{
|
{
|
||||||
SCM_ALLOW_INTS;
|
SCM_ALLOW_INTS;
|
||||||
|
@ -268,7 +268,7 @@ scm_get_one_zombie (SCM guardian)
|
||||||
if (!TCONC_EMPTYP (g->zombies))
|
if (!TCONC_EMPTYP (g->zombies))
|
||||||
TCONC_OUT (g->zombies, res);
|
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_hashq_remove_x (greedily_guarded_whash, res);
|
||||||
|
|
||||||
SCM_ALLOW_INTS;
|
SCM_ALLOW_INTS;
|
||||||
|
@ -319,7 +319,7 @@ SCM_DEFINE (scm_make_guardian, "make-guardian", 0, 1, 0,
|
||||||
g->flags = 0L;
|
g->flags = 0L;
|
||||||
|
|
||||||
/* [cmm] the UNBNDP check below is redundant but I like it. */
|
/* [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);
|
SET_GREEDY (g);
|
||||||
|
|
||||||
SCM_NEWSMOB (z, tc16_guardian, 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. */
|
/* This critical section barrier will be replaced by a mutex. */
|
||||||
SCM_DEFER_INTS;
|
SCM_DEFER_INTS;
|
||||||
|
|
||||||
res = SCM_BOOL (DESTROYED_P (GUARDIAN_DATA (guardian)));
|
res = scm_from_bool (DESTROYED_P (GUARDIAN_DATA (guardian)));
|
||||||
|
|
||||||
SCM_ALLOW_INTS;
|
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}.")
|
"Return @code{#t} if @var{guardian} is a greedy guardian, otherwise @code{#f}.")
|
||||||
#define FUNC_NAME s_scm_guardian_greedy_p
|
#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
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
|
|
@ -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.")
|
"Return @code{#t} if @var{obj} is a hash table.")
|
||||||
#define FUNC_NAME s_scm_hash_table_p
|
#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
|
#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.")
|
"nor a weak value hash table.")
|
||||||
#define FUNC_NAME s_scm_weak_key_hash_table_p
|
#define FUNC_NAME s_scm_weak_key_hash_table_p
|
||||||
{
|
{
|
||||||
return SCM_BOOL (SCM_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
|
#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.")
|
"Return @code{#t} if @var{obj} is a weak value hash table.")
|
||||||
#define FUNC_NAME s_scm_weak_value_hash_table_p
|
#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
|
#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.")
|
"Return @code{#t} if @var{obj} is a doubly weak hash table.")
|
||||||
#define FUNC_NAME s_scm_doubly_weak_hash_table_p
|
#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
|
#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))
|
if (k >= SCM_VECTOR_LENGTH (buckets))
|
||||||
scm_out_of_range ("hash_fn_create_handle_x", scm_ulong2num (k));
|
scm_out_of_range ("hash_fn_create_handle_x", scm_ulong2num (k));
|
||||||
it = assoc_fn (obj, SCM_VELTS (buckets)[k], closure);
|
it = assoc_fn (obj, SCM_VELTS (buckets)[k], closure);
|
||||||
if (!SCM_FALSEP (it))
|
if (scm_is_true (it))
|
||||||
return it;
|
return it;
|
||||||
else
|
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))
|
if (k >= SCM_VECTOR_LENGTH (buckets))
|
||||||
scm_out_of_range ("hash_fn_remove_x", scm_ulong2num (k));
|
scm_out_of_range ("hash_fn_remove_x", scm_ulong2num (k));
|
||||||
h = assoc_fn (obj, SCM_VELTS (buckets)[k], closure);
|
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]));
|
SCM_VECTOR_SET (buckets, k, delete_fn (h, SCM_VELTS (buckets)[k]));
|
||||||
if (table != buckets)
|
if (table != buckets)
|
||||||
|
|
|
@ -136,7 +136,7 @@ hook_print (SCM hook, SCM port, scm_print_state *pstate)
|
||||||
{
|
{
|
||||||
scm_putc (' ', port);
|
scm_putc (' ', port);
|
||||||
name = scm_procedure_name (SCM_CAR (ls));
|
name = scm_procedure_name (SCM_CAR (ls));
|
||||||
if (!SCM_FALSEP (name))
|
if (scm_is_true (name))
|
||||||
scm_iprin1 (name, port, pstate);
|
scm_iprin1 (name, port, pstate);
|
||||||
else
|
else
|
||||||
scm_putc ('?', port);
|
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.")
|
"Return @code{#t} if @var{x} is a hook, @code{#f} otherwise.")
|
||||||
#define FUNC_NAME s_scm_hook_p
|
#define FUNC_NAME s_scm_hook_p
|
||||||
{
|
{
|
||||||
return SCM_BOOL (SCM_HOOKP (x));
|
return scm_from_bool (SCM_HOOKP (x));
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#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
|
#define FUNC_NAME s_scm_hook_empty_p
|
||||||
{
|
{
|
||||||
SCM_VALIDATE_HOOK (1, hook);
|
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
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
@ -205,17 +205,17 @@ SCM_DEFINE (scm_add_hook_x, "add-hook!", 2, 1, 0,
|
||||||
SCM arity, rest;
|
SCM arity, rest;
|
||||||
int n_args;
|
int n_args;
|
||||||
SCM_VALIDATE_HOOK (1, hook);
|
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);
|
proc, SCM_ARG2, FUNC_NAME);
|
||||||
n_args = SCM_HOOK_ARITY (hook);
|
n_args = SCM_HOOK_ARITY (hook);
|
||||||
if (SCM_INUM (SCM_CAR (arity)) > n_args
|
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))
|
&& (SCM_INUM (SCM_CAR (arity)) + SCM_INUM (SCM_CADR (arity))
|
||||||
< n_args)))
|
< n_args)))
|
||||||
scm_wrong_type_arg (FUNC_NAME, 2, proc);
|
scm_wrong_type_arg (FUNC_NAME, 2, proc);
|
||||||
rest = scm_delq_x (proc, SCM_HOOK_PROCEDURES (hook));
|
rest = scm_delq_x (proc, SCM_HOOK_PROCEDURES (hook));
|
||||||
SCM_SET_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_append_x (scm_list_2 (rest, scm_list_1 (proc)))
|
||||||
: scm_cons (proc, rest)));
|
: scm_cons (proc, rest)));
|
||||||
return SCM_UNSPECIFIED;
|
return SCM_UNSPECIFIED;
|
||||||
|
|
|
@ -256,7 +256,7 @@ scm_standard_stream_to_port (int fdes, char *mode, char *name)
|
||||||
body_data.name = name;
|
body_data.name = name;
|
||||||
port = scm_internal_catch (SCM_BOOL_T, stream_body, &body_data,
|
port = scm_internal_catch (SCM_BOOL_T, stream_body, &body_data,
|
||||||
stream_handler, NULL);
|
stream_handler, NULL);
|
||||||
if (SCM_FALSEP (port))
|
if (scm_is_false (port))
|
||||||
port = scm_void_port (mode);
|
port = scm_void_port (mode);
|
||||||
return port;
|
return port;
|
||||||
}
|
}
|
||||||
|
@ -316,7 +316,7 @@ scm_load_startup_files ()
|
||||||
scm_primitive_load_path (scm_makfrom0str ("ice-9/boot-9.scm"));
|
scm_primitive_load_path (scm_makfrom0str ("ice-9/boot-9.scm"));
|
||||||
|
|
||||||
/* Load the init.scm file. */
|
/* Load the init.scm file. */
|
||||||
if (SCM_NFALSEP (init_path))
|
if (scm_is_true (init_path))
|
||||||
scm_primitive_load (init_path);
|
scm_primitive_load (init_path);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
|
@ -204,7 +204,7 @@ SCM_DEFINE (scm_isatty_p, "isatty?", 1, 0, 0,
|
||||||
return SCM_BOOL_F;
|
return SCM_BOOL_F;
|
||||||
|
|
||||||
rv = isatty (SCM_FPORT_FDES (port));
|
rv = isatty (SCM_FPORT_FDES (port));
|
||||||
return SCM_BOOL(rv);
|
return scm_from_bool(rv);
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
|
|
@ -58,7 +58,7 @@ SCM_DEFINE (scm_make_keyword_from_dash_symbol, "make-keyword-from-dash-symbol",
|
||||||
|
|
||||||
SCM_DEFER_INTS;
|
SCM_DEFER_INTS;
|
||||||
keyword = scm_hashq_ref (scm_keyword_obarray, symbol, SCM_BOOL_F);
|
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_NEWSMOB (keyword, scm_tc16_keyword, SCM_UNPACK (symbol));
|
||||||
scm_hashq_set_x (scm_keyword_obarray, symbol, keyword);
|
scm_hashq_set_x (scm_keyword_obarray, symbol, keyword);
|
||||||
|
@ -88,7 +88,7 @@ SCM_DEFINE (scm_keyword_p, "keyword?", 1, 0, 0,
|
||||||
"@code{#f}.")
|
"@code{#f}.")
|
||||||
#define FUNC_NAME s_scm_keyword_p
|
#define FUNC_NAME s_scm_keyword_p
|
||||||
{
|
{
|
||||||
return SCM_BOOL (SCM_KEYWORDP (obj));
|
return scm_from_bool (SCM_KEYWORDP (obj));
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
|
|
@ -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}.")
|
"Return @code{#t} iff @var{x} is the empty list, else @code{#f}.")
|
||||||
#define FUNC_NAME s_scm_null_p
|
#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
|
#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}.")
|
"Return @code{#t} iff @var{x} is a proper list, else @code{#f}.")
|
||||||
#define FUNC_NAME s_scm_list_p
|
#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
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
@ -607,7 +607,7 @@ SCM_DEFINE (scm_memv, "memv", 2, 0, 0,
|
||||||
SCM_VALIDATE_LIST (2, lst);
|
SCM_VALIDATE_LIST (2, lst);
|
||||||
for (; !SCM_NULL_OR_NIL_P (lst); lst = SCM_CDR (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 lst;
|
||||||
}
|
}
|
||||||
return SCM_BOOL_F;
|
return SCM_BOOL_F;
|
||||||
|
@ -628,7 +628,7 @@ SCM_DEFINE (scm_member, "member", 2, 0, 0,
|
||||||
SCM_VALIDATE_LIST (2, lst);
|
SCM_VALIDATE_LIST (2, lst);
|
||||||
for (; !SCM_NULL_OR_NIL_P (lst); lst = SCM_CDR (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 lst;
|
||||||
}
|
}
|
||||||
return SCM_BOOL_F;
|
return SCM_BOOL_F;
|
||||||
|
@ -681,7 +681,7 @@ SCM_DEFINE (scm_delv_x, "delv!", 2, 0, 0,
|
||||||
SCM_CONSP (walk);
|
SCM_CONSP (walk);
|
||||||
walk = SCM_CDR (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);
|
*prev = SCM_CDR (walk);
|
||||||
else
|
else
|
||||||
prev = SCM_CDRLOC (walk);
|
prev = SCM_CDRLOC (walk);
|
||||||
|
@ -706,7 +706,7 @@ SCM_DEFINE (scm_delete_x, "delete!", 2, 0, 0,
|
||||||
SCM_CONSP (walk);
|
SCM_CONSP (walk);
|
||||||
walk = SCM_CDR (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);
|
*prev = SCM_CDR (walk);
|
||||||
else
|
else
|
||||||
prev = SCM_CDRLOC (walk);
|
prev = SCM_CDRLOC (walk);
|
||||||
|
@ -802,7 +802,7 @@ SCM_DEFINE (scm_delv1_x, "delv1!", 2, 0, 0,
|
||||||
SCM_CONSP (walk);
|
SCM_CONSP (walk);
|
||||||
walk = SCM_CDR (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);
|
*prev = SCM_CDR (walk);
|
||||||
break;
|
break;
|
||||||
|
@ -830,7 +830,7 @@ SCM_DEFINE (scm_delete1_x, "delete1!", 2, 0, 0,
|
||||||
SCM_CONSP (walk);
|
SCM_CONSP (walk);
|
||||||
walk = SCM_CDR (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);
|
*prev = SCM_CDR (walk);
|
||||||
break;
|
break;
|
||||||
|
@ -866,7 +866,7 @@ SCM_DEFINE (scm_filter, "filter", 2, 0, 0,
|
||||||
SCM_CONSP (walk);
|
SCM_CONSP (walk);
|
||||||
walk = SCM_CDR (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_cons (SCM_CAR (walk), SCM_EOL);
|
||||||
prev = SCM_CDRLOC (*prev);
|
prev = SCM_CDRLOC (*prev);
|
||||||
|
@ -892,7 +892,7 @@ SCM_DEFINE (scm_filter_x, "filter!", 2, 0, 0,
|
||||||
SCM_CONSP (walk);
|
SCM_CONSP (walk);
|
||||||
walk = SCM_CDR (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);
|
prev = SCM_CDRLOC (walk);
|
||||||
else
|
else
|
||||||
*prev = SCM_CDR (walk);
|
*prev = SCM_CDR (walk);
|
||||||
|
|
|
@ -93,11 +93,11 @@ SCM_DEFINE (scm_primitive_load, "primitive-load", 1, 0, 0,
|
||||||
{
|
{
|
||||||
SCM hook = *scm_loc_load_hook;
|
SCM hook = *scm_loc_load_hook;
|
||||||
SCM_VALIDATE_STRING (1, filename);
|
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_MISC_ERROR ("value of %load-hook is neither a procedure nor #f",
|
||||||
SCM_EOL);
|
SCM_EOL);
|
||||||
|
|
||||||
if (! SCM_FALSEP (hook))
|
if (! scm_is_false (hook))
|
||||||
scm_call_1 (hook, filename);
|
scm_call_1 (hook, filename);
|
||||||
|
|
||||||
{ /* scope */
|
{ /* scope */
|
||||||
|
@ -211,12 +211,12 @@ SCM_DEFINE (scm_parse_path, "parse-path", 1, 1, 0,
|
||||||
"is returned.")
|
"is returned.")
|
||||||
#define FUNC_NAME s_scm_parse_path
|
#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,
|
path,
|
||||||
SCM_ARG1, FUNC_NAME);
|
SCM_ARG1, FUNC_NAME);
|
||||||
if (SCM_UNBNDP (tail))
|
if (SCM_UNBNDP (tail))
|
||||||
tail = SCM_EOL;
|
tail = SCM_EOL;
|
||||||
return (SCM_FALSEP (path)
|
return (scm_is_false (path)
|
||||||
? tail
|
? tail
|
||||||
: scm_internal_parse_path (SCM_STRING_CHARS (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);
|
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
|
int absolute = (SCM_STRING_LENGTH (filename) >= 1
|
||||||
#ifdef __MINGW32__
|
#ifdef __MINGW32__
|
||||||
|
|
|
@ -38,8 +38,8 @@ macro_print (SCM macro, SCM port, scm_print_state *pstate)
|
||||||
{
|
{
|
||||||
SCM code = SCM_MACRO_CODE (macro);
|
SCM code = SCM_MACRO_CODE (macro);
|
||||||
if (!SCM_CLOSUREP (code)
|
if (!SCM_CLOSUREP (code)
|
||||||
|| SCM_FALSEP (scm_procedure_p (SCM_PRINT_CLOSURE))
|
|| scm_is_false (scm_procedure_p (SCM_PRINT_CLOSURE))
|
||||||
|| SCM_FALSEP (scm_printer_apply (SCM_PRINT_CLOSURE,
|
|| scm_is_false (scm_printer_apply (SCM_PRINT_CLOSURE,
|
||||||
macro, port, pstate)))
|
macro, port, pstate)))
|
||||||
{
|
{
|
||||||
if (!SCM_CLOSUREP (code))
|
if (!SCM_CLOSUREP (code))
|
||||||
|
@ -165,7 +165,7 @@ SCM_DEFINE (scm_macro_p, "macro?", 1, 0, 0,
|
||||||
"syntax transformer.")
|
"syntax transformer.")
|
||||||
#define FUNC_NAME s_scm_macro_p
|
#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
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
|
|
@ -219,7 +219,7 @@ scm_env_top_level (SCM env)
|
||||||
while (SCM_CONSP (env))
|
while (SCM_CONSP (env))
|
||||||
{
|
{
|
||||||
SCM car_env = SCM_CAR (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;
|
return car_env;
|
||||||
env = SCM_CDR (env);
|
env = SCM_CDR (env);
|
||||||
}
|
}
|
||||||
|
@ -242,14 +242,14 @@ the_root_module ()
|
||||||
SCM
|
SCM
|
||||||
scm_lookup_closure_module (SCM proc)
|
scm_lookup_closure_module (SCM proc)
|
||||||
{
|
{
|
||||||
if (SCM_FALSEP (proc))
|
if (scm_is_false (proc))
|
||||||
return the_root_module ();
|
return the_root_module ();
|
||||||
else if (SCM_EVAL_CLOSURE_P (proc))
|
else if (SCM_EVAL_CLOSURE_P (proc))
|
||||||
return SCM_PACK (SCM_SMOB_DATA (proc));
|
return SCM_PACK (SCM_SMOB_DATA (proc));
|
||||||
else
|
else
|
||||||
{
|
{
|
||||||
SCM mod = scm_procedure_property (proc, sym_module);
|
SCM mod = scm_procedure_property (proc, sym_module);
|
||||||
if (SCM_FALSEP (mod))
|
if (scm_is_false (mod))
|
||||||
mod = the_root_module ();
|
mod = the_root_module ();
|
||||||
return mod;
|
return mod;
|
||||||
}
|
}
|
||||||
|
@ -277,7 +277,7 @@ static SCM
|
||||||
module_variable (SCM module, SCM sym)
|
module_variable (SCM module, SCM sym)
|
||||||
{
|
{
|
||||||
#define SCM_BOUND_THING_P(b) \
|
#define SCM_BOUND_THING_P(b) \
|
||||||
(!SCM_FALSEP (b))
|
(scm_is_true (b))
|
||||||
|
|
||||||
/* 1. Check module obarray */
|
/* 1. Check module obarray */
|
||||||
SCM b = scm_hashq_ref (SCM_MODULE_OBARRAY (module), sym, SCM_UNDEFINED);
|
SCM b = scm_hashq_ref (SCM_MODULE_OBARRAY (module), sym, SCM_UNDEFINED);
|
||||||
|
@ -285,7 +285,7 @@ module_variable (SCM module, SCM sym)
|
||||||
return b;
|
return b;
|
||||||
{
|
{
|
||||||
SCM binder = SCM_MODULE_BINDER (module);
|
SCM binder = SCM_MODULE_BINDER (module);
|
||||||
if (!SCM_FALSEP (binder))
|
if (scm_is_true (binder))
|
||||||
/* 2. Custom binder */
|
/* 2. Custom binder */
|
||||||
{
|
{
|
||||||
b = scm_call_3 (binder, module, sym, SCM_BOOL_F);
|
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_eval_closure_lookup (SCM eclo, SCM sym, SCM definep)
|
||||||
{
|
{
|
||||||
SCM module = SCM_PACK (SCM_SMOB_DATA (eclo));
|
SCM module = SCM_PACK (SCM_SMOB_DATA (eclo));
|
||||||
if (!SCM_FALSEP (definep))
|
if (scm_is_true (definep))
|
||||||
{
|
{
|
||||||
if (SCM_EVAL_CLOSURE_INTERFACE_P (eclo))
|
if (SCM_EVAL_CLOSURE_INTERFACE_P (eclo))
|
||||||
return SCM_BOOL_F;
|
return SCM_BOOL_F;
|
||||||
|
@ -355,7 +355,7 @@ SCM_DEFINE (scm_standard_interface_eval_closure,
|
||||||
SCM
|
SCM
|
||||||
scm_module_lookup_closure (SCM module)
|
scm_module_lookup_closure (SCM module)
|
||||||
{
|
{
|
||||||
if (SCM_FALSEP (module))
|
if (scm_is_false (module))
|
||||||
return SCM_BOOL_F;
|
return SCM_BOOL_F;
|
||||||
else
|
else
|
||||||
return SCM_MODULE_EVAL_CLOSURE (module);
|
return SCM_MODULE_EVAL_CLOSURE (module);
|
||||||
|
@ -373,7 +373,7 @@ scm_current_module_lookup_closure ()
|
||||||
SCM
|
SCM
|
||||||
scm_module_transformer (SCM module)
|
scm_module_transformer (SCM module)
|
||||||
{
|
{
|
||||||
if (SCM_FALSEP (module))
|
if (scm_is_false (module))
|
||||||
return SCM_BOOL_F;
|
return SCM_BOOL_F;
|
||||||
else
|
else
|
||||||
return SCM_MODULE_TRANSFORMER (module);
|
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 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 uses;
|
||||||
SCM_VALIDATE_MODULE (SCM_ARG1, module);
|
SCM_VALIDATE_MODULE (SCM_ARG1, module);
|
||||||
/* Search the use list */
|
/* Search the use list */
|
||||||
|
@ -407,7 +407,7 @@ SCM_DEFINE (scm_module_import_interface, "module-import-interface", 2, 0, 0,
|
||||||
return _interface;
|
return _interface;
|
||||||
{
|
{
|
||||||
SCM binder = SCM_MODULE_BINDER (_interface);
|
SCM binder = SCM_MODULE_BINDER (_interface);
|
||||||
if (!SCM_FALSEP (binder))
|
if (scm_is_true (binder))
|
||||||
/* 2. Custom binder */
|
/* 2. Custom binder */
|
||||||
{
|
{
|
||||||
b = scm_call_3 (binder, _interface, sym, SCM_BOOL_F);
|
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. */
|
/* 3. Search use list recursively. */
|
||||||
_interface = scm_module_import_interface (_interface, sym);
|
_interface = scm_module_import_interface (_interface, sym);
|
||||||
if (!SCM_FALSEP (_interface))
|
if (scm_is_true (_interface))
|
||||||
return _interface;
|
return _interface;
|
||||||
uses = SCM_CDR (uses);
|
uses = SCM_CDR (uses);
|
||||||
}
|
}
|
||||||
|
@ -460,14 +460,14 @@ scm_sym2var (SCM sym, SCM proc, SCM definep)
|
||||||
{
|
{
|
||||||
SCM handle;
|
SCM handle;
|
||||||
|
|
||||||
if (SCM_FALSEP (definep))
|
if (scm_is_false (definep))
|
||||||
var = scm_hashq_ref (scm_pre_modules_obarray, sym, SCM_BOOL_F);
|
var = scm_hashq_ref (scm_pre_modules_obarray, sym, SCM_BOOL_F);
|
||||||
else
|
else
|
||||||
{
|
{
|
||||||
handle = scm_hashq_create_handle_x (scm_pre_modules_obarray,
|
handle = scm_hashq_create_handle_x (scm_pre_modules_obarray,
|
||||||
sym, SCM_BOOL_F);
|
sym, SCM_BOOL_F);
|
||||||
var = SCM_CDR (handle);
|
var = SCM_CDR (handle);
|
||||||
if (SCM_FALSEP (var))
|
if (scm_is_false (var))
|
||||||
{
|
{
|
||||||
var = scm_make_variable (SCM_UNDEFINED);
|
var = scm_make_variable (SCM_UNDEFINED);
|
||||||
SCM_SETCDR (handle, var);
|
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));
|
SCM_MISC_ERROR ("~S is not bound to a variable", scm_list_1 (sym));
|
||||||
|
|
||||||
return var;
|
return var;
|
||||||
|
@ -496,7 +496,7 @@ scm_module_lookup (SCM module, SCM sym)
|
||||||
SCM_VALIDATE_MODULE (1, module);
|
SCM_VALIDATE_MODULE (1, module);
|
||||||
|
|
||||||
var = scm_sym2var (sym, scm_module_lookup_closure (module), SCM_BOOL_F);
|
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));
|
SCM_MISC_ERROR ("unbound variable: ~S", scm_list_1 (sym));
|
||||||
return var;
|
return var;
|
||||||
}
|
}
|
||||||
|
@ -513,7 +513,7 @@ scm_lookup (SCM sym)
|
||||||
{
|
{
|
||||||
SCM var =
|
SCM var =
|
||||||
scm_sym2var (sym, scm_current_module_lookup_closure (), SCM_BOOL_F);
|
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));
|
scm_misc_error ("scm_lookup", "unbound variable: ~S", scm_list_1 (sym));
|
||||||
return var;
|
return var;
|
||||||
}
|
}
|
||||||
|
@ -559,7 +559,7 @@ scm_module_reverse_lookup (SCM module, SCM variable)
|
||||||
SCM obarray;
|
SCM obarray;
|
||||||
long i, n;
|
long i, n;
|
||||||
|
|
||||||
if (SCM_FALSEP (module))
|
if (scm_is_false (module))
|
||||||
obarray = scm_pre_modules_obarray;
|
obarray = scm_pre_modules_obarray;
|
||||||
else
|
else
|
||||||
{
|
{
|
||||||
|
@ -593,7 +593,7 @@ scm_module_reverse_lookup (SCM module, SCM variable)
|
||||||
while (SCM_CONSP (uses))
|
while (SCM_CONSP (uses))
|
||||||
{
|
{
|
||||||
SCM sym = scm_module_reverse_lookup (SCM_CAR (uses), variable);
|
SCM sym = scm_module_reverse_lookup (SCM_CAR (uses), variable);
|
||||||
if (!SCM_FALSEP (sym))
|
if (scm_is_true (sym))
|
||||||
return sym;
|
return sym;
|
||||||
uses = SCM_CDR (uses);
|
uses = SCM_CDR (uses);
|
||||||
}
|
}
|
||||||
|
@ -620,9 +620,9 @@ SCM
|
||||||
scm_system_module_env_p (SCM env)
|
scm_system_module_env_p (SCM env)
|
||||||
{
|
{
|
||||||
SCM proc = scm_env_top_level (env);
|
SCM proc = scm_env_top_level (env);
|
||||||
if (SCM_FALSEP (proc))
|
if (scm_is_false (proc))
|
||||||
return SCM_BOOL_T;
|
return SCM_BOOL_T;
|
||||||
return ((!SCM_FALSEP (scm_procedure_property (proc,
|
return ((scm_is_true (scm_procedure_property (proc,
|
||||||
scm_sym_system_module)))
|
scm_sym_system_module)))
|
||||||
? SCM_BOOL_T
|
? SCM_BOOL_T
|
||||||
: SCM_BOOL_F);
|
: SCM_BOOL_F);
|
||||||
|
|
|
@ -357,7 +357,7 @@ SCM_DEFINE (scm_sethost, "sethost", 0, 1, 0,
|
||||||
if (SCM_UNBNDP (stayopen))
|
if (SCM_UNBNDP (stayopen))
|
||||||
endhostent ();
|
endhostent ();
|
||||||
else
|
else
|
||||||
sethostent (!SCM_FALSEP (stayopen));
|
sethostent (scm_is_true (stayopen));
|
||||||
return SCM_UNSPECIFIED;
|
return SCM_UNSPECIFIED;
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
@ -373,7 +373,7 @@ SCM_DEFINE (scm_setnet, "setnet", 0, 1, 0,
|
||||||
if (SCM_UNBNDP (stayopen))
|
if (SCM_UNBNDP (stayopen))
|
||||||
endnetent ();
|
endnetent ();
|
||||||
else
|
else
|
||||||
setnetent (!SCM_FALSEP (stayopen));
|
setnetent (scm_is_true (stayopen));
|
||||||
return SCM_UNSPECIFIED;
|
return SCM_UNSPECIFIED;
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
@ -389,7 +389,7 @@ SCM_DEFINE (scm_setproto, "setproto", 0, 1, 0,
|
||||||
if (SCM_UNBNDP (stayopen))
|
if (SCM_UNBNDP (stayopen))
|
||||||
endprotoent ();
|
endprotoent ();
|
||||||
else
|
else
|
||||||
setprotoent (!SCM_FALSEP (stayopen));
|
setprotoent (scm_is_true (stayopen));
|
||||||
return SCM_UNSPECIFIED;
|
return SCM_UNSPECIFIED;
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
@ -405,7 +405,7 @@ SCM_DEFINE (scm_setserv, "setserv", 0, 1, 0,
|
||||||
if (SCM_UNBNDP (stayopen))
|
if (SCM_UNBNDP (stayopen))
|
||||||
endservent ();
|
endservent ();
|
||||||
else
|
else
|
||||||
setservent (!SCM_FALSEP (stayopen));
|
setservent (scm_is_true (stayopen));
|
||||||
return SCM_UNSPECIFIED;
|
return SCM_UNSPECIFIED;
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
|
@ -71,7 +71,7 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
|
||||||
case scm_tc3_imm24:
|
case scm_tc3_imm24:
|
||||||
if (SCM_CHARP (x))
|
if (SCM_CHARP (x))
|
||||||
return scm_class_char;
|
return scm_class_char;
|
||||||
else if (SCM_BOOLP (x))
|
else if (scm_is_bool (x))
|
||||||
return scm_class_boolean;
|
return scm_class_boolean;
|
||||||
else if (SCM_NULLP (x))
|
else if (SCM_NULLP (x))
|
||||||
return scm_class_null;
|
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)
|
else if (SCM_OBJ_CLASS_FLAGS (x) & SCM_CLASSF_GOOPS)
|
||||||
{
|
{
|
||||||
/* Goops object */
|
/* 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_change_object_class (x,
|
||||||
SCM_CLASS_OF (x), /* old */
|
SCM_CLASS_OF (x), /* old */
|
||||||
SCM_OBJ_CLASS_REDEF (x)); /* new */
|
SCM_OBJ_CLASS_REDEF (x)); /* new */
|
||||||
|
@ -164,12 +164,12 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
|
||||||
{
|
{
|
||||||
/* ordinary struct */
|
/* ordinary struct */
|
||||||
SCM handle = scm_struct_create_handle (SCM_STRUCT_VTABLE (x));
|
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));
|
return SCM_STRUCT_TABLE_CLASS (SCM_CDR (handle));
|
||||||
else
|
else
|
||||||
{
|
{
|
||||||
SCM name = SCM_STRUCT_TABLE_NAME (SCM_CDR (handle));
|
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)
|
? SCM_SYMBOL_CHARS (name)
|
||||||
: 0,
|
: 0,
|
||||||
SCM_I_OPERATORP (x));
|
SCM_I_OPERATORP (x));
|
||||||
|
@ -297,7 +297,7 @@ SCM
|
||||||
scm_mcache_compute_cmethod (SCM cache, SCM args)
|
scm_mcache_compute_cmethod (SCM cache, SCM args)
|
||||||
{
|
{
|
||||||
SCM cmethod = scm_mcache_lookup_cmethod (cache, args);
|
SCM cmethod = scm_mcache_lookup_cmethod (cache, args);
|
||||||
if (SCM_FALSEP (cmethod))
|
if (scm_is_false (cmethod))
|
||||||
/* No match - memoize */
|
/* No match - memoize */
|
||||||
return scm_memoize_method (cache, args);
|
return scm_memoize_method (cache, args);
|
||||||
return cmethod;
|
return cmethod;
|
||||||
|
@ -342,7 +342,7 @@ SCM_DEFINE (scm_entity_p, "entity?", 1, 0, 0,
|
||||||
"Return @code{#t} if @var{obj} is an entity.")
|
"Return @code{#t} if @var{obj} is an entity.")
|
||||||
#define FUNC_NAME s_scm_entity_p
|
#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
|
#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.")
|
"Return @code{#t} if @var{obj} is an operator.")
|
||||||
#define FUNC_NAME s_scm_operator_p
|
#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_OPERATORP (obj)
|
||||||
&& !SCM_I_ENTITYP (obj));
|
&& !SCM_I_ENTITYP (obj));
|
||||||
}
|
}
|
||||||
|
|
|
@ -239,7 +239,7 @@ scm_options (SCM args, scm_t_option options[], unsigned int n, const char *s)
|
||||||
else
|
else
|
||||||
{
|
{
|
||||||
SCM old_setting;
|
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);
|
old_setting = get_option_setting (options, n);
|
||||||
change_option_setting (args, options, n, s);
|
change_option_setting (args, options, n, s);
|
||||||
return old_setting;
|
return old_setting;
|
||||||
|
|
|
@ -74,7 +74,7 @@ SCM_DEFINE (scm_pair_p, "pair?", 1, 0, 0,
|
||||||
"@code{#f}.")
|
"@code{#f}.")
|
||||||
#define FUNC_NAME s_scm_pair_p
|
#define FUNC_NAME s_scm_pair_p
|
||||||
{
|
{
|
||||||
return SCM_BOOL (SCM_CONSP (x));
|
return scm_from_bool (SCM_CONSP (x));
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
|
|
@ -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)];
|
scm_t_ptob_descriptor *ptob = &scm_ptobs[SCM_PTOBNUM (port)];
|
||||||
|
|
||||||
if (ptob->input_waiting)
|
if (ptob->input_waiting)
|
||||||
return SCM_BOOL(ptob->input_waiting (port));
|
return scm_from_bool(ptob->input_waiting (port));
|
||||||
else
|
else
|
||||||
return SCM_BOOL_T;
|
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_remove_from_port_table (port);
|
||||||
scm_mutex_unlock (&scm_i_port_table_mutex);
|
scm_mutex_unlock (&scm_i_port_table_mutex);
|
||||||
SCM_CLR_PORT_OPEN_FLAG (port);
|
SCM_CLR_PORT_OPEN_FLAG (port);
|
||||||
return SCM_BOOL (rv >= 0);
|
return scm_from_bool (rv >= 0);
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
@ -838,7 +838,7 @@ SCM_DEFINE (scm_input_port_p, "input-port?", 1, 0, 0,
|
||||||
"@code{port?}.")
|
"@code{port?}.")
|
||||||
#define FUNC_NAME s_scm_input_port_p
|
#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
|
#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
|
#define FUNC_NAME s_scm_output_port_p
|
||||||
{
|
{
|
||||||
x = SCM_COERCE_OUTPORT (x);
|
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
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
@ -861,7 +861,7 @@ SCM_DEFINE (scm_port_p, "port?", 1, 0, 0,
|
||||||
"@var{x}))}.")
|
"@var{x}))}.")
|
||||||
#define FUNC_NAME s_scm_port_p
|
#define FUNC_NAME s_scm_port_p
|
||||||
{
|
{
|
||||||
return SCM_BOOL (SCM_PORTP (x));
|
return scm_from_bool (SCM_PORTP (x));
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#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
|
#define FUNC_NAME s_scm_port_closed_p
|
||||||
{
|
{
|
||||||
SCM_VALIDATE_PORT (1, port);
|
SCM_VALIDATE_PORT (1, port);
|
||||||
return SCM_BOOL (!SCM_OPPORTP (port));
|
return scm_from_bool (!SCM_OPPORTP (port));
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
@ -882,7 +882,7 @@ SCM_DEFINE (scm_eof_object_p, "eof-object?", 1, 0, 0,
|
||||||
"return @code{#f}.")
|
"return @code{#f}.")
|
||||||
#define FUNC_NAME s_scm_eof_object_p
|
#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
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
|
|
@ -310,7 +310,7 @@ SCM_DEFINE (scm_getpwuid, "getpw", 0, 1, 0,
|
||||||
struct passwd *entry;
|
struct passwd *entry;
|
||||||
|
|
||||||
SCM result = scm_c_make_vector (7, SCM_UNSPECIFIED);
|
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 ());
|
SCM_SYSCALL (entry = getpwent ());
|
||||||
if (! entry)
|
if (! entry)
|
||||||
|
@ -357,7 +357,7 @@ SCM_DEFINE (scm_setpwent, "setpw", 0, 1, 0,
|
||||||
"@code{endpwent} procedures are implemented on top of this.")
|
"@code{endpwent} procedures are implemented on top of this.")
|
||||||
#define FUNC_NAME s_scm_setpwent
|
#define FUNC_NAME s_scm_setpwent
|
||||||
{
|
{
|
||||||
if (SCM_UNBNDP (arg) || SCM_FALSEP (arg))
|
if (SCM_UNBNDP (arg) || scm_is_false (arg))
|
||||||
endpwent ();
|
endpwent ();
|
||||||
else
|
else
|
||||||
setpwent ();
|
setpwent ();
|
||||||
|
@ -379,7 +379,7 @@ SCM_DEFINE (scm_getgrgid, "getgr", 0, 1, 0,
|
||||||
struct group *entry;
|
struct group *entry;
|
||||||
SCM result = scm_c_make_vector (4, SCM_UNSPECIFIED);
|
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 ());
|
SCM_SYSCALL (entry = getgrent ());
|
||||||
if (! entry)
|
if (! entry)
|
||||||
|
@ -414,7 +414,7 @@ SCM_DEFINE (scm_setgrent, "setgr", 0, 1, 0,
|
||||||
"@code{endgrent} procedures are implemented on top of this.")
|
"@code{endgrent} procedures are implemented on top of this.")
|
||||||
#define FUNC_NAME s_scm_setgrent
|
#define FUNC_NAME s_scm_setgrent
|
||||||
{
|
{
|
||||||
if (SCM_UNBNDP (arg) || SCM_FALSEP (arg))
|
if (SCM_UNBNDP (arg) || scm_is_false (arg))
|
||||||
endgrent ();
|
endgrent ();
|
||||||
else
|
else
|
||||||
setgrent ();
|
setgrent ();
|
||||||
|
@ -1220,7 +1220,7 @@ SCM_DEFINE (scm_access, "access?", 2, 0, 0,
|
||||||
SCM_VALIDATE_STRING (1, path);
|
SCM_VALIDATE_STRING (1, path);
|
||||||
SCM_VALIDATE_INUM (2, how);
|
SCM_VALIDATE_INUM (2, how);
|
||||||
rv = access (SCM_STRING_CHARS (path), SCM_INUM (how));
|
rv = access (SCM_STRING_CHARS (path), SCM_INUM (how));
|
||||||
return SCM_NEGATE_BOOL(rv);
|
return scm_from_bool (!rv);
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
|
|
@ -177,7 +177,7 @@ scm_make_print_state ()
|
||||||
}
|
}
|
||||||
scm_i_plugin_mutex_unlock (&print_state_mutex);
|
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
|
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] == ',' ||
|
if (len == 0 || str[0] == '\'' || str[0] == '`' || str[0] == ',' ||
|
||||||
str[0] == ':' || str[len-1] == ':' || (str[0] == '.' && len == 1) ||
|
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);
|
scm_lfwrite ("#{", 2, port);
|
||||||
weird = 1;
|
weird = 1;
|
||||||
|
@ -442,8 +442,8 @@ scm_iprin1 (SCM exp, SCM port, scm_print_state *pstate)
|
||||||
print_circref (port, pstate, exp);
|
print_circref (port, pstate, exp);
|
||||||
break;
|
break;
|
||||||
case scm_tcs_closures:
|
case scm_tcs_closures:
|
||||||
if (SCM_FALSEP (scm_procedure_p (SCM_PRINT_CLOSURE))
|
if (scm_is_false (scm_procedure_p (SCM_PRINT_CLOSURE))
|
||||||
|| SCM_FALSEP (scm_printer_apply (SCM_PRINT_CLOSURE,
|
|| scm_is_false (scm_printer_apply (SCM_PRINT_CLOSURE,
|
||||||
exp, port, pstate)))
|
exp, port, pstate)))
|
||||||
{
|
{
|
||||||
SCM formals = SCM_CLOSURE_FORMALS (exp);
|
SCM formals = SCM_CLOSURE_FORMALS (exp);
|
||||||
|
@ -603,7 +603,7 @@ scm_iprin1 (SCM exp, SCM port, scm_print_state *pstate)
|
||||||
/* Print gsubrs as primitives */
|
/* Print gsubrs as primitives */
|
||||||
SCM name = scm_procedure_name (exp);
|
SCM name = scm_procedure_name (exp);
|
||||||
scm_puts ("#<primitive-procedure", port);
|
scm_puts ("#<primitive-procedure", port);
|
||||||
if (!SCM_FALSEP (name))
|
if (scm_is_true (name))
|
||||||
{
|
{
|
||||||
scm_putc (' ', port);
|
scm_putc (' ', port);
|
||||||
scm_puts (SCM_SYMBOL_CHARS (name), 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_puts ("#<procedure-with-setter", port);
|
||||||
{
|
{
|
||||||
SCM name = scm_procedure_name (exp);
|
SCM name = scm_procedure_name (exp);
|
||||||
if (!SCM_FALSEP (name))
|
if (scm_is_true (name))
|
||||||
{
|
{
|
||||||
scm_putc (' ', port);
|
scm_putc (' ', port);
|
||||||
scm_display (name, 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);
|
print_state_pool = SCM_CDR (print_state_pool);
|
||||||
}
|
}
|
||||||
scm_i_plugin_mutex_unlock (&print_state_mutex);
|
scm_i_plugin_mutex_unlock (&print_state_mutex);
|
||||||
if (SCM_FALSEP (handle))
|
if (scm_is_false (handle))
|
||||||
handle = scm_list_1 (make_print_state ());
|
handle = scm_list_1 (make_print_state ());
|
||||||
pstate_scm = SCM_CAR (handle);
|
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
|
/* Return print state to pool if it has been created above and
|
||||||
hasn't escaped to Scheme. */
|
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_i_plugin_mutex_lock (&print_state_mutex);
|
||||||
SCM_SETCDR (handle, print_state_pool);
|
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;
|
destination = port = scm_cur_outp;
|
||||||
}
|
}
|
||||||
else if (SCM_FALSEP (destination))
|
else if (scm_is_false (destination))
|
||||||
{
|
{
|
||||||
fReturnString = 1;
|
fReturnString = 1;
|
||||||
port = scm_mkstrport (SCM_INUM0,
|
port = scm_mkstrport (SCM_INUM0,
|
||||||
|
|
|
@ -130,7 +130,7 @@ scm_i_procedure_arity (SCM proc)
|
||||||
default:
|
default:
|
||||||
return SCM_BOOL_F;
|
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
|
static SCM
|
||||||
|
@ -138,7 +138,7 @@ scm_stand_in_scm_proc(SCM proc)
|
||||||
{
|
{
|
||||||
SCM answer;
|
SCM answer;
|
||||||
answer = scm_assq (proc, scm_stand_in_procs);
|
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);
|
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);
|
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))
|
if (SCM_EQ_P (k, scm_sym_arity))
|
||||||
{
|
{
|
||||||
SCM 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);
|
p, SCM_ARG1, FUNC_NAME);
|
||||||
return arity;
|
return arity;
|
||||||
}
|
}
|
||||||
|
|
|
@ -176,7 +176,7 @@ SCM_DEFINE (scm_procedure_p, "procedure?", 1, 0, 0,
|
||||||
case scm_tc7_pws:
|
case scm_tc7_pws:
|
||||||
return SCM_BOOL_T;
|
return SCM_BOOL_T;
|
||||||
case scm_tc7_smob:
|
case scm_tc7_smob:
|
||||||
return SCM_BOOL (SCM_SMOB_DESCRIPTOR (obj).apply);
|
return scm_from_bool (SCM_SMOB_DESCRIPTOR (obj).apply);
|
||||||
default:
|
default:
|
||||||
return SCM_BOOL_F;
|
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.")
|
"Return @code{#t} if @var{obj} is a closure.")
|
||||||
#define FUNC_NAME s_scm_closure_p
|
#define FUNC_NAME s_scm_closure_p
|
||||||
{
|
{
|
||||||
return SCM_BOOL (SCM_CLOSUREP (obj));
|
return scm_from_bool (SCM_CLOSUREP (obj));
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
@ -204,7 +204,7 @@ SCM_DEFINE (scm_thunk_p, "thunk?", 1, 0, 0,
|
||||||
switch (SCM_TYP7 (obj))
|
switch (SCM_TYP7 (obj))
|
||||||
{
|
{
|
||||||
case scm_tcs_closures:
|
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_0:
|
||||||
case scm_tc7_subr_1o:
|
case scm_tc7_subr_1o:
|
||||||
case scm_tc7_lsubr:
|
case scm_tc7_lsubr:
|
||||||
|
@ -284,7 +284,7 @@ SCM_DEFINE (scm_procedure_with_setter_p, "procedure-with-setter?", 1, 0, 0,
|
||||||
"associated setter procedure.")
|
"associated setter procedure.")
|
||||||
#define FUNC_NAME s_scm_procedure_with_setter_p
|
#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
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
|
|
@ -64,19 +64,19 @@ SCM_DEFINE (scm_primitive_property_ref, "primitive-property-ref", 2, 0, 0,
|
||||||
SCM_VALIDATE_CONS (SCM_ARG1, prop);
|
SCM_VALIDATE_CONS (SCM_ARG1, prop);
|
||||||
|
|
||||||
h = scm_hashq_get_handle (scm_properties_whash, obj);
|
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));
|
SCM assoc = scm_assq (prop, SCM_CDR (h));
|
||||||
if (!SCM_FALSEP (assoc))
|
if (scm_is_true (assoc))
|
||||||
return SCM_CDR (assoc);
|
return SCM_CDR (assoc);
|
||||||
}
|
}
|
||||||
|
|
||||||
if (SCM_FALSEP (SCM_CAR (prop)))
|
if (scm_is_false (SCM_CAR (prop)))
|
||||||
return SCM_BOOL_F;
|
return SCM_BOOL_F;
|
||||||
else
|
else
|
||||||
{
|
{
|
||||||
SCM val = scm_call_2 (SCM_CAR (prop), prop, obj);
|
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);
|
h = scm_hashq_create_handle_x (scm_properties_whash, obj, SCM_EOL);
|
||||||
SCM_SETCDR (h, scm_acons (prop, val, SCM_CDR (h)));
|
SCM_SETCDR (h, scm_acons (prop, val, SCM_CDR (h)));
|
||||||
return val;
|
return val;
|
||||||
|
@ -114,7 +114,7 @@ SCM_DEFINE (scm_primitive_property_del_x, "primitive-property-del!", 2, 0, 0,
|
||||||
SCM h;
|
SCM h;
|
||||||
SCM_VALIDATE_CONS (SCM_ARG1, prop);
|
SCM_VALIDATE_CONS (SCM_ARG1, prop);
|
||||||
h = scm_hashq_get_handle (scm_properties_whash, obj);
|
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));
|
SCM_SETCDR (h, scm_assq_remove_x (SCM_CDR (h), prop));
|
||||||
return SCM_UNSPECIFIED;
|
return SCM_UNSPECIFIED;
|
||||||
}
|
}
|
||||||
|
|
|
@ -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)))
|
if (1 == inc && (n >= SCM_LONG_BIT || n == SCM_BITVECTOR_LENGTH (ra)))
|
||||||
{
|
{
|
||||||
i = base / SCM_LONG_BIT;
|
i = base / SCM_LONG_BIT;
|
||||||
if (SCM_FALSEP (fill))
|
if (scm_is_false (fill))
|
||||||
{
|
{
|
||||||
if (base % SCM_LONG_BIT) /* leading partial word */
|
if (base % SCM_LONG_BIT) /* leading partial word */
|
||||||
ve[i++] &= ~(~0L << (base % SCM_LONG_BIT));
|
ve[i++] &= ~(~0L << (base % SCM_LONG_BIT));
|
||||||
|
@ -509,7 +509,7 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore SCM_UNUSED)
|
||||||
}
|
}
|
||||||
else
|
else
|
||||||
{
|
{
|
||||||
if (SCM_FALSEP (fill))
|
if (scm_is_false (fill))
|
||||||
for (i = base; n--; i += inc)
|
for (i = base; n--; i += inc)
|
||||||
ve[i / SCM_LONG_BIT] &= ~(1L << (i % SCM_LONG_BIT));
|
ve[i / SCM_LONG_BIT] &= ~(1L << (i % SCM_LONG_BIT));
|
||||||
else if (SCM_EQ_P (fill, SCM_BOOL_T))
|
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;
|
SCM e1 = SCM_UNDEFINED, e2 = SCM_UNDEFINED;
|
||||||
for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
|
for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
|
||||||
if (SCM_BITVEC_REF (ra0, i0))
|
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);
|
SCM_BITVEC_CLR (ra0, i0);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
|
@ -897,8 +897,8 @@ ra_compare (SCM ra0, SCM ra1, SCM ra2, int opt)
|
||||||
for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
|
for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
|
||||||
if (SCM_BITVEC_REF (ra0, i0))
|
if (SCM_BITVEC_REF (ra0, i0))
|
||||||
if (opt ?
|
if (opt ?
|
||||||
SCM_NFALSEP (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_FALSEP (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);
|
SCM_BITVEC_CLR (ra0, i0);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
|
@ -1323,7 +1323,7 @@ ramap_rp (SCM ra0, SCM proc, SCM ras)
|
||||||
default:
|
default:
|
||||||
for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
|
for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
|
||||||
if (SCM_BITVEC_REF (ra0, i0))
|
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);
|
SCM_BITVEC_CLR (ra0, i0);
|
||||||
break;
|
break;
|
||||||
case scm_tc7_uvect:
|
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 n1 = SCM_MAKINUM (((long *) SCM_UNPACK (SCM_CDR (ra1)))[i1]);
|
||||||
SCM n2 = SCM_MAKINUM (((long *) SCM_UNPACK (SCM_CDR (ra2)))[i2]);
|
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);
|
SCM_BITVEC_CLR (ra0, i0);
|
||||||
}
|
}
|
||||||
break;
|
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 (a1) = ((float *) SCM_VELTS (ra1))[i1];
|
||||||
SCM_REAL_VALUE (a2) = ((float *) SCM_VELTS (ra2))[i2];
|
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);
|
SCM_BITVEC_CLR (ra0, i0);
|
||||||
}
|
}
|
||||||
break;
|
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 (a1) = ((double *) SCM_VELTS (ra1))[i1];
|
||||||
SCM_REAL_VALUE (a2) = ((double *) SCM_VELTS (ra2))[i2];
|
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);
|
SCM_BITVEC_CLR (ra0, i0);
|
||||||
}
|
}
|
||||||
break;
|
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_IMAG (a1) = ((double *) SCM_VELTS (ra1))[2 * i1 + 1];
|
||||||
SCM_COMPLEX_REAL (a2) = ((double *) SCM_VELTS (ra2))[2 * i2];
|
SCM_COMPLEX_REAL (a2) = ((double *) SCM_VELTS (ra2))[2 * i2];
|
||||||
SCM_COMPLEX_IMAG (a2) = ((double *) SCM_VELTS (ra2))[2 * i2 + 1];
|
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);
|
SCM_BITVEC_CLR (ra0, i0);
|
||||||
}
|
}
|
||||||
break;
|
break;
|
||||||
|
@ -1518,7 +1518,7 @@ SCM_DEFINE (scm_array_map_x, "array-map!", 2, 0, 1,
|
||||||
case scm_tc7_rpsubr:
|
case scm_tc7_rpsubr:
|
||||||
{
|
{
|
||||||
ra_iproc *p;
|
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;
|
goto gencase;
|
||||||
scm_array_fill_x (ra0, SCM_BOOL_T);
|
scm_array_fill_x (ra0, SCM_BOOL_T);
|
||||||
for (p = ra_rpsubrs; p->name; p++)
|
for (p = ra_rpsubrs; p->name; p++)
|
||||||
|
@ -1781,12 +1781,12 @@ raeql_1 (SCM ra0, SCM as_equal, SCM ra1)
|
||||||
default:
|
default:
|
||||||
for (; n--; i0 += inc0, i1 += inc1)
|
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;
|
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 0;
|
||||||
}
|
}
|
||||||
return 1;
|
return 1;
|
||||||
|
@ -1942,7 +1942,7 @@ raeql (SCM ra0, SCM as_equal, SCM ra1)
|
||||||
SCM
|
SCM
|
||||||
scm_raequal (SCM ra0, SCM ra1)
|
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
|
#if 0
|
||||||
|
@ -2007,7 +2007,7 @@ scm_array_equal_p (SCM ra0, SCM ra1)
|
||||||
if (!SCM_ARRAYP (ra1))
|
if (!SCM_ARRAYP (ra1))
|
||||||
goto callequal;
|
goto callequal;
|
||||||
}
|
}
|
||||||
return SCM_BOOL(raeql (ra0, SCM_BOOL_F, ra1));
|
return scm_from_bool(raeql (ra0, SCM_BOOL_F, ra1));
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -81,7 +81,7 @@ SCM_DEFINE (scm_read_delimited_x, "%read-delimited!", 3, 3, 0,
|
||||||
{
|
{
|
||||||
if (cdelims[k] == c)
|
if (cdelims[k] == c)
|
||||||
{
|
{
|
||||||
if (SCM_FALSEP (gobble))
|
if (scm_is_false (gobble))
|
||||||
scm_ungetc (c, port);
|
scm_ungetc (c, port);
|
||||||
|
|
||||||
return scm_cons (SCM_MAKE_CHAR (c),
|
return scm_cons (SCM_MAKE_CHAR (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
|
/* If this sexpr is visible in the read:sharp source, we want to
|
||||||
keep that information, so only record non-constant cons cells
|
keep that information, so only record non-constant cons cells
|
||||||
which haven't previously been read by the reader. */
|
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)
|
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
|
/* Check for user-defined hash procedure first, to allow
|
||||||
overriding of builtin hash read syntaxes. */
|
overriding of builtin hash read syntaxes. */
|
||||||
SCM sharp = scm_get_hash_procedure (c);
|
SCM sharp = scm_get_hash_procedure (c);
|
||||||
if (!SCM_FALSEP (sharp))
|
if (scm_is_true (sharp))
|
||||||
{
|
{
|
||||||
int line = SCM_LINUM (port);
|
int line = SCM_LINUM (port);
|
||||||
int column = SCM_COL (port) - 2;
|
int column = SCM_COL (port) - 2;
|
||||||
|
@ -439,7 +439,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy)
|
||||||
case '*':
|
case '*':
|
||||||
j = scm_read_token (c, tok_buf, port, 0);
|
j = scm_read_token (c, tok_buf, port, 0);
|
||||||
p = scm_istr2bve (SCM_STRING_CHARS (*tok_buf) + 1, (long) (j - 1));
|
p = scm_istr2bve (SCM_STRING_CHARS (*tok_buf) + 1, (long) (j - 1));
|
||||||
if (!SCM_FALSEP (p))
|
if (scm_is_true (p))
|
||||||
return p;
|
return p;
|
||||||
else
|
else
|
||||||
goto unkshrp;
|
goto unkshrp;
|
||||||
|
@ -482,7 +482,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy)
|
||||||
{
|
{
|
||||||
SCM sharp = scm_get_hash_procedure (c);
|
SCM sharp = scm_get_hash_procedure (c);
|
||||||
|
|
||||||
if (!SCM_FALSEP (sharp))
|
if (scm_is_true (sharp))
|
||||||
{
|
{
|
||||||
int line = SCM_LINUM (port);
|
int line = SCM_LINUM (port);
|
||||||
int column = SCM_COL (port) - 2;
|
int column = SCM_COL (port) - 2;
|
||||||
|
@ -595,7 +595,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy)
|
||||||
goto tok;
|
goto tok;
|
||||||
|
|
||||||
p = scm_i_mem2number (SCM_STRING_CHARS (*tok_buf), j, 10);
|
p = scm_i_mem2number (SCM_STRING_CHARS (*tok_buf), j, 10);
|
||||||
if (!SCM_FALSEP (p))
|
if (scm_is_true (p))
|
||||||
return p;
|
return p;
|
||||||
if (c == '#')
|
if (c == '#')
|
||||||
{
|
{
|
||||||
|
@ -858,7 +858,7 @@ SCM_DEFINE (scm_read_hash_extend, "read-hash-extend", 2, 0, 0,
|
||||||
SCM prev;
|
SCM prev;
|
||||||
|
|
||||||
SCM_VALIDATE_CHAR (1, chr);
|
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),
|
|| SCM_EQ_P (scm_procedure_p (proc), SCM_BOOL_T),
|
||||||
proc, SCM_ARG2, FUNC_NAME);
|
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))
|
if (SCM_NULLP (this))
|
||||||
{
|
{
|
||||||
/* not found, so add it to the beginning. */
|
/* not found, so add it to the beginning. */
|
||||||
if (!SCM_FALSEP (proc))
|
if (scm_is_true (proc))
|
||||||
{
|
{
|
||||||
*scm_read_hash_procedures =
|
*scm_read_hash_procedures =
|
||||||
scm_cons (scm_cons (chr, 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)))
|
if (SCM_EQ_P (chr, SCM_CAAR (this)))
|
||||||
{
|
{
|
||||||
/* already in the alist. */
|
/* already in the alist. */
|
||||||
if (SCM_FALSEP (proc))
|
if (scm_is_false (proc))
|
||||||
{
|
{
|
||||||
/* remove it. */
|
/* remove it. */
|
||||||
if (SCM_FALSEP (prev))
|
if (scm_is_false (prev))
|
||||||
{
|
{
|
||||||
*scm_read_hash_procedures =
|
*scm_read_hash_procedures =
|
||||||
SCM_CDR (*scm_read_hash_procedures);
|
SCM_CDR (*scm_read_hash_procedures);
|
||||||
|
|
|
@ -116,7 +116,7 @@ SCM_DEFINE (scm_regexp_p, "regexp?", 1, 0, 0,
|
||||||
"or @code{#f} otherwise.")
|
"or @code{#f} otherwise.")
|
||||||
#define FUNC_NAME s_scm_regexp_p
|
#define FUNC_NAME s_scm_regexp_p
|
||||||
{
|
{
|
||||||
return SCM_BOOL(SCM_RGXP (obj));
|
return scm_from_bool(SCM_RGXP (obj));
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
|
|
@ -153,7 +153,7 @@ scm_delq_spine_x (SCM cell, SCM list)
|
||||||
prev = s;
|
prev = s;
|
||||||
s = SCM_CDR (s);
|
s = SCM_CDR (s);
|
||||||
}
|
}
|
||||||
if (SCM_FALSEP (prev))
|
if (scm_is_false (prev))
|
||||||
return SCM_CDR (cell);
|
return SCM_CDR (cell);
|
||||||
else
|
else
|
||||||
{
|
{
|
||||||
|
@ -184,7 +184,7 @@ really_install_handler (void *data)
|
||||||
|
|
||||||
/* Make sure we have a cell. */
|
/* Make sure we have a cell. */
|
||||||
cell = SCM_VECTOR_REF (signal_handler_cells, signum);
|
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);
|
cell = scm_cons (SCM_BOOL_F, SCM_EOL);
|
||||||
SCM_VECTOR_SET (signal_handler_cells, signum, cell);
|
SCM_VECTOR_SET (signal_handler_cells, signum, cell);
|
||||||
|
@ -195,12 +195,12 @@ really_install_handler (void *data)
|
||||||
if (!SCM_EQ_P (thread, old_thread))
|
if (!SCM_EQ_P (thread, old_thread))
|
||||||
{
|
{
|
||||||
scm_root_state *r;
|
scm_root_state *r;
|
||||||
if (!SCM_FALSEP (old_thread))
|
if (scm_is_true (old_thread))
|
||||||
{
|
{
|
||||||
r = scm_i_thread_root (old_thread);
|
r = scm_i_thread_root (old_thread);
|
||||||
r->signal_asyncs = scm_delq_spine_x (cell, r->signal_asyncs);
|
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);
|
r = scm_i_thread_root (thread);
|
||||||
SCM_SETCDR (cell, r->signal_asyncs);
|
SCM_SETCDR (cell, r->signal_asyncs);
|
||||||
|
@ -214,7 +214,7 @@ really_install_handler (void *data)
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Set the new handler. */
|
/* 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_handlers, signum, SCM_BOOL_F);
|
||||||
SCM_VECTOR_SET (signal_cell_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
|
following code will install the new handler, so we have no
|
||||||
problem.
|
problem.
|
||||||
*/
|
*/
|
||||||
if (!SCM_FALSEP (SCM_CAR (cell)))
|
if (scm_is_true (SCM_CAR (cell)))
|
||||||
SCM_SETCAR (cell, SCM_VECTOR_REF (signal_cell_handlers, signum));
|
SCM_SETCAR (cell, SCM_VECTOR_REF (signal_cell_handlers, signum));
|
||||||
|
|
||||||
/* Phfew. That should be it. */
|
/* Phfew. That should be it. */
|
||||||
|
@ -346,7 +346,7 @@ SCM_DEFINE (scm_sigaction_for_thread, "sigaction", 1, 3, 0,
|
||||||
else
|
else
|
||||||
SCM_OUT_OF_RANGE (2, handler);
|
SCM_OUT_OF_RANGE (2, handler);
|
||||||
}
|
}
|
||||||
else if (SCM_FALSEP (handler))
|
else if (scm_is_false (handler))
|
||||||
{
|
{
|
||||||
/* restore the default handler. */
|
/* restore the default handler. */
|
||||||
#ifdef HAVE_SIGACTION
|
#ifdef HAVE_SIGACTION
|
||||||
|
|
|
@ -605,7 +605,7 @@ scm_compile_shell_switches (int argc, char **argv)
|
||||||
scm_set_program_arguments (argc ? argc - i : 0, argv + i, argv0);
|
scm_set_program_arguments (argc ? argc - i : 0, argv + i, argv0);
|
||||||
|
|
||||||
/* If the --emacs switch was set, now is when we process it. */
|
/* 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. */
|
/* Handle the `-e' switch, if it was specified. */
|
||||||
if (!SCM_NULLP (entry_point))
|
if (!SCM_NULLP (entry_point))
|
||||||
|
|
|
@ -68,7 +68,7 @@ SCM_DEFINE (scm_system, "system", 0, 1, 0,
|
||||||
if (SCM_UNBNDP (cmd))
|
if (SCM_UNBNDP (cmd))
|
||||||
{
|
{
|
||||||
rv = system (NULL);
|
rv = system (NULL);
|
||||||
return SCM_BOOL(rv);
|
return scm_from_bool(rv);
|
||||||
}
|
}
|
||||||
SCM_VALIDATE_STRING (1, cmd);
|
SCM_VALIDATE_STRING (1, cmd);
|
||||||
errno = 0;
|
errno = 0;
|
||||||
|
|
|
@ -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;
|
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]);
|
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]);
|
SWAP (base_ptr[mid], base_ptr[hi]);
|
||||||
else
|
else
|
||||||
goto jump_over;
|
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]);
|
SWAP (base_ptr[mid], base_ptr[lo]);
|
||||||
jump_over:;
|
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. */
|
that this algorithm runs much faster than others. */
|
||||||
do
|
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++;
|
left++;
|
||||||
/* The comparison predicate may be buggy */
|
/* 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);
|
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--;
|
right--;
|
||||||
/* The comparison predicate may be buggy */
|
/* 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. */
|
and the operation speeds up insertion sort's inner loop. */
|
||||||
|
|
||||||
for (run = tmp + 1; run <= thresh; run++)
|
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;
|
tmp = run;
|
||||||
|
|
||||||
if (tmp != 0)
|
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)
|
while (++run <= end)
|
||||||
{
|
{
|
||||||
tmp = run - 1;
|
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 */
|
/* The comparison predicate may be buggy */
|
||||||
if (tmp == 0)
|
if (tmp == 0)
|
||||||
|
@ -343,7 +343,7 @@ SCM_DEFINE (scm_sorted_p, "sorted?", 2, 0, 0,
|
||||||
j = len - 1;
|
j = len - 1;
|
||||||
while (j > 0)
|
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;
|
return SCM_BOOL_F;
|
||||||
else
|
else
|
||||||
{
|
{
|
||||||
|
@ -363,7 +363,7 @@ SCM_DEFINE (scm_sorted_p, "sorted?", 2, 0, 0,
|
||||||
j = len - 1;
|
j = len - 1;
|
||||||
while (j > 0)
|
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;
|
return SCM_BOOL_F;
|
||||||
else
|
else
|
||||||
{
|
{
|
||||||
|
@ -409,7 +409,7 @@ SCM_DEFINE (scm_merge, "merge", 3, 0, 0,
|
||||||
|
|
||||||
SCM_VALIDATE_NONEMPTYLIST_COPYLEN (1, alist, alen);
|
SCM_VALIDATE_NONEMPTYLIST_COPYLEN (1, alist, alen);
|
||||||
SCM_VALIDATE_NONEMPTYLIST_COPYLEN (2, blist, blen);
|
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);
|
build = scm_cons (SCM_CAR (blist), SCM_EOL);
|
||||||
blist = SCM_CDR (blist);
|
blist = SCM_CDR (blist);
|
||||||
|
@ -424,7 +424,7 @@ SCM_DEFINE (scm_merge, "merge", 3, 0, 0,
|
||||||
last = build;
|
last = build;
|
||||||
while ((alen > 0) && (blen > 0))
|
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));
|
SCM_SETCDR (last, scm_cons (SCM_CAR (blist), SCM_EOL));
|
||||||
blist = SCM_CDR (blist);
|
blist = SCM_CDR (blist);
|
||||||
|
@ -461,7 +461,7 @@ scm_merge_list_x (SCM alist, SCM blist,
|
||||||
return alist;
|
return alist;
|
||||||
else
|
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;
|
build = blist;
|
||||||
blist = SCM_CDR (blist);
|
blist = SCM_CDR (blist);
|
||||||
|
@ -476,7 +476,7 @@ scm_merge_list_x (SCM alist, SCM blist,
|
||||||
last = build;
|
last = build;
|
||||||
while ((alen > 0) && (blen > 0))
|
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);
|
SCM_SETCDR (last, blist);
|
||||||
blist = SCM_CDR (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));
|
SCM y = SCM_CAR (SCM_CDR (*seq));
|
||||||
*seq = SCM_CDR (rest);
|
*seq = SCM_CDR (rest);
|
||||||
SCM_SETCDR (rest, SCM_EOL);
|
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 (p, y);
|
||||||
SCM_SETCAR (rest, x);
|
SCM_SETCAR (rest, x);
|
||||||
|
@ -668,7 +668,7 @@ scm_merge_vector_x (SCM vec,
|
||||||
*/
|
*/
|
||||||
register SCM *vp = SCM_WRITABLE_VELTS(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++];
|
temp[it] = vp[i2++];
|
||||||
else
|
else
|
||||||
temp[it] = vp[i1++];
|
temp[it] = vp[i1++];
|
||||||
|
|
|
@ -143,7 +143,7 @@ scm_srcprops_to_plist (SCM obj)
|
||||||
plist = scm_acons (scm_sym_filename, SRCPROPFNAME (obj), plist);
|
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_column, SCM_MAKINUM (SRCPROPCOL (obj)), plist);
|
||||||
plist = scm_acons (scm_sym_line, SCM_MAKINUM (SRCPROPLINE (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;
|
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);
|
p = scm_hashq_ref (scm_source_whash, obj, SCM_EOL);
|
||||||
if (!SRCPROPSP (p))
|
if (!SRCPROPSP (p))
|
||||||
goto plist;
|
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_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_column, key)) p = SCM_MAKINUM (SRCPROPCOL (p));
|
||||||
else if (SCM_EQ_P (scm_sym_filename, key)) p = SRCPROPFNAME (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 (SRCPROPSP (p))
|
||||||
{
|
{
|
||||||
if (SCM_FALSEP (datum))
|
if (scm_is_false (datum))
|
||||||
CLEARSRCPROPBRK (p);
|
CLEARSRCPROPBRK (p);
|
||||||
else
|
else
|
||||||
SETSRCPROPBRK (p);
|
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 sp = scm_make_srcprops (0, 0, SCM_UNDEFINED, SCM_UNDEFINED, p);
|
||||||
SCM_WHASHSET (scm_source_whash, h, sp);
|
SCM_WHASHSET (scm_source_whash, h, sp);
|
||||||
if (SCM_FALSEP (datum))
|
if (scm_is_false (datum))
|
||||||
CLEARSRCPROPBRK (sp);
|
CLEARSRCPROPBRK (sp);
|
||||||
else
|
else
|
||||||
SETSRCPROPBRK (sp);
|
SETSRCPROPBRK (sp);
|
||||||
|
|
|
@ -35,7 +35,7 @@
|
||||||
#define scm_whash_handle SCM
|
#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_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_WHASHREF(whash, handle) SCM_CDR (handle)
|
||||||
#define SCM_WHASHSET(whash, handle, obj) SCM_SETCDR (handle, obj)
|
#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)
|
#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 SETSRCPROPLINE(p, l) SETSRCPROPPOS (p, l, SRCPROPCOL (p))
|
||||||
#define SETSRCPROPCOL(p, c) SETSRCPROPPOS (p, SRCPROPLINE (p), c)
|
#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_filename;
|
||||||
SCM_API SCM scm_sym_copy;
|
SCM_API SCM scm_sym_copy;
|
||||||
|
|
|
@ -205,7 +205,7 @@ do { \
|
||||||
&& SCM_EQ_P (SCM_MEMOIZED_EXP (iframe->source), applybody)) \
|
&& SCM_EQ_P (SCM_MEMOIZED_EXP (iframe->source), applybody)) \
|
||||||
{ \
|
{ \
|
||||||
iframe->source = SCM_BOOL_F; \
|
iframe->source = SCM_BOOL_F; \
|
||||||
if (SCM_FALSEP (iframe->proc)) \
|
if (scm_is_false (iframe->proc)) \
|
||||||
{ \
|
{ \
|
||||||
--iframe; \
|
--iframe; \
|
||||||
++n; \
|
++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;
|
SCM m = s->frames[i].source;
|
||||||
if (SCM_MEMOIZEDP (m)
|
if (SCM_MEMOIZEDP (m)
|
||||||
&& !SCM_IMP (SCM_MEMOIZED_ENV (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 */
|
/* Back up in order to include any non-source frames */
|
||||||
while (i > 0)
|
while (i > 0)
|
||||||
|
@ -342,8 +342,8 @@ narrow_stack (SCM stack, long inner, SCM inner_key, long outer, SCM outer_key)
|
||||||
break;
|
break;
|
||||||
|
|
||||||
m = s->frames[i - 1].proc;
|
m = s->frames[i - 1].proc;
|
||||||
if (!SCM_FALSEP (scm_procedure_p (m))
|
if (scm_is_true (scm_procedure_p (m))
|
||||||
&& !SCM_FALSEP (scm_procedure_property
|
&& scm_is_true (scm_procedure_property
|
||||||
(m, scm_sym_system_procedure)))
|
(m, scm_sym_system_procedure)))
|
||||||
break;
|
break;
|
||||||
|
|
||||||
|
@ -384,7 +384,7 @@ SCM_DEFINE (scm_stack_p, "stack?", 1, 0, 0,
|
||||||
"Return @code{#t} if @var{obj} is a calling stack.")
|
"Return @code{#t} if @var{obj} is a calling stack.")
|
||||||
#define FUNC_NAME s_scm_stack_p
|
#define FUNC_NAME s_scm_stack_p
|
||||||
{
|
{
|
||||||
return SCM_BOOL(SCM_STACKP (obj));
|
return scm_from_bool(SCM_STACKP (obj));
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#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.")
|
"Return @code{#t} if @var{obj} is a stack frame.")
|
||||||
#define FUNC_NAME s_scm_frame_p
|
#define FUNC_NAME s_scm_frame_p
|
||||||
{
|
{
|
||||||
return SCM_BOOL(SCM_FRAMEP (obj));
|
return scm_from_bool(SCM_FRAMEP (obj));
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#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
|
#define FUNC_NAME s_scm_frame_real_p
|
||||||
{
|
{
|
||||||
SCM_VALIDATE_FRAME (1, frame);
|
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
|
#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
|
#define FUNC_NAME s_scm_frame_procedure_p
|
||||||
{
|
{
|
||||||
SCM_VALIDATE_FRAME (1, frame);
|
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
|
#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
|
#define FUNC_NAME s_scm_frame_evaluating_args_p
|
||||||
{
|
{
|
||||||
SCM_VALIDATE_FRAME (1, frame);
|
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
|
#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
|
#define FUNC_NAME s_scm_frame_overflow_p
|
||||||
{
|
{
|
||||||
SCM_VALIDATE_FRAME (1, frame);
|
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
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
|
|
@ -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_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);
|
sbd_time, pos, subr);
|
||||||
|
|
||||||
lt->tm_sec = SCM_INUM (velts[0]);
|
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]);
|
lt->tm_isdst = SCM_INUM (velts[8]);
|
||||||
#ifdef HAVE_TM_ZONE
|
#ifdef HAVE_TM_ZONE
|
||||||
lt->tm_gmtoff = SCM_INUM (velts[9]);
|
lt->tm_gmtoff = SCM_INUM (velts[9]);
|
||||||
if (SCM_FALSEP (velts[10]))
|
if (scm_is_false (velts[10]))
|
||||||
lt->tm_zone = NULL;
|
lt->tm_zone = NULL;
|
||||||
else
|
else
|
||||||
lt->tm_zone = SCM_STRING_CHARS (velts[10]);
|
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);
|
SCM *velts = (SCM *) SCM_VELTS (stime);
|
||||||
int have_zone = 0;
|
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's not required that the TZ setting be correct, just that
|
||||||
it has the right name. so try something like TZ=EST0.
|
it has the right name. so try something like TZ=EST0.
|
||||||
|
|
|
@ -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}.")
|
"Return @code{#t} if @var{obj} is a string, else @code{#f}.")
|
||||||
#define FUNC_NAME s_scm_string_p
|
#define FUNC_NAME s_scm_string_p
|
||||||
{
|
{
|
||||||
return SCM_BOOL (SCM_STRINGP (obj));
|
return scm_from_bool (SCM_STRINGP (obj));
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
|
|
@ -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_STRINGP (*str), *str, SCM_ARG1, why);
|
||||||
SCM_ASSERT (SCM_CHARP (chr), chr, SCM_ARG2, 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);
|
sub_start = SCM_MAKINUM (0);
|
||||||
|
|
||||||
SCM_ASSERT (SCM_INUMP (sub_start), sub_start, SCM_ARG3, why);
|
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))
|
if (lower < 0 || lower > SCM_STRING_LENGTH (*str))
|
||||||
scm_out_of_range (why, sub_start);
|
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));
|
sub_end = SCM_MAKINUM (SCM_STRING_LENGTH (*str));
|
||||||
|
|
||||||
SCM_ASSERT (SCM_INUMP (sub_end), sub_end, SCM_ARG4, why);
|
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
|
#define FUNC_NAME s_scm_string_null_p
|
||||||
{
|
{
|
||||||
SCM_VALIDATE_STRING (1, str);
|
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
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
@ -394,7 +394,7 @@ string_capitalize_x (SCM str)
|
||||||
len = SCM_STRING_LENGTH(str);
|
len = SCM_STRING_LENGTH(str);
|
||||||
sz = SCM_STRING_UCHARS (str);
|
sz = SCM_STRING_UCHARS (str);
|
||||||
for(i=0; i<len; i++) {
|
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) {
|
if(!in_word) {
|
||||||
sz[i] = scm_c_upcase(sz[i]);
|
sz[i] = scm_c_upcase(sz[i]);
|
||||||
in_word = 1;
|
in_word = 1;
|
||||||
|
|
|
@ -120,7 +120,7 @@ string_less_p (SCM s1, SCM s2)
|
||||||
if (c > 0) return SCM_BOOL_F;
|
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 (1, s1);
|
||||||
SCM_VALIDATE_STRING (2, s2);
|
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
|
#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 (1, s1);
|
||||||
SCM_VALIDATE_STRING (2, s2);
|
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
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
@ -200,7 +200,7 @@ string_ci_less_p (SCM s1, SCM s2)
|
||||||
if (c > 0) return SCM_BOOL_F;
|
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 (1, s1);
|
||||||
SCM_VALIDATE_STRING (2, s2);
|
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
|
#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 (1, s1);
|
||||||
SCM_VALIDATE_STRING (2, s2);
|
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
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
|
|
@ -222,7 +222,7 @@ SCM_DEFINE (scm_struct_p, "struct?", 1, 0, 0,
|
||||||
"@code{#f}.")
|
"@code{#f}.")
|
||||||
#define FUNC_NAME s_scm_struct_p
|
#define FUNC_NAME s_scm_struct_p
|
||||||
{
|
{
|
||||||
return SCM_BOOL(SCM_STRUCTP (x));
|
return scm_from_bool(SCM_STRUCTP (x));
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
@ -248,7 +248,7 @@ SCM_DEFINE (scm_struct_vtable_p, "struct-vtable?", 1, 0, 0,
|
||||||
|
|
||||||
mem = SCM_STRUCT_DATA (x);
|
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
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
@ -726,7 +726,7 @@ scm_struct_create_handle (SCM obj)
|
||||||
scm_struct_ihashq,
|
scm_struct_ihashq,
|
||||||
scm_sloppy_assq,
|
scm_sloppy_assq,
|
||||||
0);
|
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));
|
SCM_SETCDR (handle, scm_cons (SCM_BOOL_F, SCM_BOOL_F));
|
||||||
return handle;
|
return handle;
|
||||||
}
|
}
|
||||||
|
@ -760,14 +760,14 @@ SCM_DEFINE (scm_set_struct_vtable_name_x, "set-struct-vtable-name!", 2, 0, 0,
|
||||||
void
|
void
|
||||||
scm_print_struct (SCM exp, SCM port, scm_print_state *pstate)
|
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);
|
scm_printer_apply (SCM_STRUCT_PRINTER (exp), exp, port, pstate);
|
||||||
else
|
else
|
||||||
{
|
{
|
||||||
SCM vtable = SCM_STRUCT_VTABLE (exp);
|
SCM vtable = SCM_STRUCT_VTABLE (exp);
|
||||||
SCM name = scm_struct_vtable_name (vtable);
|
SCM name = scm_struct_vtable_name (vtable);
|
||||||
scm_puts ("#<", port);
|
scm_puts ("#<", port);
|
||||||
if (SCM_NFALSEP (name))
|
if (scm_is_true (name))
|
||||||
scm_display (name, port);
|
scm_display (name, port);
|
||||||
else
|
else
|
||||||
scm_puts ("struct", port);
|
scm_puts ("struct", port);
|
||||||
|
|
|
@ -162,7 +162,7 @@ SCM_DEFINE (scm_symbol_p, "symbol?", 1, 0, 0,
|
||||||
"@code{#f}.")
|
"@code{#f}.")
|
||||||
#define FUNC_NAME s_scm_symbol_p
|
#define FUNC_NAME s_scm_symbol_p
|
||||||
{
|
{
|
||||||
return SCM_BOOL (SCM_SYMBOLP (obj));
|
return scm_from_bool (SCM_SYMBOLP (obj));
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#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
|
#define FUNC_NAME s_scm_symbol_interned_p
|
||||||
{
|
{
|
||||||
SCM_VALIDATE_SYMBOL (1, symbol);
|
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
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
|
|
@ -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.")
|
"All the evaluation rules for dynamic roots apply to threads.")
|
||||||
#define FUNC_NAME s_scm_call_with_new_thread
|
#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_is_true (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_procedure_p (handler)), handler, SCM_ARG2,
|
||||||
FUNC_NAME);
|
FUNC_NAME);
|
||||||
|
|
||||||
return create_thread ((scm_t_catch_body) scm_call_0, thunk,
|
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.")
|
"Move the calling thread to the end of the scheduling queue.")
|
||||||
#define FUNC_NAME s_scm_yield
|
#define FUNC_NAME s_scm_yield
|
||||||
{
|
{
|
||||||
return SCM_BOOL (scm_thread_yield ());
|
return scm_from_bool (scm_thread_yield ());
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
@ -592,7 +592,7 @@ fair_mutex_unlock (fair_mutex *m)
|
||||||
else
|
else
|
||||||
{
|
{
|
||||||
SCM next = dequeue (m->waiting);
|
SCM next = dequeue (m->waiting);
|
||||||
if (!SCM_FALSEP (next))
|
if (scm_is_true (next))
|
||||||
{
|
{
|
||||||
m->owner = next;
|
m->owner = next;
|
||||||
unblock (SCM_THREAD_DATA (next));
|
unblock (SCM_THREAD_DATA (next));
|
||||||
|
@ -667,7 +667,7 @@ fair_cond_signal (fair_cond *c)
|
||||||
{
|
{
|
||||||
SCM th;
|
SCM th;
|
||||||
scm_i_plugin_mutex_lock (&c->lock);
|
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));
|
unblock (SCM_THREAD_DATA (th));
|
||||||
scm_i_plugin_mutex_unlock (&c->lock);
|
scm_i_plugin_mutex_unlock (&c->lock);
|
||||||
return 0;
|
return 0;
|
||||||
|
@ -678,7 +678,7 @@ fair_cond_broadcast (fair_cond *c)
|
||||||
{
|
{
|
||||||
SCM th;
|
SCM th;
|
||||||
scm_i_plugin_mutex_lock (&c->lock);
|
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));
|
unblock (SCM_THREAD_DATA (th));
|
||||||
scm_i_plugin_mutex_unlock (&c->lock);
|
scm_i_plugin_mutex_unlock (&c->lock);
|
||||||
return 0;
|
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")
|
"Return @code{#t} iff @var{thread} has exited.\n")
|
||||||
#define FUNC_NAME s_scm_thread_exited_p
|
#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
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
|
|
@ -374,7 +374,7 @@ scm_exit_status (SCM args)
|
||||||
|
|
||||||
if (SCM_INUMP (cqa))
|
if (SCM_INUMP (cqa))
|
||||||
return (SCM_INUM (cqa));
|
return (SCM_INUM (cqa));
|
||||||
else if (SCM_FALSEP (cqa))
|
else if (scm_is_false (cqa))
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
return 0;
|
return 0;
|
||||||
|
@ -395,7 +395,7 @@ handler_message (void *handler_data, SCM tag, SCM args)
|
||||||
SCM parts = SCM_CADDR (args);
|
SCM parts = SCM_CADDR (args);
|
||||||
SCM rest = SCM_CDDDR (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_puts ("Backtrace:\n", p);
|
||||||
scm_display_backtrace (stack, p, SCM_UNDEFINED, SCM_UNDEFINED);
|
scm_display_backtrace (stack, p, SCM_UNDEFINED, SCM_UNDEFINED);
|
||||||
|
@ -444,7 +444,7 @@ handler_message (void *handler_data, SCM tag, SCM args)
|
||||||
SCM
|
SCM
|
||||||
scm_handle_by_message (void *handler_data, SCM tag, SCM args)
|
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));
|
exit (scm_exit_status (args));
|
||||||
}
|
}
|
||||||
|
|
|
@ -263,7 +263,7 @@ SCM_DEFINE (scm_array_p, "array?", 1, 1, 0,
|
||||||
v = SCM_ARRAY_V (v);
|
v = SCM_ARRAY_V (v);
|
||||||
}
|
}
|
||||||
if (nprot)
|
if (nprot)
|
||||||
return SCM_BOOL(nprot);
|
return scm_from_bool(nprot);
|
||||||
else
|
else
|
||||||
{
|
{
|
||||||
int protp = 0;
|
int protp = 0;
|
||||||
|
@ -316,7 +316,7 @@ SCM_DEFINE (scm_array_p, "array?", 1, 1, 0,
|
||||||
/* no default */
|
/* no default */
|
||||||
;
|
;
|
||||||
}
|
}
|
||||||
return SCM_BOOL(protp);
|
return scm_from_bool(protp);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
@ -1038,7 +1038,7 @@ tail:
|
||||||
{
|
{
|
||||||
unsigned long int length = SCM_INUM (scm_uniform_vector_length (v));
|
unsigned long int length = SCM_INUM (scm_uniform_vector_length (v));
|
||||||
SCM_ASRTGO (SCM_NULLP (args) && SCM_INUMP (ind), wna);
|
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 */
|
case scm_tc7_smob: /* enclosed */
|
||||||
goto badarg1;
|
goto badarg1;
|
||||||
case scm_tc7_bvect:
|
case scm_tc7_bvect:
|
||||||
if (SCM_FALSEP (obj))
|
if (scm_is_false (obj))
|
||||||
SCM_BITVEC_CLR(v, pos);
|
SCM_BITVEC_CLR(v, pos);
|
||||||
else if (SCM_EQ_P (obj, SCM_BOOL_T))
|
else if (SCM_EQ_P (obj, SCM_BOOL_T))
|
||||||
SCM_BITVEC_SET(v, pos);
|
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 count = 0;
|
||||||
unsigned long int i = (SCM_BITVECTOR_LENGTH (bitvector) - 1) / SCM_LONG_BIT;
|
unsigned long int i = (SCM_BITVECTOR_LENGTH (bitvector) - 1) / SCM_LONG_BIT;
|
||||||
unsigned long int w = SCM_UNPACK (SCM_VELTS (bitvector)[i]);
|
unsigned long int w = SCM_UNPACK (SCM_VELTS (bitvector)[i]);
|
||||||
if (SCM_FALSEP (b)) {
|
if (scm_is_false (b)) {
|
||||||
w = ~w;
|
w = ~w;
|
||||||
};
|
};
|
||||||
w <<= SCM_LONG_BIT - 1 - ((SCM_BITVECTOR_LENGTH (bitvector) - 1) % SCM_LONG_BIT);
|
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 {
|
} else {
|
||||||
--i;
|
--i;
|
||||||
w = SCM_UNPACK (SCM_VELTS (bitvector)[i]);
|
w = SCM_UNPACK (SCM_VELTS (bitvector)[i]);
|
||||||
if (SCM_FALSEP (b)) {
|
if (scm_is_false (b)) {
|
||||||
w = ~w;
|
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 */
|
lenw = (SCM_BITVECTOR_LENGTH (v) - 1) / SCM_LONG_BIT; /* watch for part words */
|
||||||
i = pos / SCM_LONG_BIT;
|
i = pos / SCM_LONG_BIT;
|
||||||
w = SCM_UNPACK (SCM_VELTS (v)[i]);
|
w = SCM_UNPACK (SCM_VELTS (v)[i]);
|
||||||
if (SCM_FALSEP (item))
|
if (scm_is_false (item))
|
||||||
w = ~w;
|
w = ~w;
|
||||||
xbits = (pos % SCM_LONG_BIT);
|
xbits = (pos % SCM_LONG_BIT);
|
||||||
pos -= xbits;
|
pos -= xbits;
|
||||||
|
@ -1847,7 +1847,7 @@ SCM_DEFINE (scm_bit_position, "bit-position", 3, 0, 0,
|
||||||
break;
|
break;
|
||||||
pos += SCM_LONG_BIT;
|
pos += SCM_LONG_BIT;
|
||||||
w = SCM_UNPACK (SCM_VELTS (v)[i]);
|
w = SCM_UNPACK (SCM_VELTS (v)[i]);
|
||||||
if (SCM_FALSEP (item))
|
if (scm_is_false (item))
|
||||||
w = ~w;
|
w = ~w;
|
||||||
}
|
}
|
||||||
return SCM_BOOL_F;
|
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);
|
badarg2:SCM_WRONG_TYPE_ARG (2, kv);
|
||||||
case scm_tc7_uvect:
|
case scm_tc7_uvect:
|
||||||
vlen = SCM_BITVECTOR_LENGTH (v);
|
vlen = SCM_BITVECTOR_LENGTH (v);
|
||||||
if (SCM_FALSEP (obj))
|
if (scm_is_false (obj))
|
||||||
for (i = SCM_UVECTOR_LENGTH (kv); i;)
|
for (i = SCM_UVECTOR_LENGTH (kv); i;)
|
||||||
{
|
{
|
||||||
k = SCM_UNPACK (SCM_VELTS (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;
|
break;
|
||||||
case scm_tc7_bvect:
|
case scm_tc7_bvect:
|
||||||
SCM_ASSERT (SCM_BITVECTOR_LENGTH (v) == SCM_BITVECTOR_LENGTH (kv), v, SCM_ARG1, FUNC_NAME);
|
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--;)
|
for (k = (SCM_BITVECTOR_LENGTH (v) + SCM_LONG_BIT - 1) / SCM_LONG_BIT; k--;)
|
||||||
SCM_BITVECTOR_BASE (v) [k] &= ~SCM_BITVECTOR_BASE (kv) [k];
|
SCM_BITVECTOR_BASE (v) [k] &= ~SCM_BITVECTOR_BASE (kv) [k];
|
||||||
else if (SCM_EQ_P (obj, SCM_BOOL_T))
|
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);
|
SCM_WRONG_TYPE_ARG (2, kv);
|
||||||
case scm_tc7_uvect:
|
case scm_tc7_uvect:
|
||||||
vlen = SCM_BITVECTOR_LENGTH (v);
|
vlen = SCM_BITVECTOR_LENGTH (v);
|
||||||
if (SCM_FALSEP (obj))
|
if (scm_is_false (obj))
|
||||||
for (i = SCM_UVECTOR_LENGTH (kv); i;)
|
for (i = SCM_UVECTOR_LENGTH (kv); i;)
|
||||||
{
|
{
|
||||||
k = SCM_UNPACK (SCM_VELTS (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);
|
SCM_ASSERT (SCM_BITVECTOR_LENGTH (v) == SCM_BITVECTOR_LENGTH (kv), v, SCM_ARG1, FUNC_NAME);
|
||||||
if (0 == SCM_BITVECTOR_LENGTH (v))
|
if (0 == SCM_BITVECTOR_LENGTH (v))
|
||||||
return SCM_INUM0;
|
return SCM_INUM0;
|
||||||
SCM_ASRTGO (SCM_BOOLP (obj), badarg3);
|
SCM_ASRTGO (scm_is_bool (obj), badarg3);
|
||||||
fObj = SCM_EQ_P (obj, SCM_BOOL_T);
|
fObj = SCM_EQ_P (obj, SCM_BOOL_T);
|
||||||
i = (SCM_BITVECTOR_LENGTH (v) - 1) / SCM_LONG_BIT;
|
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]));
|
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;
|
register unsigned long mask;
|
||||||
for (k = (SCM_BITVECTOR_LENGTH (v) - 1) / SCM_LONG_BIT; k > 0; k--)
|
for (k = (SCM_BITVECTOR_LENGTH (v) - 1) / SCM_LONG_BIT; k > 0; k--)
|
||||||
for (mask = 1UL << (SCM_LONG_BIT - 1); mask; mask >>= 1)
|
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)
|
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;
|
return res;
|
||||||
}
|
}
|
||||||
case scm_tc7_byvect:
|
case scm_tc7_byvect:
|
||||||
|
|
|
@ -135,11 +135,14 @@
|
||||||
|
|
||||||
#define SCM_VALIDATE_NIM(pos, scm) SCM_MAKE_VALIDATE_MSG (pos, scm, NIMP, "non-immediate")
|
#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) \
|
#define SCM_VALIDATE_BOOL_COPY(pos, flag, cvar) \
|
||||||
do { \
|
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; \
|
cvar = SCM_EQ_P (flag, SCM_BOOL_T) ? 1 : 0; \
|
||||||
} while (0)
|
} while (0)
|
||||||
|
|
||||||
|
@ -358,7 +361,7 @@
|
||||||
|
|
||||||
#define SCM_VALIDATE_THUNK(pos, thunk) \
|
#define SCM_VALIDATE_THUNK(pos, thunk) \
|
||||||
do { \
|
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)
|
} while (0)
|
||||||
|
|
||||||
#define SCM_VALIDATE_SYMBOL(pos, sym) SCM_MAKE_VALIDATE_MSG (pos, sym, SYMBOLP, "symbol")
|
#define SCM_VALIDATE_SYMBOL(pos, sym) SCM_MAKE_VALIDATE_MSG (pos, sym, SYMBOLP, "symbol")
|
||||||
|
@ -427,7 +430,7 @@
|
||||||
#define SCM_VALIDATE_ARRAY(pos, v) \
|
#define SCM_VALIDATE_ARRAY(pos, v) \
|
||||||
do { \
|
do { \
|
||||||
SCM_ASSERT (!SCM_IMP (v) \
|
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); \
|
v, pos, FUNC_NAME); \
|
||||||
} while (0)
|
} while (0)
|
||||||
|
|
||||||
|
@ -444,7 +447,7 @@
|
||||||
|
|
||||||
#define SCM_VALIDATE_VTABLE(pos, v) \
|
#define SCM_VALIDATE_VTABLE(pos, v) \
|
||||||
do { \
|
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); \
|
v, pos, FUNC_NAME); \
|
||||||
} while (0)
|
} while (0)
|
||||||
|
|
||||||
|
|
|
@ -73,7 +73,7 @@ SCM_DEFINE (scm_variable_p, "variable?", 1, 0, 0,
|
||||||
"return @code{#f}.")
|
"return @code{#f}.")
|
||||||
#define FUNC_NAME s_scm_variable_p
|
#define FUNC_NAME s_scm_variable_p
|
||||||
{
|
{
|
||||||
return SCM_BOOL (SCM_VARIABLEP (obj));
|
return scm_from_bool (SCM_VARIABLEP (obj));
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#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
|
#define FUNC_NAME s_scm_variable_bound_p
|
||||||
{
|
{
|
||||||
SCM_VALIDATE_VARIABLE (1, var);
|
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
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
|
|
@ -35,7 +35,7 @@ SCM_DEFINE (scm_vector_p, "vector?", 1, 0, 0,
|
||||||
"@code{#f}.")
|
"@code{#f}.")
|
||||||
#define FUNC_NAME s_scm_vector_p
|
#define FUNC_NAME s_scm_vector_p
|
||||||
{
|
{
|
||||||
return SCM_BOOL (SCM_VECTORP (obj));
|
return scm_from_bool (SCM_VECTORP (obj));
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
@ -245,7 +245,7 @@ scm_vector_equal_p(SCM x, SCM y)
|
||||||
{
|
{
|
||||||
long i;
|
long i;
|
||||||
for(i = SCM_VECTOR_LENGTH (x) - 1; i >= 0; 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_F;
|
||||||
return SCM_BOOL_T;
|
return SCM_BOOL_T;
|
||||||
}
|
}
|
||||||
|
|
|
@ -65,7 +65,7 @@ sf_flush (SCM port)
|
||||||
{
|
{
|
||||||
SCM f = SCM_VELTS (stream)[2];
|
SCM f = SCM_VELTS (stream)[2];
|
||||||
|
|
||||||
if (!SCM_FALSEP (f))
|
if (scm_is_true (f))
|
||||||
scm_call_0 (f);
|
scm_call_0 (f);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
@ -91,7 +91,7 @@ sf_fill_input (SCM port)
|
||||||
SCM ans;
|
SCM ans;
|
||||||
|
|
||||||
ans = scm_call_0 (SCM_VELTS (p)[3]); /* get char. */
|
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;
|
return EOF;
|
||||||
SCM_ASSERT (SCM_CHARP (ans), ans, SCM_ARG1, "sf_fill_input");
|
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 p = SCM_PACK (SCM_STREAM (port));
|
||||||
SCM f = SCM_VELTS (p)[4];
|
SCM f = SCM_VELTS (p)[4];
|
||||||
if (SCM_FALSEP (f))
|
if (scm_is_false (f))
|
||||||
return 0;
|
return 0;
|
||||||
f = scm_call_0 (f);
|
f = scm_call_0 (f);
|
||||||
errno = 0;
|
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)
|
if (SCM_VECTOR_LENGTH (p) >= 6)
|
||||||
{
|
{
|
||||||
SCM f = SCM_VELTS (p)[5];
|
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);
|
return scm_num2int (scm_call_0 (f), SCM_ARGn, NULL);
|
||||||
}
|
}
|
||||||
/* Default is such that char-ready? for soft ports returns #t, as it
|
/* Default is such that char-ready? for soft ports returns #t, as it
|
||||||
|
|
|
@ -173,7 +173,7 @@ SCM_DEFINE (scm_weak_vector_p, "weak-vector?", 1, 0, 0,
|
||||||
"weak hashes are also weak vectors.")
|
"weak hashes are also weak vectors.")
|
||||||
#define FUNC_NAME s_scm_weak_vector_p
|
#define FUNC_NAME s_scm_weak_vector_p
|
||||||
{
|
{
|
||||||
return SCM_BOOL (SCM_WVECTP (obj) && !SCM_IS_WHVEC (obj));
|
return scm_from_bool (SCM_WVECTP (obj) && !SCM_IS_WHVEC (obj));
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#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.")
|
"nor a weak value hash table.")
|
||||||
#define FUNC_NAME s_scm_weak_key_alist_vector_p
|
#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
|
#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.")
|
"Return @code{#t} if @var{obj} is a weak value hash table.")
|
||||||
#define FUNC_NAME s_scm_weak_value_alist_vector_p
|
#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
|
#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.")
|
"Return @code{#t} if @var{obj} is a doubly weak hash table.")
|
||||||
#define FUNC_NAME s_scm_doubly_weak_alist_vector_p
|
#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
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue