1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00

* Removed SCM_TRUE_P since it may get confused with !SCM_FALSEP.

This commit is contained in:
Dirk Herrmann 2000-06-05 11:39:46 +00:00
parent 1f496b05af
commit 9a09deb1c3
16 changed files with 47 additions and 30 deletions

View file

@ -1,3 +1,20 @@
2000-06-05 Dirk Herrmann <D.Herrmann@tu-bs.de>
* boolean.h (SCM_TRUE_P): Removed, as people might use it as a
replacement for !SCM_FALSEP.
* backtrace.c (display_error_body), boolean.h (SCM_BOOLP), gc.c
(scm_unhash_name), gh_data.c (gh_module_lookup), load.c
(scm_primitive_load), print.c (scm_simple_format), procs.c
(scm_procedure_documentation), procs.h (SCM_TOP_LEVEL), ramap.c
(scm_array_fill_int), scmsigs.c (scm_sigaction), stacks.c
(narrow_stack, scm_make_stack, scm_stack_id), symbols.c
(scm_string_to_obarray_symbol), throw.c (scm_catch,
scm_lazy_catch, scm_ithrow), unif.c (scm_make_uve, scm_array_p,
scm_array_set_x, scm_bit_set_star_x, scm_bit_count_star),
validate.h (SCM_VALIDATE_BOOL_COPY, SCM_VALIDATE_PROC): Replace
uses of SCM_TRUE_P (x) with SCM_EQ_P (x, SCM_BOOL_T).
2000-06-04 Mikael Djurfeldt <mdj@thalamus.nada.kth.se>
* eval.c (scm_badformalsp): New static function.

View file

@ -183,7 +183,7 @@ display_error_body (struct display_error_args *a)
if (!SCM_MEMOIZEDP (source) && !SCM_FALSEP (prev_frame))
source = SCM_FRAME_SOURCE (prev_frame);
if (SCM_FRAME_PROC_P (current_frame)
&& SCM_TRUE_P (scm_procedure_p (SCM_FRAME_PROC (current_frame))))
&& SCM_EQ_P (scm_procedure_p (SCM_FRAME_PROC (current_frame)), SCM_BOOL_T))
pname = scm_procedure_name (SCM_FRAME_PROC (current_frame));
}
if (!SCM_ROSTRINGP (pname))

View file

@ -50,11 +50,10 @@
/* Boolean Values
*
*/
#define SCM_TRUE_P(x) (SCM_EQ_P ((x), SCM_BOOL_T))
#define SCM_FALSEP(x) (SCM_EQ_P ((x), SCM_BOOL_F))
#define SCM_NFALSEP(x) (!SCM_FALSEP (x))
#define SCM_BOOLP(x) (SCM_TRUE_P (x) || SCM_FALSEP (x))
#define SCM_BOOLP(x) (SCM_EQ_P ((x), SCM_BOOL_F) || SCM_EQ_P ((x), SCM_BOOL_T))
/* Convert from a C boolean to a SCM boolean value */
#define SCM_BOOL(f) ((f) ? SCM_BOOL_T : SCM_BOOL_F)

View file

@ -2071,7 +2071,7 @@ SCM_DEFINE (scm_unhash_name, "unhash-name", 1, 0, 0,
scm_bits_t word0 = SCM_CELL_WORD_0 (cell) - scm_tc3_cons_gloc;
SCM gloc_car = SCM_PACK (word0); /* access as gloc */
SCM vcell = SCM_CELL_OBJECT_1 (gloc_car);
if ((SCM_TRUE_P (name) || SCM_EQ_P (SCM_CAR (gloc_car), name))
if ((SCM_EQ_P (name, SCM_BOOL_T) || SCM_EQ_P (SCM_CAR (gloc_car), name))
&& (SCM_UNPACK (vcell) != 0) && (SCM_UNPACK (vcell) != 1))
{
SCM_SET_CELL_OBJECT_0 (cell, name);

View file

@ -693,7 +693,7 @@ SCM
gh_module_lookup (SCM vec, const char *sname)
{
SCM sym = gh_symbol2scm (sname);
if (SCM_TRUE_P (scm_symbol_bound_p (vec, sym)))
if (SCM_EQ_P (scm_symbol_bound_p (vec, sym), SCM_BOOL_T))
return scm_symbol_binding (vec, sym);
else
return SCM_UNDEFINED;

View file

@ -111,7 +111,7 @@ SCM_DEFINE (scm_primitive_load, "primitive-load", 1, 0, 0,
{
SCM hook = *scm_loc_load_hook;
SCM_VALIDATE_ROSTRING (1,filename);
SCM_ASSERT (SCM_FALSEP (hook) || (SCM_TRUE_P (scm_procedure_p (hook))),
SCM_ASSERT (SCM_FALSEP (hook) || (SCM_EQ_P (scm_procedure_p (hook), SCM_BOOL_T)),
hook, "value of %load-hook is neither a procedure nor #f",
FUNC_NAME);

View file

@ -957,7 +957,7 @@ SCM_DEFINE (scm_simple_format, "simple-format", 2, 0, 1,
char *start;
char *p;
if (SCM_TRUE_P (destination)) {
if (SCM_EQ_P (destination, SCM_BOOL_T)) {
destination = scm_cur_outp;
} else if (SCM_FALSEP (destination)) {
fReturnString = 1;

View file

@ -271,8 +271,9 @@ SCM_DEFINE (scm_procedure_documentation, "procedure-documentation", 1, 0, 0,
#define FUNC_NAME s_scm_procedure_documentation
{
SCM code;
SCM_ASSERT (SCM_TRUE_P (scm_procedure_p (proc)) && SCM_NIMP (proc) && SCM_TYP7 (proc) != scm_tc7_contin,
proc, SCM_ARG1, FUNC_NAME);
SCM_ASSERT (SCM_EQ_P (scm_procedure_p (proc), SCM_BOOL_T)
&& SCM_NIMP (proc) && SCM_TYP7 (proc) != scm_tc7_contin,
proc, SCM_ARG1, FUNC_NAME);
switch (SCM_TYP7 (proc))
{
case scm_tcs_closures:

View file

@ -91,7 +91,7 @@ typedef struct
+ scm_tc3_closure))
#define SCM_ENV(x) SCM_CDR(x)
#define SCM_SETENV(x, e) SCM_SETCDR (x, e)
#define SCM_TOP_LEVEL(SCM_ENV) (SCM_NULLP (SCM_ENV) || (SCM_TRUE_P (scm_procedure_p (SCM_CAR (SCM_ENV)))))
#define SCM_TOP_LEVEL(ENV) (SCM_NULLP (ENV) || (SCM_EQ_P (scm_procedure_p (SCM_CAR (ENV)), SCM_BOOL_T)))
/* Procedure-with-setter

View file

@ -515,7 +515,7 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore)
if ((base + n) % SCM_LONG_BIT) /* trailing partial word */
ve[i] &= (~0L << ((base + n) % SCM_LONG_BIT));
}
else if (SCM_TRUE_P (fill))
else if (SCM_EQ_P (fill, SCM_BOOL_T))
{
if (base % SCM_LONG_BIT)
ve[i++] |= ~0L << (base % SCM_LONG_BIT);
@ -532,7 +532,7 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore)
if (SCM_FALSEP (fill))
for (i = base; n--; i += inc)
ve[i / SCM_LONG_BIT] &= ~(1L << (i % SCM_LONG_BIT));
else if (SCM_TRUE_P (fill))
else if (SCM_EQ_P (fill, SCM_BOOL_T))
for (i = base; n--; i += inc)
ve[i / SCM_LONG_BIT] |= (1L << (i % SCM_LONG_BIT));
else

View file

@ -236,7 +236,7 @@ SCM_DEFINE (scm_sigaction, "sigaction", 1, 2, 0,
old_handler = scheme_handlers[csig];
if (SCM_UNBNDP (handler))
query_only = 1;
else if (SCM_TRUE_P (scm_integer_p (handler)))
else if (SCM_EQ_P (scm_integer_p (handler), SCM_BOOL_T))
{
if (SCM_NUM2LONG (2,handler) == (long) SIG_DFL
|| SCM_NUM2LONG (2,handler) == (long) SIG_IGN)

View file

@ -353,7 +353,7 @@ narrow_stack (SCM stack,int inner,SCM inner_key,int outer,SCM outer_key)
int n = s->length;
/* Cut inner part. */
if (SCM_TRUE_P (inner_key))
if (SCM_EQ_P (inner_key, SCM_BOOL_T))
/* Cut all frames up to user module code */
{
for (i = 0; inner; ++i, --inner)
@ -428,7 +428,7 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
scm_make_stack was given. */
/* just use dframe == scm_last_debug_frame
(from initialization of dframe, above) if obj is #t */
if (!SCM_TRUE_P (obj))
if (!SCM_EQ_P (obj, SCM_BOOL_T))
{
SCM_ASSERT (SCM_NIMP (obj), obj, SCM_ARG1, FUNC_NAME);
if (SCM_DEBUGOBJP (obj))
@ -510,7 +510,7 @@ SCM_DEFINE (scm_stack_id, "stack-id", 1, 0, 0,
{
scm_debug_frame *dframe;
long offset = 0;
if (SCM_TRUE_P (stack))
if (SCM_EQ_P (stack, SCM_BOOL_T))
dframe = scm_last_debug_frame;
else
{

View file

@ -533,7 +533,7 @@ SCM_DEFINE (scm_string_to_obarray_symbol, "string->obarray-symbol", 2, 1, 0,
/* iron out some screwy calling conventions */
if (SCM_FALSEP (o))
o = scm_symhash;
else if (SCM_TRUE_P (o))
else if (SCM_EQ_P (o, SCM_BOOL_T))
o = SCM_BOOL_F;
vcell = scm_intern_obarray_soft (SCM_ROCHARS(s),

View file

@ -532,7 +532,7 @@ SCM_DEFINE (scm_catch, "catch", 3, 0, 0,
{
struct scm_body_thunk_data c;
SCM_ASSERT (SCM_SYMBOLP(tag) || SCM_TRUE_P (tag),
SCM_ASSERT (SCM_SYMBOLP (tag) || SCM_EQ_P (tag, SCM_BOOL_T),
tag, SCM_ARG1, FUNC_NAME);
c.tag = tag;
@ -557,7 +557,7 @@ SCM_DEFINE (scm_lazy_catch, "lazy-catch", 3, 0, 0,
{
struct scm_body_thunk_data c;
SCM_ASSERT (SCM_SYMBOLP(tag) || SCM_TRUE_P (tag),
SCM_ASSERT (SCM_SYMBOLP (tag) || SCM_EQ_P (tag, SCM_BOOL_T),
tag, SCM_ARG1, FUNC_NAME);
c.tag = tag;
@ -615,7 +615,7 @@ scm_ithrow (SCM key, SCM args, int noreturn)
{
SCM this_key = SCM_CAR (dynpair);
if (SCM_TRUE_P (this_key) || SCM_EQ_P (this_key, key))
if (SCM_EQ_P (this_key, SCM_BOOL_T) || SCM_EQ_P (this_key, key))
break;
}
}

View file

@ -156,7 +156,7 @@ scm_make_uve (long k, SCM prot)
{
SCM v;
long i, type;
if (SCM_TRUE_P (prot))
if (SCM_EQ_P (prot, SCM_BOOL_T))
{
i = sizeof (long) * ((k + SCM_LONG_BIT - 1) / SCM_LONG_BIT);
type = scm_tc7_bvect;
@ -293,7 +293,7 @@ SCM_DEFINE (scm_array_p, "array?", 1, 1, 0,
switch (SCM_TYP7 (v))
{
case scm_tc7_bvect:
protp = (SCM_TRUE_P (prot));
protp = (SCM_EQ_P (prot, SCM_BOOL_T));
case scm_tc7_string:
protp = SCM_CHARP(prot) && (SCM_CHAR (prot) != '\0');
case scm_tc7_byvect:
@ -1284,7 +1284,7 @@ SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1,
case scm_tc7_bvect:
if (SCM_FALSEP (obj))
SCM_BITVEC_CLR(v,pos);
else if (SCM_TRUE_P (obj))
else if (SCM_EQ_P (obj, SCM_BOOL_T))
SCM_BITVEC_SET(v,pos);
else
badobj:SCM_WTA (2,obj);
@ -1859,7 +1859,7 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0,
SCM_ASSERT ((k < vlen), SCM_MAKINUM (k), SCM_OUTOFRANGE, FUNC_NAME);
SCM_BITVEC_CLR(v,k);
}
else if (SCM_TRUE_P (obj))
else if (SCM_EQ_P (obj, SCM_BOOL_T))
for (i = SCM_LENGTH (kv); i;)
{
k = SCM_UNPACK (SCM_VELTS (kv)[--i]);
@ -1875,7 +1875,7 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0,
if (SCM_FALSEP (obj))
for (k = (SCM_LENGTH (v) + SCM_LONG_BIT - 1) / SCM_LONG_BIT; k--;)
SCM_UNPACK (SCM_VELTS (v)[k]) &= ~ SCM_UNPACK(SCM_VELTS (kv)[k]);
else if (SCM_TRUE_P (obj))
else if (SCM_EQ_P (obj, SCM_BOOL_T))
for (k = (SCM_LENGTH (v) + SCM_LONG_BIT - 1) / SCM_LONG_BIT; k--;)
SCM_UNPACK (SCM_VELTS (v)[k]) |= SCM_UNPACK (SCM_VELTS (kv)[k]);
else
@ -1924,7 +1924,7 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0,
if (!SCM_BITVEC_REF(v,k))
count++;
}
else if (SCM_TRUE_P (obj))
else if (SCM_EQ_P (obj, SCM_BOOL_T))
for (i = SCM_LENGTH (kv); i;)
{
k = SCM_UNPACK (SCM_VELTS (kv)[--i]);
@ -1941,7 +1941,7 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0,
if (0 == SCM_LENGTH (v))
return SCM_INUM0;
SCM_ASRTGO (SCM_BOOLP (obj), badarg3);
fObj = SCM_TRUE_P (obj);
fObj = SCM_EQ_P (obj, SCM_BOOL_T);
i = (SCM_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_LONG_BIT - 1 - ((SCM_LENGTH (v) - 1) % SCM_LONG_BIT);

View file

@ -1,4 +1,4 @@
/* $Id: validate.h,v 1.11 2000-05-18 08:47:52 dirk Exp $ */
/* $Id: validate.h,v 1.12 2000-06-05 11:39:46 dirk Exp $ */
/* Copyright (C) 1999, 2000 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
@ -116,7 +116,7 @@
#define SCM_VALIDATE_BOOL_COPY(pos, flag, cvar) \
do { \
SCM_ASSERT (SCM_BOOLP (flag), flag, pos, FUNC_NAME); \
cvar = SCM_TRUE_P (flag) ? 1 : 0; \
cvar = SCM_EQ_P (flag, SCM_BOOL_T) ? 1 : 0; \
} while (0)
#define SCM_VALIDATE_CHAR(pos, scm) SCM_MAKE_VALIDATE (pos, scm, CHARP)
@ -330,7 +330,7 @@
#define SCM_VALIDATE_PROC(pos, proc) \
do { \
SCM_ASSERT (SCM_TRUE_P (scm_procedure_p (proc)), proc, pos, FUNC_NAME); \
SCM_ASSERT (SCM_EQ_P (scm_procedure_p (proc), SCM_BOOL_T), proc, pos, FUNC_NAME); \
} while (0)
#define SCM_VALIDATE_NULLORCONS(pos, env) \