From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Neil Jerram Newsgroups: gmane.lisp.guile.devel Subject: Re: [PATCH] %nil-handling optimization and fixes v1 Date: Fri, 28 Aug 2009 08:11:51 +0100 Message-ID: <87fxbc76q0.fsf@arudy.ossau.uklinux.net> References: <20090709161043.GA2538@fibril.netris.org> <87k50o76uu.fsf@arudy.ossau.uklinux.net> NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=us-ascii X-Trace: ger.gmane.org 1251443546 26698 80.91.229.12 (28 Aug 2009 07:12:26 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Fri, 28 Aug 2009 07:12:26 +0000 (UTC) Cc: guile-devel@gnu.org To: Mark H Weaver Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Fri Aug 28 09:12:18 2009 Return-path: Envelope-to: guile-devel@m.gmane.org Original-Received: from lists.gnu.org ([199.232.76.165]) by lo.gmane.org with esmtp (Exim 4.50) id 1Mgvd3-0000Ob-Hy for guile-devel@m.gmane.org; Fri, 28 Aug 2009 09:12:18 +0200 Original-Received: from localhost ([127.0.0.1]:58969 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1Mgvd2-0005Kf-Le for guile-devel@m.gmane.org; Fri, 28 Aug 2009 03:12:08 -0400 Original-Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43) id 1Mgvcv-0005K6-IT for guile-devel@gnu.org; Fri, 28 Aug 2009 03:12:01 -0400 Original-Received: from exim by lists.gnu.org with spam-scanned (Exim 4.43) id 1Mgvcq-0005JU-GN for guile-devel@gnu.org; Fri, 28 Aug 2009 03:12:00 -0400 Original-Received: from [199.232.76.173] (port=33786 helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1Mgvcq-0005JR-9v for guile-devel@gnu.org; Fri, 28 Aug 2009 03:11:56 -0400 Original-Received: from mx20.gnu.org ([199.232.41.8]:32865) by monty-python.gnu.org with esmtps (TLS-1.0:RSA_AES_256_CBC_SHA1:32) (Exim 4.60) (envelope-from ) id 1Mgvcp-0003V4-Ew for guile-devel@gnu.org; Fri, 28 Aug 2009 03:11:56 -0400 Original-Received: from mail3.uklinux.net ([80.84.72.33]) by mx20.gnu.org with esmtp (Exim 4.60) (envelope-from ) id 1Mgvco-0005Db-77 for guile-devel@gnu.org; Fri, 28 Aug 2009 03:11:55 -0400 Original-Received: from arudy (host86-152-99-133.range86-152.btcentralplus.com [86.152.99.133]) by mail3.uklinux.net (Postfix) with ESMTP id 963401F686B; Fri, 28 Aug 2009 08:11:52 +0100 (BST) Original-Received: from arudy.ossau.uklinux.net (arudy [127.0.0.1]) by arudy (Postfix) with ESMTP id 0D8EA38021; Fri, 28 Aug 2009 08:11:52 +0100 (BST) In-Reply-To: <87k50o76uu.fsf@arudy.ossau.uklinux.net> (Neil Jerram's message of "Fri\, 28 Aug 2009 08\:08\:57 +0100") User-Agent: Gnus/5.11 (Gnus v5.11) Emacs/22.2 (gnu/linux) X-Detected-Operating-System: by mx20.gnu.org: GNU/Linux 2.4-2.6 X-detected-operating-system: by monty-python.gnu.org: GNU/Linux 2.6, seldom 2.4 (older, 4) X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Developers list for Guile, the GNU extensibility library" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Errors-To: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.lisp.guile.devel:9195 Archived-At: I'm sorry, I typed the wrong keys and sent this response prematurely. I'll finish off the review and send a complete response later on! Neil Neil Jerram writes: > So, finally, here we go with these patches. > > Mark H Weaver writes: > >> Attached are patches to optimize %nil handling, along with some fixes >> to %nil-handling bugs, as I outlined in my recent posts. >> >> Four patches are attached. The first.patch is the most important, and >> is a prerequisite for the others. In brief it does the following: >> >> * Renumbers the IFLAG constants. >> >> * Adds several macros related to boolean type tests, null tests, and >> boolean-truth testing (including lisp-style boolean-truth tests). >> >> * Adds compile-time checks to verify the necessary IFLAG numbering >> properties needed for the checks to work properly. >> >> * Changes some existing code to use the new optimized macros, without >> changing the semantics of the code at all (except that scm_is_bool >> is changed from a function to a macro). >> >> I added the following macros, whose names explicitly state how %nil >> should be handled. See the comments in the patch for more information >> about these. >> >> scm_is_false_assume_not_lisp_nil scm_is_true_assume_not_lisp_nil >> scm_is_false_and_not_lisp_nil scm_is_true_or_lisp_nil >> scm_is_false_or_lisp_nil scm_is_true_and_not_lisp_nil >> >> scm_is_lisp_false scm_is_lisp_true >> >> scm_is_null_assume_not_lisp_nil >> scm_is_null_and_not_lisp_nil >> scm_is_null_or_lisp_nil >> >> scm_is_bool_and_not_lisp_nil >> scm_is_bool_or_lisp_nil >> >> The following already-existing macros are defined as aliases, such >> that their semantics is unchanged (although scm_is_bool used to be a >> function and is now a macro). >> >> scm_is_null --> scm_is_null_and_not_lisp_nil >> scm_is_false --> scm_is_false_and_not_lisp_nil >> scm_is_true --> scm_is_true_or_lisp_nil >> scm_is_bool --> scm_is_bool_and_not_lisp_nil >> >> (I still believe that these should be changed to versions that handle >> %nil properly, but await approval on that point, so these patches do >> not make those changes) >> >> Also, if the preprocessor macro SCM_ENABLE_ELISP is not true (this >> macro already existed and was used in lang.h), all overheads >> associated with %nil handling are eliminated from the above macros. >> >> >> vm-fixes.patch changes semantics, by fixing %nil handling in the >> following instructions: br-if, br-if-not, br-if-null, br-if-not-null, >> not, not-not, null?, and not-null? >> >> srfi-1-fixes.patch changes semantics, by fixing %nil handling in >> several functions. Note that this patch (and several other large >> forthcoming patches) will be unnecessary if the scm_is_false, >> scm_is_true, and scm_is_null macros are changed to handle %nil as I >> proposed. >> >> non-essential.patch is the last and least important. It doesn't >> change any functionality or implementation. It changes two >> occurrences of scm_is_bool and scm_is_null, in which %nil must *not* >> be treated as a boolean or null, to use newly-added equivalent macros >> which are explicit about how nil should be handled. These changes >> will be needed if scm_is_null is changed as I proposed. It also adds >> a few comments related to %nil handling. >> >> I've run "make check" on recent git master (c4b681fd) with these >> patches applied, and everything seems to work. >> >> I haven't yet run any benchmarks, because I'm not sure how to best do >> that. I doubt the changes will make any noticeable difference except >> possibly in C code which does a lot of tests which include %nil. >> >> Comments and suggestions solicited. >> >> Best, >> Mark >> >> diff --git a/libguile/tags.h b/libguile/tags.h >> index 3294533..25aea09 100644 >> --- a/libguile/tags.h >> +++ b/libguile/tags.h >> @@ -516,12 +516,47 @@ enum scm_tc8_tags >> #define SCM_MAKIFLAG(n) SCM_MAKE_ITAG8 ((n), scm_tc8_flag) >> #define SCM_IFLAGNUM(n) (SCM_ITAG8_DATA (n)) >> >> +/* >> + * IMPORTANT NOTE regarding IFLAG numbering!!! >> + * >> + * Several macros depend upon careful IFLAG numbering of SCM_BOOL_F, >> + * SCM_BOOL_T, SCM_ELISP_NIL, SCM_EOL, and the two SCM_XXX_*_DONT_USE >> + * constants. In particular: >> + * >> + * - SCM_BOOL_F and SCM_BOOL_T must differ in exactly one bit position. >> + * (used to implement scm_is_bool_and_not_lisp_nil, aka scm_is_bool) >> + * >> + * - SCM_ELISP_NIL and SCM_BOOL_F must differ in exactly one bit position. >> + * (used to implement scm_is_false_or_lisp_nil and >> + * scm_is_true_and_not_lisp_nil) >> + * >> + * - SCM_ELISP_NIL and SCM_EOL must differ in exactly one bit position. >> + * (used to implement scm_is_null_or_lisp_nil) >> + * >> + * - SCM_ELISP_NIL, SCM_BOOL_F, SCM_EOL, SCM_XXX_ANOTHER_LISP_FALSE_DONT_USE >> + * must all be equal except for two bit positions. >> + * (used to implement scm_is_lisp_false) >> + * >> + * - SCM_ELISP_NIL, SCM_BOOL_F, SCM_BOOL_T, SCM_XXX_ANOTHER_BOOLEAN_DONT_USE >> + * must all be equal except for two bit positions. >> + * (used to implement scm_is_bool_or_lisp_nil) >> + * >> + * These properties allow the aforementioned macros to be implemented >> + * by bitwise ANDing with a mask and then comparing with a constant, >> + * using as a common basis the macro SCM_MATCHES_BITS_IN_COMMON, >> + * defined below. The properties are checked at compile-time using >> + * `verify' macros near the top of boolean.c and pairs.c. >> + */ > > Appreciate the detailed comments. > >> #define SCM_BOOL_F SCM_MAKIFLAG (0) >> -#define SCM_BOOL_T SCM_MAKIFLAG (1) >> -#define SCM_UNDEFINED SCM_MAKIFLAG (2) >> -#define SCM_EOF_VAL SCM_MAKIFLAG (3) >> -#define SCM_EOL SCM_MAKIFLAG (4) >> -#define SCM_UNSPECIFIED SCM_MAKIFLAG (5) >> +#define SCM_ELISP_NIL SCM_MAKIFLAG (1) >> +#define SCM_XXX_ANOTHER_LISP_FALSE_DONT_USE SCM_MAKIFLAG (2) >> +#define SCM_EOL SCM_MAKIFLAG (3) >> +#define SCM_BOOL_T SCM_MAKIFLAG (4) >> +#define SCM_XXX_ANOTHER_BOOLEAN_DONT_USE SCM_MAKIFLAG (5) >> + >> +#define SCM_UNSPECIFIED SCM_MAKIFLAG (6) >> +#define SCM_UNDEFINED SCM_MAKIFLAG (7) >> +#define SCM_EOF_VAL SCM_MAKIFLAG (8) >> >> /* When a variable is unbound this is marked by the SCM_UNDEFINED >> * value. The following is an unbound value which can be handled on >> @@ -531,14 +566,50 @@ enum scm_tc8_tags >> * the code which handles this value in C so that SCM_UNDEFINED can be >> * used instead. It is not ideal to let this kind of unique and >> * strange values loose on the Scheme level. */ >> -#define SCM_UNBOUND SCM_MAKIFLAG (6) >> - >> -/* The Elisp nil value. */ >> -#define SCM_ELISP_NIL SCM_MAKIFLAG (7) >> - >> +#define SCM_UNBOUND SCM_MAKIFLAG (9) >> >> #define SCM_UNBNDP(x) (scm_is_eq ((x), SCM_UNDEFINED)) >> >> +/* >> + * SCM_MATCHES_BITS_IN_COMMON(x,a,b) returns 1 if and only if x >> + * matches both a and b in every bit position where a and b are equal; >> + * otherwise it returns 0. Bit positions where a and b differ are >> + * ignored. >> + * >> + * This is used to efficiently compare against two values which differ >> + * in exactly one bit position, or against four values which differ in >> + * exactly two bit positions. It is the basis for the following >> + * macros: >> + * >> + * scm_is_null_or_lisp_nil, >> + * scm_is_false_or_lisp_nil, >> + * scm_is_true_and_not_lisp_nil, >> + * scm_is_lisp_false, >> + * scm_is_lisp_true, >> + * scm_is_bool_and_not_lisp_nil (aka scm_is_bool) >> + * scm_is_bool_or_lisp_nil. >> + */ >> +#define SCM_MATCHES_BITS_IN_COMMON(x,a,b) \ >> + ((SCM_UNPACK(x) & ~(SCM_UNPACK(a) ^ SCM_UNPACK(b))) == \ >> + (SCM_UNPACK(a) & SCM_UNPACK(b))) >> + >> +/* >> + * These macros are used for compile-time verification that the >> + * constants have the properties needed for the above macro to work >> + * properly. >> + */ >> +#define SCM_WITH_LEAST_SIGNIFICANT_1_BIT_CLEARED(x) ((x) & ((x)-1)) >> +#define SCM_HAS_EXACTLY_ONE_BIT_SET(x) \ >> + ((x) != 0 && SCM_WITH_LEAST_SIGNIFICANT_1_BIT_CLEARED (x) == 0) > > I know they're not needed, but I'd still add some more parentheses > here. > >> +#define SCM_HAS_EXACTLY_TWO_BITS_SET(x) \ >> + (SCM_HAS_EXACTLY_ONE_BIT_SET (SCM_WITH_LEAST_SIGNIFICANT_1_BIT_CLEARED (x))) >> + >> +#define SCM_VALUES_DIFFER_IN_EXACTLY_ONE_BIT_POSITION(a,b) \ >> + (SCM_HAS_EXACTLY_ONE_BIT_SET (SCM_UNPACK(a) ^ SCM_UNPACK(b))) >> +#define SCM_VALUES_DIFFER_IN_EXACTLY_TWO_BIT_POSITIONS(a,b,c,d) \ >> + (SCM_HAS_EXACTLY_TWO_BITS_SET ((SCM_UNPACK(a) ^ SCM_UNPACK(b)) | \ >> + (SCM_UNPACK(b) ^ SCM_UNPACK(c)) | \ >> + (SCM_UNPACK(c) ^ SCM_UNPACK(d)))) >> > > I'd like to make it explicit that these macros are not part of the > public libguile API, and we recently agreed on using the > BUILDING_LIBGUILE macro to do this. So we just need to put #ifdef > BUILDING_LIBGUILE ... #endif around them. > >> /* Evaluator byte codes ('immediate symbols'). These constants are used only >> diff --git a/libguile/print.c b/libguile/print.c >> index 6c44d59..fd65bf9 100644 >> --- a/libguile/print.c >> +++ b/libguile/print.c >> @@ -61,18 +61,17 @@ >> static const char *iflagnames[] = >> { >> "#f", >> + "#nil", /* Elisp nil value. Should print from elisp as symbol `nil'. */ >> + "#", >> + "()", >> "#t", >> + "#", > > "SHOULD_NOT_EXIST" might make a future developer think that those > entries should removed from the code. Maybe add a comment to explain > what it really means, or change to "SHOULD_NEVER_BE_SEEN"? > >> + "#", >> "#", >> "#", >> - "()", >> - "#", >> >> /* Unbound slot marker for GOOPS. For internal use in GOOPS only. */ >> "#", >> - >> - /* Elisp nil value. This is its Scheme name; whenever it's printed in >> - * Elisp, it should appear as the symbol `nil'. */ >> - "#nil" >> }; >> >> SCM_SYMBOL (sym_reader, "reader"); >> diff --git a/libguile/boolean.h b/libguile/boolean.h >> index 5a83797..2c480c0 100644 >> --- a/libguile/boolean.h >> +++ b/libguile/boolean.h >> @@ -31,16 +31,97 @@ >> * >> */ >> >> +/* >> + * Use these macros if it's important (for correctness) >> + * that %nil MUST be considered true >> + */ >> +#define scm_is_false_and_not_lisp_nil(x) (scm_is_eq ((x), SCM_BOOL_F)) >> +#define scm_is_true_or_lisp_nil(x) (!scm_is_eq ((x), SCM_BOOL_F)) >> + >> +/* >> + * Use these macros if %nil will never be tested, >> + * for increased efficiency. >> + */ >> +#define scm_is_false_assume_not_lisp_nil(x) (scm_is_eq ((x), SCM_BOOL_F)) >> +#define scm_is_true_assume_not_lisp_nil(x) (!scm_is_eq ((x), SCM_BOOL_F)) >> + >> +/* >> + * See the comments preceeding the definitions of SCM_BOOL_F and >> + * SCM_MATCHES_BITS_IN_COMMON in tags.h for more information on >> + * how the following macro works. >> + */ >> +#if SCM_ENABLE_ELISP >> +# define scm_is_false_or_lisp_nil(x) \ >> + (SCM_MATCHES_BITS_IN_COMMON ((x), SCM_ELISP_NIL, SCM_BOOL_F)) >> +#else >> +# define scm_is_false_or_lisp_nil(x) (scm_is_false_assume_not_lisp_nil (x)) >> +#endif >> +#define scm_is_true_and_not_lisp_nil(x) (!scm_is_false_or_lisp_nil (x)) >> >> -#define scm_is_false(x) scm_is_eq ((x), SCM_BOOL_F) >> -#define scm_is_true(x) !scm_is_false (x) >> +/* XXX Should these macros treat %nil as false by default? */ >> +#define scm_is_false(x) (scm_is_false_and_not_lisp_nil (x)) >> +#define scm_is_true(x) (!scm_is_false (x)) >> + >> +/* >> + * Since we know SCM_BOOL_F and SCM_BOOL_T differ by exactly one bit, >> + * and that SCM_BOOL_F and SCM_ELISP_NIL differ by exactly one bit, >> + * and that they of course can't be the same bit (or else SCM_BOOL_T >> + * and SCM_ELISP_NIL be would equal), it follows that SCM_BOOL_T and >> + * SCM_ELISP_NIL differ by exactly two bits, and these are the bits >> + * which will be ignored by SCM_MATCHES_BITS_IN_COMMON below. >> + * >> + * See the comments preceeding the definitions of SCM_BOOL_F and >> + * SCM_MATCHES_BITS_IN_COMMON in tags.h for more information. >> + * >> + * If SCM_ENABLE_ELISP is true, then scm_is_bool_or_lisp_nil(x) >> + * returns 1 if and only if x is one of the following: SCM_BOOL_F, >> + * SCM_BOOL_T, SCM_ELISP_NIL, or SCM_XXX_ANOTHER_BOOLEAN_DONT_USE. >> + * Otherwise, it returns 0. >> + */ >> +#if SCM_ENABLE_ELISP >> +# define scm_is_bool_or_lisp_nil(x) \ >> + (SCM_MATCHES_BITS_IN_COMMON ((x), SCM_BOOL_T, SCM_ELISP_NIL)) >> +#else >> +# define scm_is_bool_or_lisp_nil(x) (scm_is_bool_and_not_lisp_nil (x)) >> +#endif >> + >> +#define scm_is_bool_and_not_lisp_nil(x) \ >> + (SCM_MATCHES_BITS_IN_COMMON ((x), SCM_BOOL_F, SCM_BOOL_T)) >> + >> +/* XXX Should scm_is_bool treat %nil as a boolean? */ >> +#define scm_is_bool(x) (scm_is_bool_and_not_lisp_nil (x)) >> >> -SCM_API int scm_is_bool (SCM x); >> #define scm_from_bool(x) ((x) ? SCM_BOOL_T : SCM_BOOL_F) >> SCM_API int scm_to_bool (SCM x); >> >> >> >> +/* >> + * The following macros efficiently implement boolean truth testing as >> + * expected by most lisps, which treat '() aka SCM_EOL as false. >> + * >> + * Since we know SCM_ELISP_NIL and SCM_BOOL_F differ by exactly one >> + * bit, and that SCM_ELISP_NIL and SCM_EOL differ by exactly one bit, >> + * and that they of course can't be the same bit (or else SCM_BOOL_F >> + * and SCM_EOL be would equal), it follows that SCM_BOOL_F and SCM_EOL >> + * differ by exactly two bits, and these are the bits which will be >> + * ignored by SCM_MATCHES_BITS_IN_COMMON below. >> + * >> + * See the comments preceeding the definitions of SCM_BOOL_F and >> + * SCM_MATCHES_BITS_IN_COMMON in tags.h for more information. >> + * >> + * scm_is_lisp_false(x) returns 1 if and only if x is one of the >> + * following: SCM_BOOL_F, SCM_ELISP_NIL, SCM_EOL or >> + * SCM_XXX_ANOTHER_LISP_FALSE_DONT_USE. Otherwise, it returns 0. >> + */ >> +#if SCM_ENABLE_ELISP >> +# define scm_is_lisp_false(x) \ >> + (SCM_MATCHES_BITS_IN_COMMON ((x), SCM_BOOL_F, SCM_EOL)) >> +# define scm_is_lisp_true(x) (!scm_is_lisp_false(x)) >> +#endif >> + >> + >> + >> SCM_API SCM scm_not (SCM x); >> SCM_API SCM scm_boolean_p (SCM obj); >> >> diff --git a/libguile/boolean.c b/libguile/boolean.c >> index d79bf79..9a4f896 100644 >> --- a/libguile/boolean.c >> +++ b/libguile/boolean.c >> @@ -29,15 +29,37 @@ >> #include "libguile/lang.h" >> #include "libguile/tags.h" >> >> +#include "verify.h" >> + >> >> >> +/* >> + * These compile-time tests verify the properties needed for the >> + * efficient test macros defined in boolean.h, which are defined in >> + * terms of the SCM_MATCHES_BITS_IN_COMMON macro. >> + * >> + * See the comments preceeding the definitions of SCM_BOOL_F and >> + * SCM_MATCHES_BITS_IN_COMMON in tags.h for more information. >> + */ >> +verify (SCM_VALUES_DIFFER_IN_EXACTLY_ONE_BIT_POSITION \ >> + (SCM_BOOL_F, SCM_BOOL_T)); >> +verify (SCM_VALUES_DIFFER_IN_EXACTLY_ONE_BIT_POSITION \ >> + (SCM_ELISP_NIL, SCM_BOOL_F)); >> +verify (SCM_VALUES_DIFFER_IN_EXACTLY_ONE_BIT_POSITION \ >> + (SCM_ELISP_NIL, SCM_EOL)); >> +verify (SCM_VALUES_DIFFER_IN_EXACTLY_TWO_BIT_POSITIONS \ >> + (SCM_ELISP_NIL, SCM_BOOL_F, SCM_BOOL_T, \ >> + SCM_XXX_ANOTHER_BOOLEAN_DONT_USE)); >> +verify (SCM_VALUES_DIFFER_IN_EXACTLY_TWO_BIT_POSITIONS \ >> + (SCM_ELISP_NIL, SCM_BOOL_F, SCM_EOL, \ >> + SCM_XXX_ANOTHER_LISP_FALSE_DONT_USE)); >> >> SCM_DEFINE (scm_not, "not", 1, 0, 0, >> (SCM x), >> "Return @code{#t} iff @var{x} is @code{#f}, else return @code{#f}.") >> #define FUNC_NAME s_scm_not >> { >> - return scm_from_bool (scm_is_false (x) || SCM_NILP (x)); >> + return scm_from_bool (scm_is_false_or_lisp_nil (x)); >> } >> #undef FUNC_NAME >> >> @@ -47,19 +69,14 @@ SCM_DEFINE (scm_boolean_p, "boolean?", 1, 0, 0, >> "Return @code{#t} iff @var{obj} is either @code{#t} or @code{#f}.") >> #define FUNC_NAME s_scm_boolean_p >> { >> - return scm_from_bool (scm_is_bool (obj) || SCM_NILP (obj)); >> + return scm_from_bool (scm_is_bool_or_lisp_nil (obj)); >> } >> #undef FUNC_NAME >> >> int >> -scm_is_bool (SCM x) >> -{ >> - return scm_is_eq (x, SCM_BOOL_F) || scm_is_eq (x, SCM_BOOL_T); >> -} >> - >> -int >> scm_to_bool (SCM x) >> { >> + /* XXX Should this first test use scm_is_false_or_lisp_nil instead? */ >> if (scm_is_eq (x, SCM_BOOL_F)) >> return 0; >> else if (scm_is_eq (x, SCM_BOOL_T)) >> diff --git a/libguile/pairs.h b/libguile/pairs.h >> index a6d44d2..9c75709 100644 >> --- a/libguile/pairs.h >> +++ b/libguile/pairs.h >> @@ -34,7 +34,32 @@ >> # define SCM_VALIDATE_PAIR(cell, expr) (expr) >> #endif >> >> -#define scm_is_null(x) (scm_is_eq ((x), SCM_EOL)) >> +/* >> + * Use scm_is_null_and_not_lisp_nil if it's important (for correctness) >> + * that %nil must NOT be considered null. >> + */ >> +#define scm_is_null_and_not_lisp_nil(x) (scm_is_eq ((x), SCM_EOL)) >> + >> +/* >> + * Use scm_is_null_assume_not_lisp_nil if %nil will never be tested, >> + * for increased efficiency. >> + */ >> +#define scm_is_null_assume_not_lisp_nil(x) (scm_is_eq ((x), SCM_EOL)) >> + >> +/* >> + * See the comments preceeding the definitions of SCM_BOOL_F and >> + * SCM_MATCHES_BITS_IN_COMMON in tags.h for more information on >> + * how the following macro works. >> + */ >> +#if SCM_ENABLE_ELISP >> +# define scm_is_null_or_lisp_nil(x) \ >> + (SCM_MATCHES_BITS_IN_COMMON ((x), SCM_ELISP_NIL, SCM_EOL)) >> +#else >> +# define scm_is_null_or_lisp_nil(x) (scm_is_null_assume_not_lisp_nil (x)) >> +#endif >> + >> +/* XXX Should scm_is_null treat %nil as null by default? */ >> +#define scm_is_null(x) (scm_is_null_and_not_lisp_nil(x)) >> >> #define SCM_CAR(x) (SCM_VALIDATE_PAIR (x, SCM_CELL_OBJECT_0 (x))) >> #define SCM_CDR(x) (SCM_VALIDATE_PAIR (x, SCM_CELL_OBJECT_1 (x))) >> diff --git a/libguile/pairs.c b/libguile/pairs.c >> index aaaeb11..49eef82 100644 >> --- a/libguile/pairs.c >> +++ b/libguile/pairs.c >> @@ -27,11 +27,25 @@ >> >> #include "libguile/pairs.h" >> >> +#include "verify.h" >> + >> >> >> /* {Pairs} >> */ >> >> +/* >> + * This compile-time test verifies the properties needed for the >> + * efficient test macro scm_is_null_or_lisp_nil defined in pairs.h, >> + * which is defined in terms of the SCM_MATCHES_BITS_IN_COMMON macro. >> + * >> + * See the comments preceeding the definitions of SCM_BOOL_F and >> + * SCM_MATCHES_BITS_IN_COMMON in tags.h for more information. >> + */ >> +verify (SCM_VALUES_DIFFER_IN_EXACTLY_ONE_BIT_POSITION \ >> + (SCM_ELISP_NIL, SCM_EOL)); >> + >> + >> #if (SCM_DEBUG_PAIR_ACCESSES == 1) >> >> #include "libguile/ports.h" >> diff --git a/libguile/lang.h b/libguile/lang.h >> index 47128de..985f5ef 100644 >> --- a/libguile/lang.h >> +++ b/libguile/lang.h >> @@ -39,7 +39,7 @@ SCM_INTERNAL void scm_init_lang (void); >> >> #endif /* ! SCM_ENABLE_ELISP */ >> >> -#define SCM_NULL_OR_NIL_P(x) (scm_is_null (x) || SCM_NILP (x)) >> +#define SCM_NULL_OR_NIL_P(x) (scm_is_null_or_lisp_nil (x)) >> >> #endif /* SCM_LANG_H */ >> >> diff --git a/libguile/eval.i.c b/libguile/eval.i.c >> index 99aa265..9da1664 100644 >> --- a/libguile/eval.i.c >> +++ b/libguile/eval.i.c >> @@ -304,7 +304,7 @@ dispatch: >> while (!scm_is_null (SCM_CDR (x))) >> { >> SCM test_result = EVALCAR (x, env); >> - if (scm_is_false (test_result) || SCM_NILP (test_result)) >> + if (scm_is_false_or_lisp_nil (test_result)) >> RETURN (SCM_BOOL_F); >> else >> x = SCM_CDR (x); >> @@ -442,8 +442,7 @@ dispatch: >> xx = SCM_CDR (clause); >> proc = EVALCAR (xx, env); >> guard_result = SCM_APPLY (proc, arg1, SCM_EOL); >> - if (scm_is_true (guard_result) >> - && !SCM_NILP (guard_result)) >> + if (scm_is_true_and_not_lisp_nil (guard_result)) >> { >> proc = SCM_CDDR (xx); >> proc = EVALCAR (proc, env); >> @@ -451,7 +450,7 @@ dispatch: >> goto apply_proc; >> } >> } >> - else if (scm_is_true (arg1) && !SCM_NILP (arg1)) >> + else if (scm_is_true_and_not_lisp_nil (arg1)) >> { >> x = SCM_CDR (clause); >> if (scm_is_null (x)) >> @@ -498,7 +497,7 @@ dispatch: >> >> SCM test_result = EVALCAR (test_form, env); >> >> - while (scm_is_false (test_result) || SCM_NILP (test_result)) >> + while (scm_is_false_or_lisp_nil (test_result)) >> { >> { >> /* Evaluate body forms. */ >> @@ -552,7 +551,7 @@ dispatch: >> { >> SCM test_result = EVALCAR (x, env); >> x = SCM_CDR (x); /* then expression */ >> - if (scm_is_false (test_result) || SCM_NILP (test_result)) >> + if (scm_is_false_or_lisp_nil (test_result)) >> { >> x = SCM_CDR (x); /* else expression */ >> if (scm_is_null (x)) >> @@ -623,7 +622,7 @@ dispatch: >> while (!scm_is_null (SCM_CDR (x))) >> { >> SCM val = EVALCAR (x, env); >> - if (scm_is_true (val) && !SCM_NILP (val)) >> + if (scm_is_true_and_not_lisp_nil (val)) >> RETURN (val); >> else >> x = SCM_CDR (x); >> >> diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c >> index d55d6e2..427a2fc 100644 >> --- a/libguile/vm-i-system.c >> +++ b/libguile/vm-i-system.c >> @@ -406,12 +406,12 @@ VM_DEFINE_INSTRUCTION (31, br, "br", 2, 0, 0) >> >> VM_DEFINE_INSTRUCTION (32, br_if, "br-if", 2, 0, 0) >> { >> - BR (!SCM_FALSEP (*sp)); >> + BR (scm_is_true_and_not_lisp_nil (*sp)); >> } >> >> VM_DEFINE_INSTRUCTION (33, br_if_not, "br-if-not", 2, 0, 0) >> { >> - BR (SCM_FALSEP (*sp)); >> + BR (scm_is_false_or_lisp_nil (*sp)); >> } >> >> VM_DEFINE_INSTRUCTION (34, br_if_eq, "br-if-eq", 2, 0, 0) >> @@ -428,12 +428,12 @@ VM_DEFINE_INSTRUCTION (35, br_if_not_eq, "br-if-not-eq", 2, 0, 0) >> >> VM_DEFINE_INSTRUCTION (36, br_if_null, "br-if-null", 2, 0, 0) >> { >> - BR (SCM_NULLP (*sp)); >> + BR (scm_is_null_or_lisp_nil (*sp)); >> } >> >> VM_DEFINE_INSTRUCTION (37, br_if_not_null, "br-if-not-null", 2, 0, 0) >> { >> - BR (!SCM_NULLP (*sp)); >> + BR (!scm_is_null_or_lisp_nil (*sp)); >> } >> >> >> diff --git a/libguile/vm-i-scheme.c b/libguile/vm-i-scheme.c >> index 5de39a2..40781ff 100644 >> --- a/libguile/vm-i-scheme.c >> +++ b/libguile/vm-i-scheme.c >> @@ -32,13 +32,13 @@ >> VM_DEFINE_FUNCTION (80, not, "not", 1) >> { >> ARGS1 (x); >> - RETURN (SCM_BOOL (SCM_FALSEP (x))); >> + RETURN (SCM_BOOL (scm_is_false_or_lisp_nil (x))); >> } >> >> VM_DEFINE_FUNCTION (81, not_not, "not-not", 1) >> { >> ARGS1 (x); >> - RETURN (SCM_BOOL (!SCM_FALSEP (x))); >> + RETURN (SCM_BOOL (!scm_is_false_or_lisp_nil (x))); >> } >> >> VM_DEFINE_FUNCTION (82, eq, "eq?", 2) >> @@ -56,13 +56,13 @@ VM_DEFINE_FUNCTION (83, not_eq, "not-eq?", 2) >> VM_DEFINE_FUNCTION (84, nullp, "null?", 1) >> { >> ARGS1 (x); >> - RETURN (SCM_BOOL (SCM_NULLP (x))); >> + RETURN (SCM_BOOL (scm_is_null_or_lisp_nil (x))); >> } >> >> VM_DEFINE_FUNCTION (85, not_nullp, "not-null?", 1) >> { >> ARGS1 (x); >> - RETURN (SCM_BOOL (!SCM_NULLP (x))); >> + RETURN (SCM_BOOL (!scm_is_null_or_lisp_nil (x))); >> } >> >> VM_DEFINE_FUNCTION (86, eqv, "eqv?", 2) >> >> diff --git a/srfi/srfi-1.c b/srfi/srfi-1.c >> index 02f46fc..268f1dc 100644 >> --- a/srfi/srfi-1.c >> +++ b/srfi/srfi-1.c >> @@ -211,7 +211,7 @@ SCM_DEFINE (scm_srfi1_break, "break", 2, 0, 0, >> for ( ; scm_is_pair (lst); lst = SCM_CDR (lst)) >> { >> SCM elem = SCM_CAR (lst); >> - if (scm_is_true (pred_tramp (pred, elem))) >> + if (scm_is_true_and_not_lisp_nil (pred_tramp (pred, elem))) >> goto done; >> >> /* want this elem, tack it onto the end of ret */ >> @@ -243,7 +243,7 @@ SCM_DEFINE (scm_srfi1_break_x, "break!", 2, 0, 0, >> p = &lst; >> for (upto = lst; scm_is_pair (upto); upto = SCM_CDR (upto)) >> { >> - if (scm_is_true (pred_tramp (pred, SCM_CAR (upto)))) >> + if (scm_is_true_and_not_lisp_nil (pred_tramp (pred, SCM_CAR (upto)))) >> goto done; >> >> /* want this element */ >> @@ -334,7 +334,8 @@ SCM_DEFINE (scm_srfi1_count, "count", 2, 0, 1, >> SCM_ASSERT (pred_tramp, pred, SCM_ARG1, FUNC_NAME); >> >> for ( ; scm_is_pair (list1); list1 = SCM_CDR (list1)) >> - count += scm_is_true (pred_tramp (pred, SCM_CAR (list1))); >> + count += scm_is_true_and_not_lisp_nil (pred_tramp (pred, >> + SCM_CAR (list1))); >> >> /* check below that list1 is a proper list, and done */ >> end_list1: >> @@ -361,8 +362,9 @@ SCM_DEFINE (scm_srfi1_count, "count", 2, 0, 1, >> argnum = 3; >> break; >> } >> - count += scm_is_true (pred_tramp >> - (pred, SCM_CAR (list1), SCM_CAR (list2))); >> + count += scm_is_true_and_not_lisp_nil (pred_tramp >> + (pred, SCM_CAR (list1), >> + SCM_CAR (list2))); >> list1 = SCM_CDR (list1); >> list2 = SCM_CDR (list2); >> } >> @@ -396,7 +398,8 @@ SCM_DEFINE (scm_srfi1_count, "count", 2, 0, 1, >> SCM_SIMPLE_VECTOR_SET (vec, i, SCM_CDR (lst)); /* rest of lst */ >> } >> >> - count += scm_is_true (scm_apply (pred, args, SCM_EOL)); >> + count += scm_is_true_and_not_lisp_nil (scm_apply (pred, args, >> + SCM_EOL)); >> } >> } >> >> @@ -452,7 +455,7 @@ SCM_DEFINE (scm_srfi1_delete, "delete", 2, 1, 0, >> >> for ( ; scm_is_pair (lst); lst = SCM_CDR (lst)) >> { >> - if (scm_is_true (equal_p (pred, x, SCM_CAR (lst)))) >> + if (scm_is_true_and_not_lisp_nil (equal_p (pred, x, SCM_CAR (lst)))) >> { >> /* delete this element, so copy those at keeplst */ >> p = list_copy_part (keeplst, count, p); >> @@ -509,7 +512,7 @@ SCM_DEFINE (scm_srfi1_delete_x, "delete!", 2, 1, 0, >> scm_is_pair (walk); >> walk = SCM_CDR (walk)) >> { >> - if (scm_is_true (equal_p (pred, x, SCM_CAR (walk)))) >> + if (scm_is_true_and_not_lisp_nil (equal_p (pred, x, SCM_CAR (walk)))) >> *prev = SCM_CDR (walk); >> else >> prev = SCM_CDRLOC (walk); >> @@ -591,7 +594,7 @@ SCM_DEFINE (scm_srfi1_delete_duplicates, "delete-duplicates", 1, 1, 0, >> /* look for item in "ret" list */ >> for (l = ret; scm_is_pair (l); l = SCM_CDR (l)) >> { >> - if (scm_is_true (equal_p (pred, SCM_CAR (l), item))) >> + if (scm_is_true_and_not_lisp_nil (equal_p (pred, SCM_CAR (l), item))) >> { >> /* "item" is a duplicate, so copy keeplst onto ret */ >> duplicate: >> @@ -608,7 +611,7 @@ SCM_DEFINE (scm_srfi1_delete_duplicates, "delete-duplicates", 1, 1, 0, >> for (i = 0, l = keeplst; >> i < count && scm_is_pair (l); >> i++, l = SCM_CDR (l)) >> - if (scm_is_true (equal_p (pred, SCM_CAR (l), item))) >> + if (scm_is_true_and_not_lisp_nil (equal_p (pred, SCM_CAR (l), item))) >> goto duplicate; >> >> /* keep this element */ >> @@ -684,7 +687,8 @@ SCM_DEFINE (scm_srfi1_delete_duplicates_x, "delete-duplicates!", 1, 1, 0, >> l = ret; >> for (;;) >> { >> - if (scm_is_true (equal_p (pred, SCM_CAR (l), item))) >> + if (scm_is_true_and_not_lisp_nil (equal_p (pred, SCM_CAR (l), >> + item))) >> break; /* equal, forget this element */ >> >> if (scm_is_eq (l, endret)) >> @@ -770,7 +774,7 @@ SCM_DEFINE (scm_srfi1_drop_while, "drop-while", 2, 0, 0, >> SCM_ASSERT (pred_tramp, pred, SCM_ARG1, FUNC_NAME); >> >> for ( ; scm_is_pair (lst); lst = SCM_CDR (lst)) >> - if (scm_is_false (pred_tramp (pred, SCM_CAR (lst)))) >> + if (scm_is_false_or_lisp_nil (pred_tramp (pred, SCM_CAR (lst)))) >> goto done; >> >> SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (lst), lst, SCM_ARG2, FUNC_NAME, "list"); >> @@ -824,7 +828,7 @@ SCM_DEFINE (scm_srfi1_filter_map, "filter-map", 2, 0, 1, >> for ( ; scm_is_pair (list1); list1 = SCM_CDR (list1)) >> { >> elem = proc_tramp (proc, SCM_CAR (list1)); >> - if (scm_is_true (elem)) >> + if (scm_is_true_and_not_lisp_nil (elem)) >> { >> newcell = scm_cons (elem, SCM_EOL); >> *loc = newcell; >> @@ -855,7 +859,7 @@ SCM_DEFINE (scm_srfi1_filter_map, "filter-map", 2, 0, 1, >> goto check_lst_and_done; >> } >> elem = proc_tramp (proc, SCM_CAR (list1), SCM_CAR (list2)); >> - if (scm_is_true (elem)) >> + if (scm_is_true_and_not_lisp_nil (elem)) >> { >> newcell = scm_cons (elem, SCM_EOL); >> *loc = newcell; >> @@ -895,7 +899,7 @@ SCM_DEFINE (scm_srfi1_filter_map, "filter-map", 2, 0, 1, >> } >> >> elem = scm_apply (proc, args, SCM_EOL); >> - if (scm_is_true (elem)) >> + if (scm_is_true_and_not_lisp_nil (elem)) >> { >> newcell = scm_cons (elem, SCM_EOL); >> *loc = newcell; >> @@ -924,7 +928,7 @@ SCM_DEFINE (scm_srfi1_find, "find", 2, 0, 0, >> for ( ; scm_is_pair (lst); lst = SCM_CDR (lst)) >> { >> SCM elem = SCM_CAR (lst); >> - if (scm_is_true (pred_tramp (pred, elem))) >> + if (scm_is_true_and_not_lisp_nil (pred_tramp (pred, elem))) >> return elem; >> } >> SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (lst), lst, SCM_ARG2, FUNC_NAME, "list"); >> @@ -945,7 +949,7 @@ SCM_DEFINE (scm_srfi1_find_tail, "find-tail", 2, 0, 0, >> SCM_ASSERT (pred_tramp, pred, SCM_ARG1, FUNC_NAME); >> >> for ( ; scm_is_pair (lst); lst = SCM_CDR (lst)) >> - if (scm_is_true (pred_tramp (pred, SCM_CAR (lst)))) >> + if (scm_is_true_and_not_lisp_nil (pred_tramp (pred, SCM_CAR (lst)))) >> return lst; >> SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (lst), lst, SCM_ARG2, FUNC_NAME, "list"); >> >> @@ -1121,7 +1125,7 @@ SCM_DEFINE (scm_srfi1_list_index, "list-index", 2, 0, 1, >> SCM_ASSERT (pred_tramp, pred, SCM_ARG1, FUNC_NAME); >> >> for ( ; scm_is_pair (list1); n++, list1 = SCM_CDR (list1)) >> - if (scm_is_true (pred_tramp (pred, SCM_CAR (list1)))) >> + if (scm_is_true_and_not_lisp_nil (pred_tramp (pred, SCM_CAR (list1)))) >> return SCM_I_MAKINUM (n); >> >> /* not found, check below that list1 is a proper list */ >> @@ -1146,8 +1150,9 @@ SCM_DEFINE (scm_srfi1_list_index, "list-index", 2, 0, 1, >> argnum = 3; >> break; >> } >> - if (scm_is_true (pred_tramp (pred, >> - SCM_CAR (list1), SCM_CAR (list2)))) >> + if (scm_is_true_and_not_lisp_nil (pred_tramp (pred, >> + SCM_CAR (list1), >> + SCM_CAR (list2)))) >> return SCM_I_MAKINUM (n); >> >> list1 = SCM_CDR (list1); >> @@ -1183,7 +1188,7 @@ SCM_DEFINE (scm_srfi1_list_index, "list-index", 2, 0, 1, >> SCM_SIMPLE_VECTOR_SET (vec, i, SCM_CDR (lst)); /* rest of lst */ >> } >> >> - if (scm_is_true (scm_apply (pred, args, SCM_EOL))) >> + if (scm_is_true_and_not_lisp_nil (scm_apply (pred, args, SCM_EOL))) >> return SCM_I_MAKINUM (n); >> } >> } >> @@ -1286,7 +1291,8 @@ SCM_DEFINE (scm_srfi1_lset_adjoin, "lset-adjoin", 2, 0, 1, >> elem = SCM_CAR (rest); >> >> for (l = lst; scm_is_pair (l); l = SCM_CDR (l)) >> - if (scm_is_true (equal_tramp (equal, SCM_CAR (l), elem))) >> + if (scm_is_true_and_not_lisp_nil (equal_tramp (equal, SCM_CAR (l), >> + elem))) >> goto next_elem; /* elem already in lst, don't add */ >> >> SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P(l), lst, SCM_ARG2, FUNC_NAME, "list"); >> @@ -1343,7 +1349,8 @@ SCM_DEFINE (scm_srfi1_lset_difference_x, "lset-difference!", 2, 0, 1, >> r = SCM_CDR (r), argnum++) >> { >> for (b = SCM_CAR (r); scm_is_pair (b); b = SCM_CDR (b)) >> - if (scm_is_true (equal_tramp (equal, elem, SCM_CAR (b)))) >> + if (scm_is_true_and_not_lisp_nil (equal_tramp (equal, elem, >> + SCM_CAR (b)))) >> goto next_elem; /* equal to elem, so drop that elem */ >> >> SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (b), b, argnum, FUNC_NAME,"list"); >> @@ -1385,7 +1392,7 @@ check_map_args (SCM argv, >> long elt_len; >> elt = SCM_SIMPLE_VECTOR_REF (argv, i); >> >> - if (!(scm_is_null (elt) || scm_is_pair (elt))) >> + if (!(scm_is_null_or_lisp_nil (elt) || scm_is_pair (elt))) >> goto check_map_error; >> >> elt_len = srfi1_ilength (elt); >> @@ -1430,7 +1437,8 @@ scm_srfi1_map (SCM proc, SCM arg1, SCM args) >> SCM *pres = &res; >> >> len = srfi1_ilength (arg1); >> - SCM_GASSERTn ((scm_is_null (arg1) || scm_is_pair (arg1)) && len >= -1, >> + SCM_GASSERTn ((scm_is_null_or_lisp_nil (arg1) || >> + scm_is_pair (arg1)) && len >= -1, >> g_srfi1_map, >> scm_cons2 (proc, arg1, args), SCM_ARG2, s_srfi1_map); >> SCM_VALIDATE_REST_ARGUMENT (args); >> @@ -1456,7 +1464,7 @@ scm_srfi1_map (SCM proc, SCM arg1, SCM args) >> scm_cons2 (proc, arg1, args), SCM_ARG1, s_srfi1_map); >> if (len < 0 || (len2 >= 0 && len2 < len)) >> len = len2; >> - SCM_GASSERTn ((scm_is_null (arg2) || scm_is_pair (arg2)) >> + SCM_GASSERTn ((scm_is_null_or_lisp_nil (arg2) || scm_is_pair (arg2)) >> && len >= 0 && len2 >= -1, >> g_srfi1_map, >> scm_cons2 (proc, arg1, args), >> @@ -1501,7 +1509,8 @@ scm_srfi1_for_each (SCM proc, SCM arg1, SCM args) >> { >> long i, len; >> len = srfi1_ilength (arg1); >> - SCM_GASSERTn ((scm_is_null (arg1) || scm_is_pair (arg1)) && len >= -1, >> + SCM_GASSERTn ((scm_is_null_or_lisp_nil (arg1) || >> + scm_is_pair (arg1)) && len >= -1, >> g_srfi1_for_each, scm_cons2 (proc, arg1, args), >> SCM_ARG2, s_srfi1_for_each); >> SCM_VALIDATE_REST_ARGUMENT (args); >> @@ -1528,7 +1537,7 @@ scm_srfi1_for_each (SCM proc, SCM arg1, SCM args) >> scm_cons2 (proc, arg1, args), SCM_ARG1, s_srfi1_for_each); >> if (len < 0 || (len2 >= 0 && len2 < len)) >> len = len2; >> - SCM_GASSERTn ((scm_is_null (arg2) || scm_is_pair (arg2)) >> + SCM_GASSERTn ((scm_is_null_or_lisp_nil (arg2) || scm_is_pair (arg2)) >> && len >= 0 && len2 >= -1, >> g_srfi1_for_each, >> scm_cons2 (proc, arg1, args), >> @@ -1593,7 +1602,7 @@ SCM_DEFINE (scm_srfi1_member, "member", 2, 1, 0, >> } >> for (; !SCM_NULL_OR_NIL_P (lst); lst = SCM_CDR (lst)) >> { >> - if (scm_is_true (equal_p (pred, x, SCM_CAR (lst)))) >> + if (scm_is_true_and_not_lisp_nil (equal_p (pred, x, SCM_CAR (lst)))) >> return lst; >> } >> return SCM_BOOL_F; >> @@ -1621,7 +1630,7 @@ SCM_DEFINE (scm_srfi1_assoc, "assoc", 2, 1, 0, >> SCM tmp = SCM_CAR (ls); >> SCM_ASSERT_TYPE (scm_is_pair (tmp), alist, SCM_ARG2, FUNC_NAME, >> "association list"); >> - if (scm_is_true (equal_p (pred, key, SCM_CAR (tmp)))) >> + if (scm_is_true_and_not_lisp_nil (equal_p (pred, key, SCM_CAR (tmp)))) >> return tmp; >> } >> SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (ls), alist, SCM_ARG2, FUNC_NAME, >> @@ -1685,7 +1694,7 @@ SCM_DEFINE (scm_srfi1_partition, "partition", 2, 0, 0, >> elt = SCM_CAR (list); >> new_tail = scm_cons (SCM_CAR (list), SCM_EOL); >> >> - if (scm_is_true (call (pred, elt))) { >> + if (scm_is_true_and_not_lisp_nil (call (pred, elt))) { >> SCM_SETCDR(kept_tail, new_tail); >> kept_tail = new_tail; >> } >> @@ -1737,7 +1746,7 @@ SCM_DEFINE (scm_srfi1_partition_x, "partition!", 2, 0, 0, >> >> for ( ; scm_is_pair (lst); lst = SCM_CDR (lst)) >> { >> - if (scm_is_true (pred_tramp (pred, SCM_CAR (lst)))) >> + if (scm_is_true_and_not_lisp_nil (pred_tramp (pred, SCM_CAR (lst)))) >> { >> *tp = lst; >> tp = SCM_CDRLOC (lst); >> @@ -1906,7 +1915,7 @@ SCM_DEFINE (scm_srfi1_remove, "remove", 2, 0, 0, >> scm_is_pair (walk); >> walk = SCM_CDR (walk)) >> { >> - if (scm_is_false (call (pred, SCM_CAR (walk)))) >> + if (scm_is_false_or_lisp_nil (call (pred, SCM_CAR (walk)))) >> { >> *prev = scm_cons (SCM_CAR (walk), SCM_EOL); >> prev = SCM_CDRLOC (*prev); >> @@ -1938,7 +1947,7 @@ SCM_DEFINE (scm_srfi1_remove_x, "remove!", 2, 0, 0, >> scm_is_pair (walk); >> walk = SCM_CDR (walk)) >> { >> - if (scm_is_false (call (pred, SCM_CAR (walk)))) >> + if (scm_is_false_or_lisp_nil (call (pred, SCM_CAR (walk)))) >> prev = SCM_CDRLOC (walk); >> else >> *prev = SCM_CDR (walk); >> @@ -1987,7 +1996,7 @@ SCM_DEFINE (scm_srfi1_span, "span", 2, 0, 0, >> for ( ; scm_is_pair (lst); lst = SCM_CDR (lst)) >> { >> SCM elem = SCM_CAR (lst); >> - if (scm_is_false (pred_tramp (pred, elem))) >> + if (scm_is_false_or_lisp_nil (pred_tramp (pred, elem))) >> goto done; >> >> /* want this elem, tack it onto the end of ret */ >> @@ -2019,7 +2028,7 @@ SCM_DEFINE (scm_srfi1_span_x, "span!", 2, 0, 0, >> p = &lst; >> for (upto = lst; scm_is_pair (upto); upto = SCM_CDR (upto)) >> { >> - if (scm_is_false (pred_tramp (pred, SCM_CAR (upto)))) >> + if (scm_is_false_or_lisp_nil (pred_tramp (pred, SCM_CAR (upto)))) >> goto done; >> >> /* want this element */ >> @@ -2147,7 +2156,7 @@ SCM_DEFINE (scm_srfi1_take_while, "take-while", 2, 0, 0, >> for ( ; scm_is_pair (lst); lst = SCM_CDR (lst)) >> { >> SCM elem = SCM_CAR (lst); >> - if (scm_is_false (pred_tramp (pred, elem))) >> + if (scm_is_false_or_lisp_nil (pred_tramp (pred, elem))) >> goto done; >> >> /* want this elem, tack it onto the end of ret */ >> @@ -2178,7 +2187,7 @@ SCM_DEFINE (scm_srfi1_take_while_x, "take-while!", 2, 0, 0, >> p = &lst; >> for (upto = lst; scm_is_pair (upto); upto = SCM_CDR (upto)) >> { >> - if (scm_is_false (pred_tramp (pred, SCM_CAR (upto)))) >> + if (scm_is_false_or_lisp_nil (pred_tramp (pred, SCM_CAR (upto)))) >> goto done; >> >> /* want this element */ >> >> diff --git a/libguile/discouraged.h b/libguile/discouraged.h >> index 1be05f0..0411069 100644 >> --- a/libguile/discouraged.h >> +++ b/libguile/discouraged.h >> @@ -54,6 +54,9 @@ >> >> /* SCM_BOOL_NOT returns the other boolean. >> * The order of ^s here is important for Borland C++ (!?!?!) >> + * >> + * XXX Should this handle %nil properly, and thus be >> + * defined as (scm_from_bool (scm_is_false_or_lisp_nil (x))) ? >> */ >> #define SCM_BOOL_NOT(x) (SCM_PACK (SCM_UNPACK (x) \ >> ^ (SCM_UNPACK (SCM_BOOL_T) \ >> diff --git a/libguile/goops.c b/libguile/goops.c >> index 1548472..b6234a6 100644 >> --- a/libguile/goops.c >> +++ b/libguile/goops.c >> @@ -190,11 +190,12 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0, >> return scm_class_integer; >> >> case scm_tc3_imm24: >> + /* XXX What should be done with SCM_ELISP_NIL? */ >> if (SCM_CHARP (x)) >> return scm_class_char; >> - else if (scm_is_bool (x)) >> + else if (scm_is_bool_and_not_lisp_nil (x)) >> return scm_class_boolean; >> - else if (scm_is_null (x)) >> + else if (scm_is_null_and_not_lisp_nil (x)) >> return scm_class_null; >> else >> return scm_class_unknown;