mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-02 13:00:26 +02:00
Code Activity

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

Browse source
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
Download patch file Download diff file Expand all files Collapse all files

17
libguile/ChangeLog
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> 2000-06-04 Mikael Djurfeldt <mdj@thalamus.nada.kth.se>
* eval.c (scm_badformalsp): New static function. * eval.c (scm_badformalsp): New static function.

2
libguile/backtrace.c
View file

@ -183,7 +183,7 @@ display_error_body (struct display_error_args *a)
if (!SCM_MEMOIZEDP (source) && !SCM_FALSEP (prev_frame)) if (!SCM_MEMOIZEDP (source) && !SCM_FALSEP (prev_frame))
source = SCM_FRAME_SOURCE (prev_frame); source = SCM_FRAME_SOURCE (prev_frame);
if (SCM_FRAME_PROC_P (current_frame) if (SCM_FRAME_PROC_P (current_frame)
&& SCM_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)); pname = scm_procedure_name (SCM_FRAME_PROC (current_frame));
} }
if (!SCM_ROSTRINGP (pname)) if (!SCM_ROSTRINGP (pname))

3
libguile/boolean.h
View file

@ -50,11 +50,10 @@
/* Boolean Values /* 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_FALSEP(x) (SCM_EQ_P ((x), SCM_BOOL_F))
#define SCM_NFALSEP(x) (!SCM_FALSEP (x)) #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 */ /* Convert from a C boolean to a SCM boolean value */
#define SCM_BOOL(f) ((f) ? SCM_BOOL_T : SCM_BOOL_F) #define SCM_BOOL(f) ((f) ? SCM_BOOL_T : SCM_BOOL_F)

2
libguile/gc.c
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_bits_t word0 = SCM_CELL_WORD_0 (cell) - scm_tc3_cons_gloc;
SCM gloc_car = SCM_PACK (word0); /* access as gloc */ SCM gloc_car = SCM_PACK (word0); /* access as gloc */
SCM vcell = SCM_CELL_OBJECT_1 (gloc_car); 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_UNPACK (vcell) != 0) && (SCM_UNPACK (vcell) != 1))
{ {
SCM_SET_CELL_OBJECT_0 (cell, name); SCM_SET_CELL_OBJECT_0 (cell, name);

2
libguile/gh_data.c
View file

@ -693,7 +693,7 @@ SCM
gh_module_lookup (SCM vec, const char *sname) gh_module_lookup (SCM vec, const char *sname)
{ {
SCM sym = gh_symbol2scm (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); return scm_symbol_binding (vec, sym);
else else
return SCM_UNDEFINED; return SCM_UNDEFINED;

2
libguile/load.c
View file

@ -111,7 +111,7 @@ SCM_DEFINE (scm_primitive_load, "primitive-load", 1, 0, 0,
{ {
SCM hook = *scm_loc_load_hook; SCM hook = *scm_loc_load_hook;
SCM_VALIDATE_ROSTRING (1,filename); 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", hook, "value of %load-hook is neither a procedure nor #f",
FUNC_NAME); FUNC_NAME);

2
libguile/print.c
View file

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

5
libguile/procs.c
View file

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

2
libguile/procs.h
View file

@ -91,7 +91,7 @@ typedef struct
+ scm_tc3_closure)) + scm_tc3_closure))
#define SCM_ENV(x) SCM_CDR(x) #define SCM_ENV(x) SCM_CDR(x)
#define SCM_SETENV(x, e) SCM_SETCDR (x, e) #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 /* Procedure-with-setter

4
libguile/ramap.c
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 */ if ((base + n) % SCM_LONG_BIT) /* trailing partial word */
ve[i] &= (~0L << ((base + n) % SCM_LONG_BIT)); 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) if (base % SCM_LONG_BIT)
ve[i++] |= ~0L << (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)) if (SCM_FALSEP (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_TRUE_P (fill)) else if (SCM_EQ_P (fill, SCM_BOOL_T))
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 else

2
libguile/scmsigs.c
View file

@ -236,7 +236,7 @@ SCM_DEFINE (scm_sigaction, "sigaction", 1, 2, 0,
old_handler = scheme_handlers[csig]; old_handler = scheme_handlers[csig];
if (SCM_UNBNDP (handler)) if (SCM_UNBNDP (handler))
query_only = 1; 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 if (SCM_NUM2LONG (2,handler) == (long) SIG_DFL
|| SCM_NUM2LONG (2,handler) == (long) SIG_IGN) || SCM_NUM2LONG (2,handler) == (long) SIG_IGN)

6
libguile/stacks.c
View file

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

2
libguile/symbols.c
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 */ /* iron out some screwy calling conventions */
if (SCM_FALSEP (o)) if (SCM_FALSEP (o))
o = scm_symhash; o = scm_symhash;
else if (SCM_TRUE_P (o)) else if (SCM_EQ_P (o, SCM_BOOL_T))
o = SCM_BOOL_F; o = SCM_BOOL_F;
vcell = scm_intern_obarray_soft (SCM_ROCHARS(s), vcell = scm_intern_obarray_soft (SCM_ROCHARS(s),

6
libguile/throw.c
View file

@ -532,7 +532,7 @@ SCM_DEFINE (scm_catch, "catch", 3, 0, 0,
{ {
struct scm_body_thunk_data c; 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); tag, SCM_ARG1, FUNC_NAME);
c.tag = tag; c.tag = tag;
@ -557,7 +557,7 @@ SCM_DEFINE (scm_lazy_catch, "lazy-catch", 3, 0, 0,
{ {
struct scm_body_thunk_data c; 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); tag, SCM_ARG1, FUNC_NAME);
c.tag = tag; c.tag = tag;
@ -615,7 +615,7 @@ scm_ithrow (SCM key, SCM args, int noreturn)
{ {
SCM this_key = SCM_CAR (dynpair); 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; break;
} }
} }

14
libguile/unif.c
View file

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

6
libguile/validate.h
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. /* Copyright (C) 1999, 2000 Free Software Foundation, Inc.
* *
* This program is free software; you can redistribute it and/or modify * This program is free software; you can redistribute it and/or modify
@ -116,7 +116,7 @@
#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_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) } while (0)
#define SCM_VALIDATE_CHAR(pos, scm) SCM_MAKE_VALIDATE (pos, scm, CHARP) #define SCM_VALIDATE_CHAR(pos, scm) SCM_MAKE_VALIDATE (pos, scm, CHARP)
@ -330,7 +330,7 @@
#define SCM_VALIDATE_PROC(pos, proc) \ #define SCM_VALIDATE_PROC(pos, proc) \
do { \ 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) } while (0)
#define SCM_VALIDATE_NULLORCONS(pos, env) \ #define SCM_VALIDATE_NULLORCONS(pos, env) \