From aef35c0e7d006331c107610d590460873fa48da8 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 28 Jun 2004 13:31:36 +0000 Subject: [PATCH 01/58] *** empty log message *** --- doc/goops/ChangeLog | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/doc/goops/ChangeLog b/doc/goops/ChangeLog index a04b81ab5..2283fde45 100644 --- a/doc/goops/ChangeLog +++ b/doc/goops/ChangeLog @@ -1,3 +1,11 @@ +2004-06-28 Marius Vollmer + + * Makefile.am: Removed home-grown code for HTML generation. + Automake does it for us now. + (goops_TEXINFOS): Added hierarchy.png + + * hierarchy.png: New file. + 2004-05-19 Kevin Ryde * Makefile.am (CLEANFILES): Remove, goops.tmp goops.cps cleaned by From 7aaaee73a035b18fd8d0387a031b685f19e45a6f Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 28 Jun 2004 13:39:31 +0000 Subject: [PATCH 02/58] Removed code for --enable-htmldoc; support for HTML is now included in automake. --- configure.in | 22 ---------------------- 1 file changed, 22 deletions(-) diff --git a/configure.in b/configure.in index 886e9ff77..0ea2576ef 100644 --- a/configure.in +++ b/configure.in @@ -132,28 +132,6 @@ AC_ARG_ENABLE(regex, [ --disable-regex omit regular expression interfaces],, enable_regex=yes) -AC_ARG_ENABLE(htmldoc, - [ --enable-htmldoc build HTML documentation as well as Info], - [if test "$enable_htmldoc" = "" || test "$enable_htmldoc" = y || test "$enable_htmldoc" = yes; then - htmldoc_enabled=yes - AC_PATH_PROG(TEXI2HTML, texi2html, not found) - if test "$TEXI2HTML" = "not found"; then - echo - echo Building HTML documentation requires the \`texi2html\' program, - echo which appears not to be present on your machine. - echo - echo \`texi2html\' is available from - echo 'http://www.mathematik.uni-kl.de/~obachman/Texi2html/.' - echo - echo In the meantime, to build the guile-doc distribution - echo without HTML enabled, please rerun \`./configure\' without - echo the \`--enable-htmldoc\' option. - exit -1 - fi - fi]) - -AM_CONDITIONAL(HTMLDOC, test x$htmldoc_enabled = xyes) - AC_ARG_ENABLE([deprecated], AC_HELP_STRING([--disable-deprecated],[omit deprecated features])) From ae7ded5671c02092b767a643c73d5b1a20368309 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 28 Jun 2004 13:40:18 +0000 Subject: [PATCH 03/58] *** empty log message *** --- ChangeLog | 5 +++++ NEWS | 5 +++++ 2 files changed, 10 insertions(+) diff --git a/ChangeLog b/ChangeLog index fddb1c8a2..71837dd17 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2004-06-28 Marius Vollmer + + * configure.in: Removed code for --enable-htmldoc; support for + HTML is now included in automake. + 2004-06-16 Rob Browning * pre-inst-guile.in: modify to handle move of readline.scm to diff --git a/NEWS b/NEWS index c348cf295..3a3dfb024 100644 --- a/NEWS +++ b/NEWS @@ -128,6 +128,11 @@ This is an implementation of SRFI-31 which provides a special form We now use a modified version of libltdl that allows us to make improvements to it without having to rely on libtool releases. +** The --enable-htmldoc option has been removed from 'configure'. + +Support for translating the documentation into HTML is now always +provided. Use 'make html'. + * Changes to the stand-alone interpreter ** New command line option `--no-debug'. From c0967f56b0c26745cec559d8faffbb814c87ca43 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Sun, 4 Jul 2004 23:57:10 +0000 Subject: [PATCH 04/58] (uvec_sizes): Add "const". --- srfi/srfi-4.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/srfi/srfi-4.c b/srfi/srfi-4.c index 1d5e9820f..4a37112ed 100644 --- a/srfi/srfi-4.c +++ b/srfi/srfi-4.c @@ -1,6 +1,6 @@ /* srfi-4.c --- Homogeneous numeric vector datatypes. * - * Copyright (C) 2001 Free Software Foundation, Inc. + * Copyright (C) 2001, 2004 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public @@ -73,7 +73,7 @@ int scm_tc16_uvec = 0; /* This array maps type tags to the size of the elements. */ -static int uvec_sizes[10] = {1, 1, 2, 2, 4, 4, 8, 8, 4, 8}; +static const int uvec_sizes[10] = {1, 1, 2, 2, 4, 4, 8, 8, 4, 8}; #if SCM_HAVE_T_INT64 From 981e8059b9674e231d0bef04305b7a56022cc836 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Sun, 4 Jul 2004 23:58:05 +0000 Subject: [PATCH 05/58] *** empty log message *** --- srfi/ChangeLog | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/srfi/ChangeLog b/srfi/ChangeLog index 5a59d11fe..d6c3ff778 100644 --- a/srfi/ChangeLog +++ b/srfi/ChangeLog @@ -1,3 +1,7 @@ +2004-07-05 Kevin Ryde + + * srfi-4.c (uvec_sizes): Add "const". + 2004-06-20 Rob Browning * srfi-4.c: fix #ifdef checks for 64-bit types; should be #if. From b2e723816a67fef5f20f16fef68351508dc350df Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Mon, 5 Jul 2004 00:00:48 +0000 Subject: [PATCH 06/58] Correction to heading comment. --- srfi/srfi-31.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/srfi/srfi-31.scm b/srfi/srfi-31.scm index cc9709117..69e5c0147 100644 --- a/srfi/srfi-31.scm +++ b/srfi/srfi-31.scm @@ -1,4 +1,4 @@ -;;; srfi-34.scm --- Time/Date Library +;;; srfi-31.scm --- special form for recursive evaluation ;; Copyright (C) 2004 Free Software Foundation, Inc. ;; From ad3e9ceb94775bfcc4a49b89de75bed3cb908760 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Mon, 5 Jul 2004 00:01:48 +0000 Subject: [PATCH 07/58] *** empty log message *** --- srfi/ChangeLog | 2 ++ 1 file changed, 2 insertions(+) diff --git a/srfi/ChangeLog b/srfi/ChangeLog index d6c3ff778..b8ea311a1 100644 --- a/srfi/ChangeLog +++ b/srfi/ChangeLog @@ -2,6 +2,8 @@ * srfi-4.c (uvec_sizes): Add "const". + * srfi-31.scm: Correction to heading comment. + 2004-06-20 Rob Browning * srfi-4.c: fix #ifdef checks for 64-bit types; should be #if. From 4d0bfea13049ee348144bb76ba37d28abfc88d63 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Mon, 5 Jul 2004 00:04:39 +0000 Subject: [PATCH 08/58] (isinf, isnan): Detect macro versions as well as functions, since C99 specifies them as macros and that's all HP-UX has. Reported by Andreas Voegele. --- configure.in | 26 +++++++++++++++++++++++++- 1 file changed, 25 insertions(+), 1 deletion(-) diff --git a/configure.in b/configure.in index 0ea2576ef..265d2e990 100644 --- a/configure.in +++ b/configure.in @@ -844,7 +844,31 @@ AC_CHECK_HEADERS(floatingpoint.h ieeefp.h nan.h) # older systems # sincos - GLIBC extension # -AC_CHECK_FUNCS(asinh acosh atanh copysign finite isinf isnan sincos trunc) +AC_CHECK_FUNCS(asinh acosh atanh copysign finite sincos trunc) + +# C99 specifies isinf and isnan as macros. +# HP-UX provides only macros, no functions. +# Glibc 2.3.2 provides both macros and functions. +# +# We're concerned that some systems may have only functions, the following +# tests are designed to detect both functions and macros. +# +AC_MSG_CHECKING([for isinf]) +AC_LINK_IFELSE( +[#include +int main () { return (isinf(0.0) != 0); }], + [AC_MSG_RESULT([yes]) + AC_DEFINE(HAVE_ISINF, 1, + [Define to 1 if you have the `isinf' macro or function.])], + [AC_MSG_RESULT([no])]) +AC_MSG_CHECKING([for isnan]) +AC_LINK_IFELSE( +[#include +int main () { return (isnan(0.0) != 0); }], + [AC_MSG_RESULT([yes]) + AC_DEFINE(HAVE_ISNAN, 1, + [Define to 1 if you have the `isnan' macro or function.])], + [AC_MSG_RESULT([no])]) # When testing for the presence of alloca, we need to add alloca.o # explicitly to LIBOBJS to make sure that it is translated to From fbacbccede5e0f076188b901b1209ba0ad2e9dad Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Mon, 5 Jul 2004 00:08:24 +0000 Subject: [PATCH 09/58] (system): Correction to redefinition, now guile is stricter about when a define binding comes into existance. --- ice-9/slib.scm | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/ice-9/slib.scm b/ice-9/slib.scm index 423653c75..83513459c 100644 --- a/ice-9/slib.scm +++ b/ice-9/slib.scm @@ -257,8 +257,9 @@ ;; waitpid with WUNTRACED, but allow for it anyway, just in case. ;; (if (defined? 'system) - (define-public system - (let ((guile-core-system system)) + (begin + (define guile-core-system system) + (define-public system (lambda (str) (let ((st (guile-core-system str))) (or (status:exit-val st) From 40827c6d16648487e6183d92639191125df2e102 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Mon, 5 Jul 2004 00:09:17 +0000 Subject: [PATCH 10/58] *** empty log message *** --- ice-9/ChangeLog | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog index de6819d4a..581e367e4 100644 --- a/ice-9/ChangeLog +++ b/ice-9/ChangeLog @@ -1,3 +1,8 @@ +2004-07-05 Kevin Ryde + + * slib.scm (system): Correction to redefinition, now guile is stricter + about when a define binding comes into existance. + 2004-05-29 Dirk Herrmann * boot-9.scm: Reordered definitions such that macro definitions From e4e249c1b8e5a2dfb619871227ff7ccc8ed000f7 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Mon, 5 Jul 2004 00:21:24 +0000 Subject: [PATCH 11/58] *** empty log message *** --- ChangeLog | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/ChangeLog b/ChangeLog index 71837dd17..e5118a539 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2004-07-05 Kevin Ryde + + * configure.in (isinf, isnan): Detect macro versions as well as + functions, since C99 specifies them as macros and that's all HP-UX + has. Reported by Andreas Voegele. + 2004-06-28 Marius Vollmer * configure.in: Removed code for --enable-htmldoc; support for From 3a684cc6c979b57512af1feb88f1517d506c2088 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 5 Jul 2004 17:13:39 +0000 Subject: [PATCH 12/58] (scm_is_true, scm_is_false, scm_from_bool, scm_to_bool): New. --- libguile/boolean.c | 15 +++++++++++++++ libguile/boolean.h | 8 ++++++++ 2 files changed, 23 insertions(+) diff --git a/libguile/boolean.c b/libguile/boolean.c index 97cffe845..1f6b5b037 100644 --- a/libguile/boolean.c +++ b/libguile/boolean.c @@ -45,7 +45,22 @@ SCM_DEFINE (scm_boolean_p, "boolean?", 1, 0, 0, } #undef FUNC_NAME +int +scm_is_bool (SCM x) +{ + return scm_is_eq (x, SCM_BOOL_F) || scm_is_eq (SCM_BOOL_T); +} +int +scm_to_bool (SCM x) +{ + if (scm_is_eq (x, SCM_BOOL_F)) + return 0; + else if (scm_is_eq (x, SCM_BOOL_T)) + return 1; + else + scm_wrong_type_arg (NULL, 0, x); +} void scm_init_boolean () diff --git a/libguile/boolean.h b/libguile/boolean.h index 982c950d6..63cc06006 100644 --- a/libguile/boolean.h +++ b/libguile/boolean.h @@ -47,10 +47,18 @@ ^ (SCM_UNPACK (SCM_BOOL_T) \ ^ SCM_UNPACK (SCM_BOOL_F)))) +#define scm_is_false(x) scm_is_eq ((x), SCM_BOOL_F) +#define scm_is_true(x) !scm_is_false (x) + +SCM_API int scm_is_bool(x); +#define scm_from_bool(x) ((f) ? SCM_BOOL_T : SCM_BOOL_F) +SCM_API int scm_to_bool (SCM x); + SCM_API SCM scm_not (SCM x); SCM_API SCM scm_boolean_p (SCM obj); + SCM_API void scm_init_boolean (void); #endif /* SCM_BOOLEAN_H */ From 800570a6c79ec08c3f76ef23634dbd5e6558678a Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 5 Jul 2004 17:14:23 +0000 Subject: [PATCH 13/58] *** empty log message *** --- libguile/ChangeLog | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index d6186fb5b..6fd885239 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,8 @@ +2004-07-05 Marius Vollmer + + * boolean.h, boolean.c (scm_is_true, scm_is_false, scm_from_bool, + scm_to_bool): New. + 2004-06-27 Dirk Herrmann * backtrace.c (display_expression, display_frame): Call From 103f4adfbf4dbd45f1ce31529b929498b3543d86 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 5 Jul 2004 17:37:41 +0000 Subject: [PATCH 14/58] (Booleans): Added reference entries for scm_is_true, scm_is_false, scm_is_bool, scm_from_bool, and scm_to_bool. --- doc/ref/scheme-data.texi | 57 ++++++++++++++++++++++++++-------------- 1 file changed, 38 insertions(+), 19 deletions(-) diff --git a/doc/ref/scheme-data.texi b/doc/ref/scheme-data.texi index 6a23fc95c..3c87268c3 100755 --- a/doc/ref/scheme-data.texi +++ b/doc/ref/scheme-data.texi @@ -108,41 +108,60 @@ In C, the two Scheme boolean values are available as the two constants @code{SCM_BOOL_T} for @code{#t} and @code{SCM_BOOL_F} for @code{#f}. Care must be taken with the false value @code{SCM_BOOL_F}: it is not false when used in C conditionals. In order to test for it, use -@code{SCM_FALSEP} or @code{SCM_NFALSEP}. +@code{scm_is_false} or @code{scm_is_true}. @rnindex not @deffn {Scheme Procedure} not x @deffnx {C Function} scm_not (x) -Return @code{#t} iff @var{x} is @code{#f}, else return @code{#f}. +Return @code{#t} if @var{x} is @code{#f}, else return @code{#f}. @end deffn @rnindex boolean? @deffn {Scheme Procedure} boolean? obj @deffnx {C Function} scm_boolean_p (obj) -Return @code{#t} iff @var{obj} is either @code{#t} or @code{#f}. +Return @code{#t} if @var{obj} is either @code{#t} or @code{#f}, else +return @code{#f}. @end deffn @rnindex SCM_BOOL_T -@deffn {C Macro} SCM_BOOL_T -Represents a value that is true in the Scheme sense. -@end deffn +@deftypevr {C Macro} SCM SCM_BOOL_T +The @code{SCM} representation of the Scheme object @code{#t}. +@end deftypevr @rnindex SCM_BOOL_T -@deffn {C Macro} SCM_BOOL_F -Represents a value that is false in the Scheme sense. -@end deffn +@deftypevr {C Macro} SCM SCM_BOOL_F +The @code{SCM} representation of the Scheme object @code{#f}. +@end deftypevr -@rnindex SCM_FALSEP -@deffn {C Macro} SCM_FALSEP (SCM obj) -Return true in the C sense when @var{obj} is false in the Scheme -sense; return false in the C sense otherwise. -@end deffn +@rnindex scm_is_true +@deftypefn {C Macro} int scm_is_true (SCM obj) +Return @code{0} if @var{obj} is @code{#f}, else return @code{1}. +@end deftypefn -@rnindex SCM_NFALSEP -@deffn {C Macro} SCM_NFALSEP (SCM obj) -Return true in the C sense when @var{obj} is true in the Scheme -sense; return false in the C sense otherwise. -@end deffn +@rnindex scm_is_false +@deftypefn {C Macro} int scm_is_false (SCM obj) +Return @code{1} if @var{obj} is @code{#f}, else return @code{0}. +@end deftypefn + +@rnindex scm_is_bool +@deftypefn {C Macro} scm_is_bool (SCM obj) +Return @code{1} if @var{obj} is either @code{#t} or @code{#f}, else +return @code{0}. +@end deftypefn + +@rnindex scm_from_bool +@deftypefn {C Macro} SCM scm_from_bool (int val) +Return @code{#f} if @var{val} is @code{0}, else return @code{#t}. +@end deftypefn + +@rnindex scm_to_bool +@deftypefn {C Macro} int scm_to_bool (SCM val) +Return @code{1} if @var{val} is @code{SCM_BOOL_T}, return @code{0} +when @var{val} is @code{SCM_BOOL_F}, else signal a `wrong type' error. + +You should probably use @code{scm_is_true} instead of this function +when you just want to test a @code{SCM} value for trueness. +@end deftypefn @node Numbers @subsection Numerical data types From 71ab4b5057d008c0ed1f4ec77307f6439bbf67fc Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 5 Jul 2004 17:38:19 +0000 Subject: [PATCH 15/58] *** empty log message *** --- doc/ref/ChangeLog | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index 280e810e4..8cee40148 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,9 @@ +2004-07-05 Marius Vollmer + + * scheme-data.texi (Booleans): Added reference entries for + scm_is_true, scm_is_false, scm_is_bool, scm_from_bool, and + scm_to_bool. + 2004-06-28 Marius Vollmer * Makefile.am: Removed home-grown code for HTML generation. From 0954f871cdd1cc201b99c3295ff32eae853b3be5 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Tue, 6 Jul 2004 09:54:35 +0000 Subject: [PATCH 16/58] *** empty log message *** --- emacs/.cvsignore | 16 +++++++++++++--- 1 file changed, 13 insertions(+), 3 deletions(-) diff --git a/emacs/.cvsignore b/emacs/.cvsignore index d6870b18c..1d2926ce4 100644 --- a/emacs/.cvsignore +++ b/emacs/.cvsignore @@ -1,6 +1,16 @@ +*.info Makefile Makefile.in -version.texi -*.info -stamp-vti +gds.aux +gds.cp +gds.dvi +gds.fn +gds.ky +gds.log +gds.pg +gds.toc +gds.tp +gds.vr mdate-sh +stamp-vti +version.texi From ede310d888afd9d5ef8d36fc0f30b6263d6dc807 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Tue, 6 Jul 2004 10:05:45 +0000 Subject: [PATCH 17/58] * 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. --- libguile/boolean.h | 20 ++------------------ libguile/deprecated.h | 22 ++++++++++++++++++++++ 2 files changed, 24 insertions(+), 18 deletions(-) diff --git a/libguile/boolean.h b/libguile/boolean.h index 63cc06006..5285021ae 100644 --- a/libguile/boolean.h +++ b/libguile/boolean.h @@ -29,29 +29,13 @@ /* Boolean Values * */ -#define SCM_FALSEP(x) (SCM_EQ_P ((x), SCM_BOOL_F)) -#define SCM_NFALSEP(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) - -/* Convert from a C boolean to a SCM boolean value and negate it */ -#define SCM_NEGATE_BOOL(f) ((f) ? SCM_BOOL_F : SCM_BOOL_T) - -/* SCM_BOOL_NOT returns the other boolean. - * The order of ^s here is important for Borland C++ (!?!?!) - */ -#define SCM_BOOL_NOT(x) (SCM_PACK (SCM_UNPACK (x) \ - ^ (SCM_UNPACK (SCM_BOOL_T) \ - ^ SCM_UNPACK (SCM_BOOL_F)))) #define scm_is_false(x) scm_is_eq ((x), SCM_BOOL_F) #define scm_is_true(x) !scm_is_false (x) -SCM_API int scm_is_bool(x); -#define scm_from_bool(x) ((f) ? SCM_BOOL_T : SCM_BOOL_F) +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); diff --git a/libguile/deprecated.h b/libguile/deprecated.h index 56cf5e0b9..0091d7c46 100644 --- a/libguile/deprecated.h +++ b/libguile/deprecated.h @@ -305,6 +305,28 @@ SCM_API SCM scm_gentemp (SCM prefix, SCM obarray); #define SCM_CELL_WORD_LOC(x, n) ((scm_t_bits*)SCM_CELL_OBJECT_LOC((x),(n))) +#define SCM_FALSEP(x) (SCM_EQ_P ((x), SCM_BOOL_F)) +#define SCM_NFALSEP(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) + +/* Convert from a C boolean to a SCM boolean value and negate it */ +#define SCM_NEGATE_BOOL(f) ((f) ? SCM_BOOL_F : SCM_BOOL_T) + +/* SCM_BOOL_NOT returns the other boolean. + * The order of ^s here is important for Borland C++ (!?!?!) + */ +#define SCM_BOOL_NOT(x) (SCM_PACK (SCM_UNPACK (x) \ + ^ (SCM_UNPACK (SCM_BOOL_T) \ + ^ SCM_UNPACK (SCM_BOOL_F)))) + +#if 0 +SCM_API SCM SCM_MAKINUM (scm_t_signed_bits val); +#endif + void scm_i_init_deprecated (void); #endif From 73e4de09b9f21609251df9e1098105208bac1a63 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Tue, 6 Jul 2004 10:23:30 +0000 Subject: [PATCH 18/58] (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. * 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. --- libguile/numbers.c | 519 +++++++++++++++++++++++++++++++++++++-------- libguile/numbers.h | 74 ++++++- 2 files changed, 498 insertions(+), 95 deletions(-) diff --git a/libguile/numbers.c b/libguile/numbers.c index 6187fefdc..ab791edd4 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -346,7 +346,7 @@ scm_make_ratio (SCM numerator, SCM denominator) /* Then flip signs so that the denominator is positive. */ - if (SCM_NFALSEP (scm_negative_p (denominator))) + if (scm_is_true (scm_negative_p (denominator))) { numerator = scm_difference (numerator, SCM_UNDEFINED); denominator = scm_difference (denominator, SCM_UNDEFINED); @@ -459,15 +459,15 @@ SCM_DEFINE (scm_odd_p, "odd?", 1, 0, 0, if (SCM_INUMP (n)) { long val = SCM_INUM (n); - return SCM_BOOL ((val & 1L) != 0); + return scm_from_bool ((val & 1L) != 0); } else if (SCM_BIGP (n)) { int odd_p = mpz_odd_p (SCM_I_BIG_MPZ (n)); scm_remember_upto_here_1 (n); - return SCM_BOOL (odd_p); + return scm_from_bool (odd_p); } - else if (!SCM_FALSEP (scm_inf_p (n))) + else if (scm_is_true (scm_inf_p (n))) return SCM_BOOL_T; else if (SCM_REALP (n)) { @@ -494,15 +494,15 @@ SCM_DEFINE (scm_even_p, "even?", 1, 0, 0, if (SCM_INUMP (n)) { long val = SCM_INUM (n); - return SCM_BOOL ((val & 1L) == 0); + return scm_from_bool ((val & 1L) == 0); } else if (SCM_BIGP (n)) { int even_p = mpz_even_p (SCM_I_BIG_MPZ (n)); scm_remember_upto_here_1 (n); - return SCM_BOOL (even_p); + return scm_from_bool (even_p); } - else if (!SCM_FALSEP (scm_inf_p (n))) + else if (scm_is_true (scm_inf_p (n))) return SCM_BOOL_T; else if (SCM_REALP (n)) { @@ -526,9 +526,9 @@ SCM_DEFINE (scm_inf_p, "inf?", 1, 0, 0, #define FUNC_NAME s_scm_inf_p { if (SCM_REALP (n)) - return SCM_BOOL (xisinf (SCM_REAL_VALUE (n))); + return scm_from_bool (xisinf (SCM_REAL_VALUE (n))); else if (SCM_COMPLEXP (n)) - return SCM_BOOL (xisinf (SCM_COMPLEX_REAL (n)) + return scm_from_bool (xisinf (SCM_COMPLEX_REAL (n)) || xisinf (SCM_COMPLEX_IMAG (n))); else return SCM_BOOL_F; @@ -542,9 +542,9 @@ SCM_DEFINE (scm_nan_p, "nan?", 1, 0, 0, #define FUNC_NAME s_scm_nan_p { if (SCM_REALP (n)) - return SCM_BOOL (xisnan (SCM_REAL_VALUE (n))); + return scm_from_bool (xisnan (SCM_REAL_VALUE (n))); else if (SCM_COMPLEXP (n)) - return SCM_BOOL (xisnan (SCM_COMPLEX_REAL (n)) + return scm_from_bool (xisnan (SCM_COMPLEX_REAL (n)) || xisnan (SCM_COMPLEX_IMAG (n))); else return SCM_BOOL_F; @@ -671,7 +671,7 @@ SCM_PRIMITIVE_GENERIC (scm_abs, "abs", 1, 0, 0, } else if (SCM_FRACTIONP (x)) { - if (SCM_FALSEP (scm_negative_p (SCM_FRACTION_NUMERATOR (x)))) + if (scm_is_false (scm_negative_p (SCM_FRACTION_NUMERATOR (x)))) return x; return scm_make_ratio (scm_difference (SCM_FRACTION_NUMERATOR (x), SCM_UNDEFINED), SCM_FRACTION_DENOMINATOR (x)); @@ -1414,7 +1414,7 @@ SCM_DEFINE (scm_logtest, "logtest", 2, 0, 0, if (SCM_INUMP (k)) { long nk = SCM_INUM (k); - return SCM_BOOL (nj & nk); + return scm_from_bool (nj & nk); } else if (SCM_BIGP (k)) { @@ -1427,7 +1427,7 @@ SCM_DEFINE (scm_logtest, "logtest", 2, 0, 0, mpz_init_set_si (nj_z, nj); mpz_and (nj_z, nj_z, SCM_I_BIG_MPZ (k)); scm_remember_upto_here_1 (k); - result = SCM_BOOL (mpz_sgn (nj_z) != 0); + result = scm_from_bool (mpz_sgn (nj_z) != 0); mpz_clear (nj_z); return result; } @@ -1452,7 +1452,7 @@ SCM_DEFINE (scm_logtest, "logtest", 2, 0, 0, SCM_I_BIG_MPZ (j), SCM_I_BIG_MPZ (k)); scm_remember_upto_here_2 (j, k); - result = SCM_BOOL (mpz_sgn (result_z) != 0); + result = scm_from_bool (mpz_sgn (result_z) != 0); mpz_clear (result_z); return result; } @@ -1486,13 +1486,13 @@ SCM_DEFINE (scm_logbit_p, "logbit?", 2, 0, 0, { /* bits above what's in an inum follow the sign bit */ iindex = min (iindex, SCM_LONG_BIT - 1); - return SCM_BOOL ((1L << iindex) & SCM_INUM (j)); + return scm_from_bool ((1L << iindex) & SCM_INUM (j)); } else if (SCM_BIGP (j)) { int val = mpz_tstbit (SCM_I_BIG_MPZ (j), iindex); scm_remember_upto_here_1 (j); - return SCM_BOOL (val); + return scm_from_bool (val); } else SCM_WRONG_TYPE_ARG (SCM_ARG2, j); @@ -1670,9 +1670,9 @@ SCM_DEFINE (scm_integer_expt, "integer-expt", 2, 0, 0, /* 0^0 == 1 according to R5RS */ if (SCM_EQ_P (n, SCM_INUM0) || SCM_EQ_P (n, acc)) - return SCM_FALSEP (scm_zero_p(k)) ? n : acc; + return scm_is_false (scm_zero_p(k)) ? n : acc; else if (SCM_EQ_P (n, SCM_MAKINUM (-1L))) - return SCM_FALSEP (scm_even_p (k)) ? n : acc; + return scm_is_false (scm_even_p (k)) ? n : acc; if (SCM_INUMP (k)) i2 = SCM_INUM (k); @@ -1785,7 +1785,7 @@ SCM_DEFINE (scm_ash, "ash", 2, 0, 0, SCM_MAKINUM (-bits_to_shift)); /* scm_quotient assumes its arguments are integers, but it's legal to (ash 1/2 -1) */ - if (SCM_FALSEP (scm_negative_p (n))) + if (scm_is_false (scm_negative_p (n))) return scm_quotient (n, div); else return scm_sum (SCM_MAKINUM (-1L), @@ -2665,7 +2665,7 @@ mem2ureal (const char* mem, size_t len, unsigned int *p_idx, SCM uinteger; uinteger = mem2uinteger (mem, len, &idx, radix, &x); - if (SCM_FALSEP (uinteger)) + if (scm_is_false (uinteger)) return SCM_BOOL_F; if (idx == len) @@ -2677,7 +2677,7 @@ mem2ureal (const char* mem, size_t len, unsigned int *p_idx, idx++; divisor = mem2uinteger (mem, len, &idx, radix, &x); - if (SCM_FALSEP (divisor)) + if (scm_is_false (divisor)) return SCM_BOOL_F; /* both are int/big here, I assume */ @@ -2686,7 +2686,7 @@ mem2ureal (const char* mem, size_t len, unsigned int *p_idx, else if (radix == 10) { result = mem2decimal_from_point (uinteger, mem, len, &idx, &x); - if (SCM_FALSEP (result)) + if (scm_is_false (result)) return SCM_BOOL_F; } else @@ -2736,7 +2736,7 @@ mem2complex (const char* mem, size_t len, unsigned int idx, return SCM_BOOL_F; ureal = mem2ureal (mem, len, &idx, radix, p_exactness); - if (SCM_FALSEP (ureal)) + if (scm_is_false (ureal)) { /* input must be either +i or -i */ @@ -2756,7 +2756,7 @@ mem2complex (const char* mem, size_t len, unsigned int idx, } else { - if (sign == -1 && SCM_FALSEP (scm_nan_p (ureal))) + if (sign == -1 && scm_is_false (scm_nan_p (ureal))) ureal = scm_difference (ureal, SCM_UNDEFINED); if (idx == len) @@ -2802,12 +2802,12 @@ mem2complex (const char* mem, size_t len, unsigned int idx, sign = 1; angle = mem2ureal (mem, len, &idx, radix, p_exactness); - if (SCM_FALSEP (angle)) + if (scm_is_false (angle)) return SCM_BOOL_F; if (idx != len) return SCM_BOOL_F; - if (sign == -1 && SCM_FALSEP (scm_nan_p (ureal))) + if (sign == -1 && scm_is_false (scm_nan_p (ureal))) angle = scm_difference (angle, SCM_UNDEFINED); result = scm_make_polar (ureal, angle); @@ -2825,9 +2825,9 @@ mem2complex (const char* mem, size_t len, unsigned int idx, int sign = (c == '+') ? 1 : -1; SCM imag = mem2ureal (mem, len, &idx, radix, p_exactness); - if (SCM_FALSEP (imag)) + if (scm_is_false (imag)) imag = SCM_MAKINUM (sign); - else if (sign == -1 && SCM_FALSEP (scm_nan_p (ureal))) + else if (sign == -1 && scm_is_false (scm_nan_p (ureal))) imag = scm_difference (imag, SCM_UNDEFINED); if (idx == len) @@ -2908,7 +2908,7 @@ scm_i_mem2number (const char* mem, size_t len, unsigned int default_radix) else result = mem2complex (mem, len, idx, (unsigned int) radix, &implicit_x); - if (SCM_FALSEP (result)) + if (scm_is_false (result)) return SCM_BOOL_F; switch (forced_x) @@ -2997,19 +2997,19 @@ scm_bigequal (SCM x, SCM y) { int result = mpz_cmp (SCM_I_BIG_MPZ (x), SCM_I_BIG_MPZ (y)); scm_remember_upto_here_2 (x, y); - return SCM_BOOL (0 == result); + return scm_from_bool (0 == result); } SCM scm_real_equalp (SCM x, SCM y) { - return SCM_BOOL (SCM_REAL_VALUE (x) == SCM_REAL_VALUE (y)); + return scm_from_bool (SCM_REAL_VALUE (x) == SCM_REAL_VALUE (y)); } SCM scm_complex_equalp (SCM x, SCM y) { - return SCM_BOOL (SCM_COMPLEX_REAL (x) == SCM_COMPLEX_REAL (y) + return scm_from_bool (SCM_COMPLEX_REAL (x) == SCM_COMPLEX_REAL (y) && SCM_COMPLEX_IMAG (x) == SCM_COMPLEX_IMAG (y)); } @@ -3018,9 +3018,9 @@ scm_i_fraction_equalp (SCM x, SCM y) { scm_i_fraction_reduce (x); scm_i_fraction_reduce (y); - if (SCM_FALSEP (scm_equal_p (SCM_FRACTION_NUMERATOR (x), + if (scm_is_false (scm_equal_p (SCM_FRACTION_NUMERATOR (x), SCM_FRACTION_NUMERATOR (y))) - || SCM_FALSEP (scm_equal_p (SCM_FRACTION_DENOMINATOR (x), + || scm_is_false (scm_equal_p (SCM_FRACTION_DENOMINATOR (x), SCM_FRACTION_DENOMINATOR (y)))) return SCM_BOOL_F; else @@ -3043,7 +3043,7 @@ SCM_DEFINE (scm_number_p, "complex?", 1, 0, 0, "rational or integer number.") #define FUNC_NAME s_scm_number_p { - return SCM_BOOL (SCM_NUMBERP (x)); + return scm_from_bool (SCM_NUMBERP (x)); } #undef FUNC_NAME @@ -3139,14 +3139,14 @@ scm_num_eq_p (SCM x, SCM y) if (SCM_INUMP (y)) { long yy = SCM_INUM (y); - return SCM_BOOL (xx == yy); + return scm_from_bool (xx == yy); } else if (SCM_BIGP (y)) return SCM_BOOL_F; else if (SCM_REALP (y)) - return SCM_BOOL ((double) xx == SCM_REAL_VALUE (y)); + return scm_from_bool ((double) xx == SCM_REAL_VALUE (y)); else if (SCM_COMPLEXP (y)) - return SCM_BOOL (((double) xx == SCM_COMPLEX_REAL (y)) + return scm_from_bool (((double) xx == SCM_COMPLEX_REAL (y)) && (0.0 == SCM_COMPLEX_IMAG (y))); else if (SCM_FRACTIONP (y)) return SCM_BOOL_F; @@ -3161,7 +3161,7 @@ scm_num_eq_p (SCM x, SCM y) { int cmp = mpz_cmp (SCM_I_BIG_MPZ (x), SCM_I_BIG_MPZ (y)); scm_remember_upto_here_2 (x, y); - return SCM_BOOL (0 == cmp); + return scm_from_bool (0 == cmp); } else if (SCM_REALP (y)) { @@ -3170,7 +3170,7 @@ scm_num_eq_p (SCM x, SCM y) return SCM_BOOL_F; cmp = xmpz_cmp_d (SCM_I_BIG_MPZ (x), SCM_REAL_VALUE (y)); scm_remember_upto_here_1 (x); - return SCM_BOOL (0 == cmp); + return scm_from_bool (0 == cmp); } else if (SCM_COMPLEXP (y)) { @@ -3181,7 +3181,7 @@ scm_num_eq_p (SCM x, SCM y) return SCM_BOOL_F; cmp = xmpz_cmp_d (SCM_I_BIG_MPZ (x), SCM_COMPLEX_REAL (y)); scm_remember_upto_here_1 (x); - return SCM_BOOL (0 == cmp); + return scm_from_bool (0 == cmp); } else if (SCM_FRACTIONP (y)) return SCM_BOOL_F; @@ -3191,7 +3191,7 @@ scm_num_eq_p (SCM x, SCM y) else if (SCM_REALP (x)) { if (SCM_INUMP (y)) - return SCM_BOOL (SCM_REAL_VALUE (x) == (double) SCM_INUM (y)); + return scm_from_bool (SCM_REAL_VALUE (x) == (double) SCM_INUM (y)); else if (SCM_BIGP (y)) { int cmp; @@ -3199,12 +3199,12 @@ scm_num_eq_p (SCM x, SCM y) return SCM_BOOL_F; cmp = xmpz_cmp_d (SCM_I_BIG_MPZ (y), SCM_REAL_VALUE (x)); scm_remember_upto_here_1 (y); - return SCM_BOOL (0 == cmp); + return scm_from_bool (0 == cmp); } else if (SCM_REALP (y)) - return SCM_BOOL (SCM_REAL_VALUE (x) == SCM_REAL_VALUE (y)); + return scm_from_bool (SCM_REAL_VALUE (x) == SCM_REAL_VALUE (y)); else if (SCM_COMPLEXP (y)) - return SCM_BOOL ((SCM_REAL_VALUE (x) == SCM_COMPLEX_REAL (y)) + return scm_from_bool ((SCM_REAL_VALUE (x) == SCM_COMPLEX_REAL (y)) && (0.0 == SCM_COMPLEX_IMAG (y))); else if (SCM_FRACTIONP (y)) { @@ -3212,7 +3212,7 @@ scm_num_eq_p (SCM x, SCM y) if (xisnan (xx)) return SCM_BOOL_F; if (xisinf (xx)) - return SCM_BOOL (xx < 0.0); + return scm_from_bool (xx < 0.0); x = scm_inexact_to_exact (x); /* with x as frac or int */ goto again; } @@ -3222,7 +3222,7 @@ scm_num_eq_p (SCM x, SCM y) else if (SCM_COMPLEXP (x)) { if (SCM_INUMP (y)) - return SCM_BOOL ((SCM_COMPLEX_REAL (x) == (double) SCM_INUM (y)) + return scm_from_bool ((SCM_COMPLEX_REAL (x) == (double) SCM_INUM (y)) && (SCM_COMPLEX_IMAG (x) == 0.0)); else if (SCM_BIGP (y)) { @@ -3233,13 +3233,13 @@ scm_num_eq_p (SCM x, SCM y) return SCM_BOOL_F; cmp = xmpz_cmp_d (SCM_I_BIG_MPZ (y), SCM_COMPLEX_REAL (x)); scm_remember_upto_here_1 (y); - return SCM_BOOL (0 == cmp); + return scm_from_bool (0 == cmp); } else if (SCM_REALP (y)) - return SCM_BOOL ((SCM_COMPLEX_REAL (x) == SCM_REAL_VALUE (y)) + return scm_from_bool ((SCM_COMPLEX_REAL (x) == SCM_REAL_VALUE (y)) && (SCM_COMPLEX_IMAG (x) == 0.0)); else if (SCM_COMPLEXP (y)) - return SCM_BOOL ((SCM_COMPLEX_REAL (x) == SCM_COMPLEX_REAL (y)) + return scm_from_bool ((SCM_COMPLEX_REAL (x) == SCM_COMPLEX_REAL (y)) && (SCM_COMPLEX_IMAG (x) == SCM_COMPLEX_IMAG (y))); else if (SCM_FRACTIONP (y)) { @@ -3250,7 +3250,7 @@ scm_num_eq_p (SCM x, SCM y) if (xisnan (xx)) return SCM_BOOL_F; if (xisinf (xx)) - return SCM_BOOL (xx < 0.0); + return scm_from_bool (xx < 0.0); x = scm_inexact_to_exact (x); /* with x as frac or int */ goto again; } @@ -3269,7 +3269,7 @@ scm_num_eq_p (SCM x, SCM y) if (xisnan (yy)) return SCM_BOOL_F; if (xisinf (yy)) - return SCM_BOOL (0.0 < yy); + return scm_from_bool (0.0 < yy); y = scm_inexact_to_exact (y); /* with y as frac or int */ goto again; } @@ -3282,7 +3282,7 @@ scm_num_eq_p (SCM x, SCM y) if (xisnan (yy)) return SCM_BOOL_F; if (xisinf (yy)) - return SCM_BOOL (0.0 < yy); + return scm_from_bool (0.0 < yy); y = scm_inexact_to_exact (y); /* with y as frac or int */ goto again; } @@ -3316,16 +3316,16 @@ scm_less_p (SCM x, SCM y) if (SCM_INUMP (y)) { long yy = SCM_INUM (y); - return SCM_BOOL (xx < yy); + return scm_from_bool (xx < yy); } else if (SCM_BIGP (y)) { int sgn = mpz_sgn (SCM_I_BIG_MPZ (y)); scm_remember_upto_here_1 (y); - return SCM_BOOL (sgn > 0); + return scm_from_bool (sgn > 0); } else if (SCM_REALP (y)) - return SCM_BOOL ((double) xx < SCM_REAL_VALUE (y)); + return scm_from_bool ((double) xx < SCM_REAL_VALUE (y)); else if (SCM_FRACTIONP (y)) { /* "x < a/b" becomes "x*b < a" */ @@ -3343,13 +3343,13 @@ scm_less_p (SCM x, SCM y) { int sgn = mpz_sgn (SCM_I_BIG_MPZ (x)); scm_remember_upto_here_1 (x); - return SCM_BOOL (sgn < 0); + return scm_from_bool (sgn < 0); } else if (SCM_BIGP (y)) { int cmp = mpz_cmp (SCM_I_BIG_MPZ (x), SCM_I_BIG_MPZ (y)); scm_remember_upto_here_2 (x, y); - return SCM_BOOL (cmp < 0); + return scm_from_bool (cmp < 0); } else if (SCM_REALP (y)) { @@ -3358,7 +3358,7 @@ scm_less_p (SCM x, SCM y) return SCM_BOOL_F; cmp = xmpz_cmp_d (SCM_I_BIG_MPZ (x), SCM_REAL_VALUE (y)); scm_remember_upto_here_1 (x); - return SCM_BOOL (cmp < 0); + return scm_from_bool (cmp < 0); } else if (SCM_FRACTIONP (y)) goto int_frac; @@ -3368,7 +3368,7 @@ scm_less_p (SCM x, SCM y) else if (SCM_REALP (x)) { if (SCM_INUMP (y)) - return SCM_BOOL (SCM_REAL_VALUE (x) < (double) SCM_INUM (y)); + return scm_from_bool (SCM_REAL_VALUE (x) < (double) SCM_INUM (y)); else if (SCM_BIGP (y)) { int cmp; @@ -3376,17 +3376,17 @@ scm_less_p (SCM x, SCM y) return SCM_BOOL_F; cmp = xmpz_cmp_d (SCM_I_BIG_MPZ (y), SCM_REAL_VALUE (x)); scm_remember_upto_here_1 (y); - return SCM_BOOL (cmp > 0); + return scm_from_bool (cmp > 0); } else if (SCM_REALP (y)) - return SCM_BOOL (SCM_REAL_VALUE (x) < SCM_REAL_VALUE (y)); + return scm_from_bool (SCM_REAL_VALUE (x) < SCM_REAL_VALUE (y)); else if (SCM_FRACTIONP (y)) { double xx = SCM_REAL_VALUE (x); if (xisnan (xx)) return SCM_BOOL_F; if (xisinf (xx)) - return SCM_BOOL (xx < 0.0); + return scm_from_bool (xx < 0.0); x = scm_inexact_to_exact (x); /* with x as frac or int */ goto again; } @@ -3408,7 +3408,7 @@ scm_less_p (SCM x, SCM y) if (xisnan (yy)) return SCM_BOOL_F; if (xisinf (yy)) - return SCM_BOOL (0.0 < yy); + return scm_from_bool (0.0 < yy); y = scm_inexact_to_exact (y); /* with y as frac or int */ goto again; } @@ -3461,10 +3461,10 @@ scm_leq_p (SCM x, SCM y) SCM_WTA_DISPATCH_2 (g_leq_p, x, y, SCM_ARG1, FUNC_NAME); else if (!SCM_NUMBERP (y)) SCM_WTA_DISPATCH_2 (g_leq_p, x, y, SCM_ARG2, FUNC_NAME); - else if (SCM_NFALSEP (scm_nan_p (x)) || SCM_NFALSEP (scm_nan_p (y))) + else if (scm_is_true (scm_nan_p (x)) || scm_is_true (scm_nan_p (y))) return SCM_BOOL_F; else - return SCM_BOOL_NOT (scm_less_p (y, x)); + return scm_not (scm_less_p (y, x)); } #undef FUNC_NAME @@ -3481,10 +3481,10 @@ scm_geq_p (SCM x, SCM y) SCM_WTA_DISPATCH_2 (g_geq_p, x, y, SCM_ARG1, FUNC_NAME); else if (!SCM_NUMBERP (y)) SCM_WTA_DISPATCH_2 (g_geq_p, x, y, SCM_ARG2, FUNC_NAME); - else if (SCM_NFALSEP (scm_nan_p (x)) || SCM_NFALSEP (scm_nan_p (y))) + else if (scm_is_true (scm_nan_p (x)) || scm_is_true (scm_nan_p (y))) return SCM_BOOL_F; else - return SCM_BOOL_NOT (scm_less_p (x, y)); + return scm_not (scm_less_p (x, y)); } #undef FUNC_NAME @@ -3497,13 +3497,13 @@ SCM scm_zero_p (SCM z) { if (SCM_INUMP (z)) - return SCM_BOOL (SCM_EQ_P (z, SCM_INUM0)); + return scm_from_bool (SCM_EQ_P (z, SCM_INUM0)); else if (SCM_BIGP (z)) return SCM_BOOL_F; else if (SCM_REALP (z)) - return SCM_BOOL (SCM_REAL_VALUE (z) == 0.0); + return scm_from_bool (SCM_REAL_VALUE (z) == 0.0); else if (SCM_COMPLEXP (z)) - return SCM_BOOL (SCM_COMPLEX_REAL (z) == 0.0 + return scm_from_bool (SCM_COMPLEX_REAL (z) == 0.0 && SCM_COMPLEX_IMAG (z) == 0.0); else if (SCM_FRACTIONP (z)) return SCM_BOOL_F; @@ -3520,15 +3520,15 @@ SCM scm_positive_p (SCM x) { if (SCM_INUMP (x)) - return SCM_BOOL (SCM_INUM (x) > 0); + return scm_from_bool (SCM_INUM (x) > 0); else if (SCM_BIGP (x)) { int sgn = mpz_sgn (SCM_I_BIG_MPZ (x)); scm_remember_upto_here_1 (x); - return SCM_BOOL (sgn > 0); + return scm_from_bool (sgn > 0); } else if (SCM_REALP (x)) - return SCM_BOOL(SCM_REAL_VALUE (x) > 0.0); + return scm_from_bool(SCM_REAL_VALUE (x) > 0.0); else if (SCM_FRACTIONP (x)) return scm_positive_p (SCM_FRACTION_NUMERATOR (x)); else @@ -3544,15 +3544,15 @@ SCM scm_negative_p (SCM x) { if (SCM_INUMP (x)) - return SCM_BOOL (SCM_INUM (x) < 0); + return scm_from_bool (SCM_INUM (x) < 0); else if (SCM_BIGP (x)) { int sgn = mpz_sgn (SCM_I_BIG_MPZ (x)); scm_remember_upto_here_1 (x); - return SCM_BOOL (sgn < 0); + return scm_from_bool (sgn < 0); } else if (SCM_REALP (x)) - return SCM_BOOL(SCM_REAL_VALUE (x) < 0.0); + return scm_from_bool(SCM_REAL_VALUE (x) < 0.0); else if (SCM_FRACTIONP (x)) return scm_negative_p (SCM_FRACTION_NUMERATOR (x)); else @@ -3605,7 +3605,7 @@ scm_max (SCM x, SCM y) else if (SCM_FRACTIONP (y)) { use_less: - return (SCM_FALSEP (scm_less_p (x, y)) ? x : y); + return (scm_is_false (scm_less_p (x, y)) ? x : y); } else SCM_WTA_DISPATCH_2 (g_max, x, y, SCM_ARGn, s_max); @@ -3737,7 +3737,7 @@ scm_min (SCM x, SCM y) else if (SCM_FRACTIONP (y)) { use_less: - return (SCM_FALSEP (scm_less_p (x, y)) ? y : x); + return (scm_is_false (scm_less_p (x, y)) ? y : x); } else SCM_WTA_DISPATCH_2 (g_min, x, y, SCM_ARGn, s_min); @@ -4990,7 +4990,7 @@ SCM_DEFINE (scm_truncate_number, "truncate", 1, 0, 0, "Round the number @var{x} towards zero.") #define FUNC_NAME s_scm_truncate_number { - if (SCM_FALSEP (scm_negative_p (x))) + if (scm_is_false (scm_negative_p (x))) return scm_floor (x); else return scm_ceiling (x); @@ -5018,8 +5018,8 @@ SCM_DEFINE (scm_round_number, "round", 1, 0, 0, SCM plus_half = scm_sum (x, exactly_one_half); SCM result = scm_floor (plus_half); /* Adjust so that the scm_round is towards even. */ - if (!SCM_FALSEP (scm_num_eq_p (plus_half, result)) - && !SCM_FALSEP (scm_odd_p (result))) + if (scm_is_true (scm_num_eq_p (plus_half, result)) + && scm_is_true (scm_odd_p (result))) return scm_difference (result, SCM_MAKINUM (1)); else return result; @@ -5040,7 +5040,7 @@ SCM_PRIMITIVE_GENERIC (scm_floor, "floor", 1, 0, 0, { SCM q = scm_quotient (SCM_FRACTION_NUMERATOR (x), SCM_FRACTION_DENOMINATOR (x)); - if (SCM_FALSEP (scm_negative_p (x))) + if (scm_is_false (scm_negative_p (x))) { /* For positive x, rounding towards zero is correct. */ return q; @@ -5071,7 +5071,7 @@ SCM_PRIMITIVE_GENERIC (scm_ceiling, "ceiling", 1, 0, 0, { SCM q = scm_quotient (SCM_FRACTION_NUMERATOR (x), SCM_FRACTION_DENOMINATOR (x)); - if (SCM_FALSEP (scm_positive_p (x))) + if (scm_is_false (scm_positive_p (x))) { /* For negative x, rounding towards zero is correct. */ return q; @@ -5344,7 +5344,7 @@ scm_magnitude (SCM z) return scm_make_real (hypot (SCM_COMPLEX_REAL (z), SCM_COMPLEX_IMAG (z))); else if (SCM_FRACTIONP (z)) { - if (SCM_FALSEP (scm_negative_p (SCM_FRACTION_NUMERATOR (z)))) + if (scm_is_false (scm_negative_p (SCM_FRACTION_NUMERATOR (z)))) return z; return scm_make_ratio (scm_difference (SCM_FRACTION_NUMERATOR (z), SCM_UNDEFINED), SCM_FRACTION_DENOMINATOR (z)); @@ -5391,7 +5391,7 @@ scm_angle (SCM z) return scm_make_real (atan2 (SCM_COMPLEX_IMAG (z), SCM_COMPLEX_REAL (z))); else if (SCM_FRACTIONP (z)) { - if (SCM_FALSEP (scm_negative_p (SCM_FRACTION_NUMERATOR (z)))) + if (scm_is_false (scm_negative_p (SCM_FRACTION_NUMERATOR (z)))) return scm_flo0; else return scm_make_real (atan2 (0.0, -1.0)); } @@ -5479,7 +5479,7 @@ SCM_DEFINE (scm_rationalize, "rationalize", 2, 0, 0, SCM rx; int i = 0; - if (!SCM_FALSEP (scm_num_eq_p (ex, int_part))) + if (scm_is_true (scm_num_eq_p (ex, int_part))) return ex; ex = scm_difference (ex, int_part); /* x = x-int_part */ @@ -5495,14 +5495,14 @@ SCM_DEFINE (scm_rationalize, "rationalize", 2, 0, 0, { a = scm_sum (scm_product (a1, tt), a2); /* a = a1*tt + a2 */ b = scm_sum (scm_product (b1, tt), b2); /* b = b1*tt + b2 */ - if (SCM_FALSEP (scm_zero_p (b)) && /* b != 0 */ - SCM_FALSEP + if (scm_is_false (scm_zero_p (b)) && /* b != 0 */ + scm_is_false (scm_gr_p (scm_abs (scm_difference (ex, scm_divide (a, b))), err))) /* abs(x-a/b) <= err */ { SCM res = scm_sum (int_part, scm_divide (a, b)); - if (SCM_FALSEP (scm_exact_p (x)) - || SCM_FALSEP (scm_exact_p (err))) + if (scm_is_false (scm_exact_p (x)) + || scm_is_false (scm_exact_p (err))) return scm_exact_to_inexact (res); else return res; @@ -5663,6 +5663,339 @@ SCM_DEFINE (scm_rationalize, "rationalize", 2, 0, 0, #define FTYPE double #include "libguile/num2float.i.c" +/* conversion functions */ + +int +scm_is_integer (SCM val) +{ + return scm_is_true (scm_integer_p (val)); +} + +int +scm_is_signed_integer (SCM val, scm_t_intmax min, scm_t_intmax max) +{ + if (SCM_INUMP (val)) + { + scm_t_signed_bits n = SCM_INUM (val); + return n >= min && n <= max; + } + else if (SCM_BIGP (val)) + { + if (min >= SCM_MOST_NEGATIVE_FIXNUM && max <= SCM_MOST_POSITIVE_FIXNUM) + return 0; + else if (min >= LONG_MIN && max <= LONG_MAX) + return (mpz_cmp_si (SCM_I_BIG_MPZ (val), min) >= 0 + && mpz_cmp_si (SCM_I_BIG_MPZ (val), max) <= 0); + else + { + /* Get the big hammer. */ + + mpz_t bigmin, bigmax; + int res; + + mpz_init (bigmin); + if (min >= 0) + mpz_import (bigmin, 1, 1, sizeof (scm_t_intmax), 0, 0, &min); + else + { + /* Magically works for min == INTMAX_MIN as well. */ + min = -min; + mpz_import (bigmin, 1, 1, sizeof (scm_t_intmax), 0, 0, &min); + mpz_neg (bigmin, bigmin); + } + res = mpz_cmp (SCM_I_BIG_MPZ (val), bigmin); + mpz_clear (bigmin); + if (res < 0) + return 0; + + mpz_init (bigmax); + if (max >= 0) + mpz_import (bigmax, 1, 1, sizeof (scm_t_intmax), 0, 0, &max); + else + { + /* Magically works for max == INTMAX_MIN as well. */ + max = -max; + mpz_import (bigmax, 1, 1, sizeof (scm_t_intmax), 0, 0, &max); + mpz_neg (bigmax, bigmax); + } + res = mpz_cmp (SCM_I_BIG_MPZ (val), bigmax); + mpz_clear (bigmax); + return res <= 0; + } + } + else if (SCM_REALP (val)) + { + double n = SCM_REAL_VALUE (val); + return n == floor(n) && n >= min && n <= max; + } + else + return 0; +} + +int +scm_is_unsigned_integer (SCM val, scm_t_uintmax min, scm_t_uintmax max) +{ + if (SCM_INUMP (val)) + { + scm_t_signed_bits n = SCM_INUM (val); + return n >= 0 && ((scm_t_uintmax)n) >= min && ((scm_t_uintmax)n) <= max; + } + else if (SCM_BIGP (val)) + { + if (max <= SCM_MOST_POSITIVE_FIXNUM) + return 0; + else if (max <= ULONG_MAX) + return (mpz_cmp_ui (SCM_I_BIG_MPZ (val), min) >= 0 + && mpz_cmp_ui (SCM_I_BIG_MPZ (val), max) <= 0); + else + { + /* Get the big hammer. */ + + mpz_t bigmin, bigmax; + int res; + + mpz_init (bigmin); + mpz_import (bigmin, 1, 1, sizeof (scm_t_uintmax), 0, 0, &min); + res = mpz_cmp (SCM_I_BIG_MPZ (val), bigmin); + mpz_clear (bigmin); + if (res < 0) + return 0; + + mpz_init (bigmax); + mpz_import (bigmax, 1, 1, sizeof (scm_t_intmax), 0, 0, &max); + res = mpz_cmp (SCM_I_BIG_MPZ (val), bigmax); + mpz_clear (bigmax); + return res <= 0; + } + } + else if (SCM_REALP (val)) + { + double n = SCM_REAL_VALUE (val); + return n == floor(n) && n >= min && n <= max; + } + else + return 0; +} + +scm_t_intmax +scm_to_signed_integer (SCM val, scm_t_intmax min, scm_t_intmax max) +{ + if (SCM_INUMP (val)) + { + scm_t_signed_bits n = SCM_INUM (val); + if (n >= min && n <= max) + return n; + else + { + out_of_range: + scm_out_of_range (NULL, val); + return 0; + } + } + else if (SCM_BIGP (val)) + { + if (min >= SCM_MOST_NEGATIVE_FIXNUM && max <= SCM_MOST_POSITIVE_FIXNUM) + goto out_of_range; + else if (min >= LONG_MIN && max <= LONG_MAX) + { + if (mpz_fits_slong_p (SCM_I_BIG_MPZ (val))) + { + long n = mpz_get_si (SCM_I_BIG_MPZ (val)); + if (n >= min && n <= max) + return n; + else + goto out_of_range; + } + else + goto out_of_range; + } + else + { + scm_t_intmax n; + size_t count; + + if (mpz_sizeinbase (SCM_I_BIG_MPZ (val), 2) + > 8*sizeof (scm_t_uintmax)) + goto out_of_range; + + mpz_export (&n, &count, 1, sizeof (scm_t_uintmax), 0, 0, + SCM_I_BIG_MPZ (val)); + + if (mpz_sgn (SCM_I_BIG_MPZ (val)) >= 0) + { + if (n < 0) + goto out_of_range; + } + else + { + n = -n; + if (n >= 0) + goto out_of_range; + } + + if (n >= min && n <= max) + return n; + else + goto out_of_range; + } + } + else if (SCM_REALP (val)) + { + double n = SCM_REAL_VALUE (val); + if (n != floor(n)) + goto wrong_type_arg; + if (n >= min && n <= max) + return n; + else + goto out_of_range; + } + else + { + wrong_type_arg: + scm_wrong_type_arg_msg (NULL, 0, val, "integer"); + return 0; + } +} + +scm_t_uintmax +scm_to_unsigned_integer (SCM val, scm_t_uintmax min, scm_t_uintmax max) +{ + if (SCM_INUMP (val)) + { + scm_t_signed_bits n = SCM_INUM (val); + if (n >= 0 && ((scm_t_uintmax)n) >= min && ((scm_t_uintmax)n) <= max) + return n; + else + { + out_of_range: + scm_out_of_range (NULL, val); + return 0; + } + } + else if (SCM_BIGP (val)) + { + if (max <= SCM_MOST_POSITIVE_FIXNUM) + goto out_of_range; + else if (max <= ULONG_MAX) + { + if (mpz_fits_ulong_p (SCM_I_BIG_MPZ (val))) + { + unsigned long n = mpz_get_ui (SCM_I_BIG_MPZ (val)); + if (n >= min && n <= max) + return n; + else + goto out_of_range; + } + else + goto out_of_range; + } + else + { + scm_t_uintmax n; + size_t count; + + if (mpz_sgn (SCM_I_BIG_MPZ (val)) < 0) + goto out_of_range; + + if (mpz_sizeinbase (SCM_I_BIG_MPZ (val), 2) + > 8*sizeof (scm_t_uintmax)) + goto out_of_range; + + mpz_export (&n, &count, 1, sizeof (scm_t_uintmax), 0, 0, + SCM_I_BIG_MPZ (val)); + + if (n >= min && n <= max) + return n; + else + goto out_of_range; + } + } + else if (SCM_REALP (val)) + { + double n = SCM_REAL_VALUE (val); + if (n != floor(n)) + goto wrong_type_arg; + if (n >= min && n <= max) + return n; + else + goto out_of_range; + } + else + { + wrong_type_arg: + scm_wrong_type_arg_msg (NULL, 0, val, "integer"); + return 0; + } +} + +SCM +scm_from_signed_integer (scm_t_intmax val) +{ + if (SCM_FIXABLE (val)) + return SCM_MAKINUM (val); + else if (val >= LONG_MIN && val <= LONG_MAX) + { + SCM z = scm_double_cell (scm_tc16_big, 0, 0, 0); + mpz_init_set_si (SCM_I_BIG_MPZ (z), val); + return z; + } + else + { + SCM z = scm_double_cell (scm_tc16_big, 0, 0, 0); + mpz_init (SCM_I_BIG_MPZ (z)); + if (val < 0) + { + val = -val; + mpz_import (SCM_I_BIG_MPZ (z), 1, 1, sizeof (scm_t_intmax), 0, 0, + &val); + mpz_neg (SCM_I_BIG_MPZ (z), SCM_I_BIG_MPZ (z)); + } + else + mpz_import (SCM_I_BIG_MPZ (z), 1, 1, sizeof (scm_t_intmax), 0, 0, + &val); + return z; + } +} + +SCM +scm_from_unsigned_integer (scm_t_uintmax val) +{ + if (SCM_POSFIXABLE (val)) + return SCM_MAKINUM (val); + else if (val <= ULONG_MAX) + { + SCM z = scm_double_cell (scm_tc16_big, 0, 0, 0); + mpz_init_set_ui (SCM_I_BIG_MPZ (z), val); + return z; + } + else + { + SCM z = scm_double_cell (scm_tc16_big, 0, 0, 0); + mpz_init (SCM_I_BIG_MPZ (z)); + mpz_import (SCM_I_BIG_MPZ (z), 1, 1, sizeof (scm_t_uintmax), 0, 0, + &val); + return z; + } +} + +int +scm_is_real (SCM val) +{ + return scm_is_true (scm_real_p (val)); +} + +double +scm_to_double (SCM val) +{ + return scm_num2dbl (val, NULL); +} + +SCM +scm_from_double (double val) +{ + return scm_make_real (val); +} + #ifdef GUILE_DEBUG #ifndef SIZE_MAX @@ -5729,7 +6062,7 @@ check_sanity () #define CHECK \ scm_internal_catch (SCM_BOOL_T, check_body, &data, check_handler, &data); \ - if (!SCM_FALSEP (data)) abort(); + if (scm_is_true (data)) abort(); static SCM check_body (void *data) diff --git a/libguile/numbers.h b/libguile/numbers.h index a9ee5f57f..59b755e9a 100644 --- a/libguile/numbers.h +++ b/libguile/numbers.h @@ -72,7 +72,6 @@ (SCM_PACK ((((scm_t_signed_bits) (x)) << 2) + scm_tc2_int)) #define SCM_INUM(x) (SCM_SRS ((scm_t_signed_bits) SCM_UNPACK (x), 2)) - /* SCM_FIXABLE is true if its long argument can be encoded in an SCM_INUM. */ #define SCM_POSFIXABLE(n) ((n) <= SCM_MOST_POSITIVE_FIXNUM) #define SCM_NEGFIXABLE(n) ((n) >= SCM_MOST_NEGATIVE_FIXNUM) @@ -82,7 +81,6 @@ /* A name for 0. */ #define SCM_INUM0 (SCM_MAKINUM (0)) - /* SCM_MAXEXP is the maximum double precision exponent * SCM_FLTMAX is less than or scm_equal the largest single precision float */ @@ -340,6 +338,78 @@ SCM_API int scm_i_print_fraction (SCM sexp, SCM port, scm_print_state *pstate); SCM_API SCM scm_sys_check_number_conversions (void); #endif +/* conversion functions */ + +SCM_API int scm_is_integer (SCM val); +SCM_API int scm_is_signed_integer (SCM val, + scm_t_intmax min, scm_t_intmax max); +SCM_API int scm_is_unsigned_integer (SCM val, + scm_t_uintmax min, scm_t_uintmax max); + +SCM_API SCM scm_from_signed_integer (scm_t_intmax val); +SCM_API SCM scm_from_unsigned_integer (scm_t_uintmax val); + +SCM_API scm_t_intmax scm_to_signed_integer (SCM val, + scm_t_intmax min, + scm_t_intmax max); +SCM_API scm_t_uintmax scm_to_unsigned_integer (SCM val, + scm_t_uintmax min, + scm_t_uintmax max); + +#define scm_to_schar(x) \ + ((signed char)scm_to_signed_integer ((x), SCHAR_MIN, SCHAR_MAX)) +#define scm_to_uchar(x) \ + ((unsigned char)scm_to_unsigned_integer ((x), 0, UCHAR_MAX)) +#if CHAR_MIN == 0 +#define scm_to_char scm_to_uchar +#else +#define scm_to_char scm_to_schar +#endif + +#define scm_to_short(x) \ + ((short)scm_to_signed_integer ((x), SHORT_MIN, SHORT_MAX)) +#define scm_to_ushort(x) \ + ((unsigned short)scm_to_unsigned_integer ((x), 0, SHORT_MAX)) + +#define scm_to_int(x) \ + ((int)scm_to_signed_integer ((x), INT_MIN, INT_MAX)) +#define scm_to_uint(x) \ + ((unsigned int)scm_to_unsigned_integer ((x), 0, UINT_MAX)) + +#define scm_to_long(x) \ + ((long)scm_to_signed_integer ((x), LONG_MIN, LONG_MAX)) +#define scm_to_ulong(x) \ + ((unsigned long)scm_to_unsigned_integer ((x), 0, ULONG_MAX)) + +#define scm_to_ssize_t(x) \ + ((ssize_t)scm_to_signed_integer ((x), -SSIZE_MAX-1, SSIZE_MAX)) +#define scm_to_size_t(x) \ + ((unsigned long)scm_to_unsigned_integer ((x), 0, (~(size_t)0))) + +#define scm_from_schar(x) scm_from_signed_integer ((signed char)(x)) +#define scm_from_uchar(x) scm_from_unsigned_integer ((unsigned char)(x)) +#if CHAR_MIN == 0 +#define scm_from_char scm_from_uchar +#else +#define scm_from_char scm_from_schar +#endif + +#define scm_from_short(x) scm_from_signed_integer ((short)(x)) +#define scm_from_ushort(x) scm_from_unsigned_integer ((unsigned short)(x)) + +#define scm_from_int(x) scm_from_signed_integer ((int)(x)) +#define scm_from_uint(x) scm_from_unsigned_integer ((unsigned int)(x)) + +#define scm_from_long(x) scm_from_signed_integer ((long)(x)) +#define scm_from_ulong(x) scm_from_unsigned_integer ((unsigned long)(x)) + +#define scm_from_ssize_t(x) scm_from_signed_integer ((ssize_t)(x)) +#define scm_from_size_t(x) scm_from_unsigned_integer ((size_t)(x)) + +SCM_API int scm_is_real (SCM val); +SCM_API double scm_to_double (SCM val); +SCM_API SCM scm_from_double (double val); + SCM_API void scm_init_numbers (void); #endif /* SCM_NUMBERS_H */ From 1fe56d60fda532eba3b4f689a671a2f939191e50 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Tue, 6 Jul 2004 10:25:37 +0000 Subject: [PATCH 19/58] (scm_is_bool): Fix typo. * 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. --- libguile/boolean.c | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/libguile/boolean.c b/libguile/boolean.c index 1f6b5b037..be4332806 100644 --- a/libguile/boolean.c +++ b/libguile/boolean.c @@ -23,6 +23,8 @@ #include "libguile/validate.h" #include "libguile/boolean.h" #include "libguile/lang.h" +#include "libguile/tags.h" + @@ -31,7 +33,7 @@ SCM_DEFINE (scm_not, "not", 1, 0, 0, "Return @code{#t} iff @var{x} is @code{#f}, else return @code{#f}.") #define FUNC_NAME s_scm_not { - return SCM_BOOL(SCM_FALSEP (x) || SCM_NILP (x)); + return scm_from_bool (scm_is_false (x) || SCM_NILP (x)); } #undef FUNC_NAME @@ -41,14 +43,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_BOOL (SCM_BOOLP (obj) || SCM_NILP (obj)); + return scm_from_bool (scm_is_bool (obj) || SCM_NILP (obj)); } #undef FUNC_NAME int scm_is_bool (SCM x) { - return scm_is_eq (x, SCM_BOOL_F) || scm_is_eq (SCM_BOOL_T); + return scm_is_eq (x, SCM_BOOL_F) || scm_is_eq (x, SCM_BOOL_T); } int From 9c293a3d2f20f783cc59d749f4d6bcd09fbb0cd5 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Tue, 6 Jul 2004 10:42:33 +0000 Subject: [PATCH 20/58] (scm_is_eq): New. --- libguile/tags.h | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/libguile/tags.h b/libguile/tags.h index 9b06cdc63..dd9012659 100644 --- a/libguile/tags.h +++ b/libguile/tags.h @@ -136,7 +136,8 @@ typedef unsigned long scm_t_bits; /* SCM values can not be compared by using the operator ==. Use the following * macro instead, which is the equivalent of the scheme predicate 'eq?'. */ -#define SCM_EQ_P(x, y) (SCM_UNPACK (x) == SCM_UNPACK (y)) +#define scm_is_eq(x, y) (SCM_UNPACK (x) == SCM_UNPACK (y)) +#define SCM_EQ_P scm_is_eq From 7888309be8638cb5b75db163383a3d977bd9769d Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Tue, 6 Jul 2004 10:59:25 +0000 Subject: [PATCH 21/58] * 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. --- libguile/ChangeLog | 24 +++++++++++++ libguile/alist.c | 8 ++--- libguile/async.c | 2 +- libguile/backtrace.c | 28 +++++++-------- libguile/chars.c | 34 +++++++++--------- libguile/convert.i.c | 8 ++--- libguile/coop-pthreads.c | 12 +++---- libguile/coop-threads.c | 8 ++--- libguile/debug.c | 12 +++---- libguile/debug.h | 6 ++-- libguile/deprecated.c | 46 +++++++++++++++---------- libguile/deprecation.c | 2 +- libguile/dynl.c | 2 +- libguile/dynwind.c | 2 +- libguile/environments.c | 24 ++++++------- libguile/eq.c | 26 +++++++------- libguile/error.c | 8 ++--- libguile/eval.c | 74 ++++++++++++++++++++-------------------- libguile/evalext.c | 6 ++-- libguile/filesys.c | 6 ++-- libguile/fluids.c | 2 +- libguile/fports.c | 2 +- libguile/gc.c | 6 ++-- libguile/gh_data.c | 4 +-- libguile/gh_predicates.c | 32 ++++++++--------- libguile/goops.c | 38 ++++++++++----------- libguile/goops.h | 2 +- libguile/guardians.c | 12 +++---- libguile/hashtab.c | 12 +++---- libguile/hooks.c | 12 +++---- libguile/init.c | 4 +-- libguile/ioext.c | 2 +- libguile/keywords.c | 4 +-- libguile/list.c | 20 +++++------ libguile/load.c | 10 +++--- libguile/macros.c | 6 ++-- libguile/modules.c | 40 +++++++++++----------- libguile/net_db.c | 8 ++--- libguile/objects.c | 14 ++++---- libguile/options.c | 2 +- libguile/pairs.c | 2 +- libguile/ports.c | 14 ++++---- libguile/posix.c | 10 +++--- libguile/print.c | 18 +++++----- libguile/procprop.c | 6 ++-- libguile/procs.c | 8 ++--- libguile/properties.c | 10 +++--- libguile/ramap.c | 32 ++++++++--------- libguile/rdelim.c | 2 +- libguile/read.c | 18 +++++----- libguile/regex-posix.c | 2 +- libguile/scmsigs.c | 14 ++++---- libguile/script.c | 2 +- libguile/simpos.c | 2 +- libguile/sort.c | 30 ++++++++-------- libguile/srcprop.c | 8 ++--- libguile/srcprop.h | 4 +-- libguile/stacks.c | 20 +++++------ libguile/stime.c | 6 ++-- libguile/strings.c | 2 +- libguile/strop.c | 8 ++--- libguile/strorder.c | 12 +++---- libguile/struct.c | 10 +++--- libguile/symbols.c | 4 +-- libguile/threads.c | 14 ++++---- libguile/throw.c | 6 ++-- libguile/unif.c | 28 +++++++-------- libguile/validate.h | 13 ++++--- libguile/variable.c | 4 +-- libguile/vectors.c | 4 +-- libguile/vports.c | 10 +++--- libguile/weaks.c | 8 ++--- 72 files changed, 469 insertions(+), 432 deletions(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 6fd885239..471f4f7e9 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,27 @@ +2004-07-06 Marius Vollmer + + * 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 * boolean.h, boolean.c (scm_is_true, scm_is_false, scm_from_bool, diff --git a/libguile/alist.c b/libguile/alist.c index 05eed0241..b876ae59d 100644 --- a/libguile/alist.c +++ b/libguile/alist.c @@ -71,7 +71,7 @@ SCM_DEFINE (scm_sloppy_assv, "sloppy-assv", 2, 0, 0, { SCM tmp = SCM_CAR (alist); if (SCM_CONSP (tmp) - && SCM_NFALSEP (scm_eqv_p (SCM_CAR (tmp), key))) + && scm_is_true (scm_eqv_p (SCM_CAR (tmp), key))) return tmp; } return SCM_BOOL_F; @@ -89,7 +89,7 @@ SCM_DEFINE (scm_sloppy_assoc, "sloppy-assoc", 2, 0, 0, { SCM tmp = SCM_CAR (alist); if (SCM_CONSP (tmp) - && SCM_NFALSEP (scm_equal_p (SCM_CAR (tmp), key))) + && scm_is_true (scm_equal_p (SCM_CAR (tmp), key))) return tmp; } return SCM_BOOL_F; @@ -139,7 +139,7 @@ SCM_DEFINE (scm_assv, "assv", 2, 0, 0, SCM tmp = SCM_CAR (ls); SCM_ASSERT_TYPE (SCM_CONSP (tmp), alist, SCM_ARG2, FUNC_NAME, "association list"); - if (SCM_NFALSEP (scm_eqv_p (SCM_CAR (tmp), key))) + if (scm_is_true (scm_eqv_p (SCM_CAR (tmp), key))) return tmp; } SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (ls), alist, SCM_ARG2, FUNC_NAME, @@ -160,7 +160,7 @@ SCM_DEFINE (scm_assoc, "assoc", 2, 0, 0, SCM tmp = SCM_CAR (ls); SCM_ASSERT_TYPE (SCM_CONSP (tmp), alist, SCM_ARG2, FUNC_NAME, "association list"); - if (SCM_NFALSEP (scm_equal_p (SCM_CAR (tmp), key))) + if (scm_is_true (scm_equal_p (SCM_CAR (tmp), key))) return tmp; } SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (ls), alist, SCM_ARG2, FUNC_NAME, diff --git a/libguile/async.c b/libguile/async.c index 34165fe11..333b8d0e1 100644 --- a/libguile/async.c +++ b/libguile/async.c @@ -162,7 +162,7 @@ scm_async_click () for (asyncs = scm_root->signal_asyncs; !SCM_NULLP(asyncs); asyncs = SCM_CDR (asyncs)) { - if (!SCM_FALSEP (SCM_CAR (asyncs))) + if (scm_is_true (SCM_CAR (asyncs))) { SCM proc = SCM_CAR (asyncs); SCM_SETCAR (asyncs, SCM_BOOL_F); diff --git a/libguile/backtrace.c b/libguile/backtrace.c index 59542d619..9bf942932 100644 --- a/libguile/backtrace.c +++ b/libguile/backtrace.c @@ -89,7 +89,7 @@ display_header (SCM source, SCM port) else scm_puts ("", port); - if (!SCM_FALSEP (line) && !SCM_FALSEP (col)) + if (scm_is_true (line) && scm_is_true (col)) { scm_putc (':', port); scm_intprint (SCM_INUM (line) + 1, 10, port); @@ -116,7 +116,7 @@ struct display_error_message_data { static SCM display_error_message (struct display_error_message_data *d) { - if (SCM_STRINGP (d->message) && !SCM_FALSEP (scm_list_p (d->args))) + if (SCM_STRINGP (d->message) && scm_is_true (scm_list_p (d->args))) scm_simple_format (d->port, d->message, d->args); else scm_display (d->message, d->port); @@ -225,7 +225,7 @@ display_error_body (struct display_error_args *a) current_frame = scm_stack_ref (a->stack, SCM_INUM0); source = SCM_FRAME_SOURCE (current_frame); prev_frame = SCM_FRAME_PREV (current_frame); - if (!SCM_MEMOIZEDP (source) && !SCM_FALSEP (prev_frame)) + if (!SCM_MEMOIZEDP (source) && scm_is_true (prev_frame)) source = SCM_FRAME_SOURCE (prev_frame); if (!SCM_SYMBOLP (pname) && !SCM_STRINGP (pname) && SCM_FRAME_PROC_P (current_frame) && SCM_EQ_P (scm_procedure_p (SCM_FRAME_PROC (current_frame)), SCM_BOOL_T)) @@ -416,11 +416,11 @@ static void display_application (SCM frame, int indentation, SCM sport, SCM port, scm_print_state *pstate) { SCM proc = SCM_FRAME_PROC (frame); - SCM name = (!SCM_FALSEP (scm_procedure_p (proc)) + SCM name = (scm_is_true (scm_procedure_p (proc)) ? scm_procedure_name (proc) : SCM_BOOL_F); display_frame_expr ("[", - scm_cons (!SCM_FALSEP (name) ? name : proc, + scm_cons (scm_is_true (name) ? name : proc, SCM_FRAME_ARGS (frame)), SCM_FRAME_EVAL_ARGS_P (frame) ? " ..." : "]", indentation, @@ -500,8 +500,8 @@ display_backtrace_file (frame, last_file, port, pstate) *last_file = file; scm_puts ("In ", port); - if (SCM_FALSEP (file)) - if (SCM_FALSEP (line)) + if (scm_is_false (file)) + if (scm_is_false (line)) scm_puts ("unknown file", port); else scm_puts ("current input", port); @@ -523,9 +523,9 @@ display_backtrace_file_and_line (SCM frame, SCM port, scm_print_state *pstate) if (SCM_EQ_P (SCM_PACK (SCM_SHOW_FILE_NAME), sym_base)) { - if (SCM_FALSEP (file)) + if (scm_is_false (file)) { - if (SCM_FALSEP (line)) + if (scm_is_false (line)) scm_putc ('?', port); else scm_puts ("", port); @@ -544,7 +544,7 @@ display_backtrace_file_and_line (SCM frame, SCM port, scm_print_state *pstate) scm_putc (':', port); } - else if (!SCM_FALSEP (line)) + else if (scm_is_true (line)) { int i, j=0; for (i = SCM_INUM (line)+1; i > 0; i = i/10, j++) @@ -552,7 +552,7 @@ display_backtrace_file_and_line (SCM frame, SCM port, scm_print_state *pstate) indent (4-j, port); } - if (SCM_FALSEP (line)) + if (scm_is_false (line)) scm_puts (" ?", port); else scm_intprint (SCM_INUM (line) + 1, 10, port); @@ -572,7 +572,7 @@ display_frame (SCM frame, int nfield, int indentation, SCM sport, SCM port, scm_ } /* display file name and line number */ - if (!SCM_FALSEP (SCM_PACK (SCM_SHOW_FILE_NAME))) + if (scm_is_true (SCM_PACK (SCM_SHOW_FILE_NAME))) display_backtrace_file_and_line (frame, port, pstate); /* Check size of frame number. */ @@ -772,7 +772,7 @@ SCM_DEFINE (scm_backtrace, "backtrace", 0, 0, 0, { SCM the_last_stack = scm_fluid_ref (SCM_VARIABLE_REF (scm_the_last_stack_fluid_var)); - if (!SCM_FALSEP (the_last_stack)) + if (scm_is_true (the_last_stack)) { scm_newline (scm_cur_outp); scm_puts ("Backtrace:\n", scm_cur_outp); @@ -781,7 +781,7 @@ SCM_DEFINE (scm_backtrace, "backtrace", 0, 0, 0, SCM_UNDEFINED, SCM_UNDEFINED); scm_newline (scm_cur_outp); - if (SCM_FALSEP (SCM_VARIABLE_REF (scm_has_shown_backtrace_hint_p_var)) + if (scm_is_false (SCM_VARIABLE_REF (scm_has_shown_backtrace_hint_p_var)) && !SCM_BACKTRACE_P) { scm_puts ("Type \"(debug-enable 'backtrace)\" if you would like " diff --git a/libguile/chars.c b/libguile/chars.c index dc6edf2d0..c4fdf9b03 100644 --- a/libguile/chars.c +++ b/libguile/chars.c @@ -31,7 +31,7 @@ SCM_DEFINE (scm_char_p, "char?", 1, 0, 0, "Return @code{#t} iff @var{x} is a character, else @code{#f}.") #define FUNC_NAME s_scm_char_p { - return SCM_BOOL(SCM_CHARP(x)); + return scm_from_bool (SCM_CHARP(x)); } #undef FUNC_NAME @@ -42,7 +42,7 @@ SCM_DEFINE1 (scm_char_eq_p, "char=?", scm_tc7_rpsubr, { SCM_VALIDATE_CHAR (1, x); SCM_VALIDATE_CHAR (2, y); - return SCM_BOOL (SCM_EQ_P (x, y)); + return scm_from_bool (SCM_EQ_P (x, y)); } #undef FUNC_NAME @@ -55,7 +55,7 @@ SCM_DEFINE1 (scm_char_less_p, "char?", scm_tc7_rpsubr, { SCM_VALIDATE_CHAR (1, x); SCM_VALIDATE_CHAR (2, y); - return SCM_BOOL(SCM_CHAR(x) > SCM_CHAR(y)); + return scm_from_bool (SCM_CHAR(x) > SCM_CHAR(y)); } #undef FUNC_NAME @@ -91,7 +91,7 @@ SCM_DEFINE1 (scm_char_geq_p, "char>=?", scm_tc7_rpsubr, { SCM_VALIDATE_CHAR (1, x); SCM_VALIDATE_CHAR (2, y); - return SCM_BOOL(SCM_CHAR(x) >= SCM_CHAR(y)); + return scm_from_bool (SCM_CHAR(x) >= SCM_CHAR(y)); } #undef FUNC_NAME @@ -103,7 +103,7 @@ SCM_DEFINE1 (scm_char_ci_eq_p, "char-ci=?", scm_tc7_rpsubr, { SCM_VALIDATE_CHAR (1, x); SCM_VALIDATE_CHAR (2, y); - return SCM_BOOL(scm_c_upcase(SCM_CHAR(x))==scm_c_upcase(SCM_CHAR(y))); + return scm_from_bool (scm_c_upcase(SCM_CHAR(x))==scm_c_upcase(SCM_CHAR(y))); } #undef FUNC_NAME @@ -115,7 +115,7 @@ SCM_DEFINE1 (scm_char_ci_less_p, "char-ci?", scm_tc7_rpsubr, { SCM_VALIDATE_CHAR (1, x); SCM_VALIDATE_CHAR (2, y); - return SCM_BOOL(scm_c_upcase(SCM_CHAR(x)) > scm_c_upcase(SCM_CHAR(y))); + return scm_from_bool (scm_c_upcase(SCM_CHAR(x)) > scm_c_upcase(SCM_CHAR(y))); } #undef FUNC_NAME @@ -151,7 +151,7 @@ SCM_DEFINE1 (scm_char_ci_geq_p, "char-ci>=?", scm_tc7_rpsubr, { SCM_VALIDATE_CHAR (1, x); SCM_VALIDATE_CHAR (2, y); - return SCM_BOOL(scm_c_upcase(SCM_CHAR(x)) >= scm_c_upcase(SCM_CHAR(y))); + return scm_from_bool (scm_c_upcase(SCM_CHAR(x)) >= scm_c_upcase(SCM_CHAR(y))); } #undef FUNC_NAME @@ -163,7 +163,7 @@ SCM_DEFINE (scm_char_alphabetic_p, "char-alphabetic?", 1, 0, 0, #define FUNC_NAME s_scm_char_alphabetic_p { SCM_VALIDATE_CHAR (1, chr); - return SCM_BOOL(isalpha(SCM_CHAR(chr))); + return scm_from_bool (isalpha(SCM_CHAR(chr))); } #undef FUNC_NAME @@ -174,7 +174,7 @@ SCM_DEFINE (scm_char_numeric_p, "char-numeric?", 1, 0, 0, #define FUNC_NAME s_scm_char_numeric_p { SCM_VALIDATE_CHAR (1, chr); - return SCM_BOOL(isdigit(SCM_CHAR(chr))); + return scm_from_bool (isdigit(SCM_CHAR(chr))); } #undef FUNC_NAME @@ -185,7 +185,7 @@ SCM_DEFINE (scm_char_whitespace_p, "char-whitespace?", 1, 0, 0, #define FUNC_NAME s_scm_char_whitespace_p { SCM_VALIDATE_CHAR (1, chr); - return SCM_BOOL(isspace(SCM_CHAR(chr))); + return scm_from_bool (isspace(SCM_CHAR(chr))); } #undef FUNC_NAME @@ -198,7 +198,7 @@ SCM_DEFINE (scm_char_upper_case_p, "char-upper-case?", 1, 0, 0, #define FUNC_NAME s_scm_char_upper_case_p { SCM_VALIDATE_CHAR (1, chr); - return SCM_BOOL(isupper(SCM_CHAR(chr))); + return scm_from_bool (isupper(SCM_CHAR(chr))); } #undef FUNC_NAME @@ -210,7 +210,7 @@ SCM_DEFINE (scm_char_lower_case_p, "char-lower-case?", 1, 0, 0, #define FUNC_NAME s_scm_char_lower_case_p { SCM_VALIDATE_CHAR (1, chr); - return SCM_BOOL(islower(SCM_CHAR(chr))); + return scm_from_bool (islower(SCM_CHAR(chr))); } #undef FUNC_NAME @@ -224,7 +224,7 @@ SCM_DEFINE (scm_char_is_both_p, "char-is-both?", 1, 0, 0, #define FUNC_NAME s_scm_char_is_both_p { SCM_VALIDATE_CHAR (1, chr); - return SCM_BOOL((isupper(SCM_CHAR(chr)) || islower(SCM_CHAR(chr)))); + return scm_from_bool ((isupper(SCM_CHAR(chr)) || islower(SCM_CHAR(chr)))); } #undef FUNC_NAME diff --git a/libguile/convert.i.c b/libguile/convert.i.c index 703cf0141..282854400 100644 --- a/libguile/convert.i.c +++ b/libguile/convert.i.c @@ -10,15 +10,15 @@ SCM2CTYPES (SCM obj, CTYPE *data) long i, n; SCM val; - SCM_ASSERT (SCM_NIMP (obj) || SCM_NFALSEP (scm_list_p (obj)), + SCM_ASSERT (SCM_NIMP (obj) || scm_is_true (scm_list_p (obj)), obj, SCM_ARG1, FUNC_NAME); /* list conversion */ - if (SCM_NFALSEP (scm_list_p (obj))) + if (scm_is_true (scm_list_p (obj))) { /* traverse the given list and validate the range of each member */ SCM list = obj; - for (n = 0; SCM_NFALSEP (scm_pair_p (list)); list = SCM_CDR (list), n++) + for (n = 0; scm_is_true (scm_pair_p (list)); list = SCM_CDR (list), n++) { val = SCM_CAR (list); #if SIZEOF_CTYPE && SIZEOF_CTYPE < SIZEOF_SCM_T_BITS @@ -55,7 +55,7 @@ SCM2CTYPES (SCM obj, CTYPE *data) /* traverse the list once more and convert each member */ list = obj; - for (i = 0; SCM_NFALSEP (scm_pair_p (list)); list = SCM_CDR (list), i++) + for (i = 0; scm_is_true (scm_pair_p (list)); list = SCM_CDR (list), i++) { val = SCM_CAR (list); if (SCM_INUMP (val)) diff --git a/libguile/coop-pthreads.c b/libguile/coop-pthreads.c index 42a53457d..57386d4ae 100644 --- a/libguile/coop-pthreads.c +++ b/libguile/coop-pthreads.c @@ -549,7 +549,7 @@ scm_call_with_new_thread (SCM argl) if (!SCM_CONSP (args)) SCM_WRONG_NUM_ARGS (); thunk = SCM_CAR (args); - SCM_ASSERT (SCM_NFALSEP (scm_thunk_p (thunk)), + SCM_ASSERT (scm_is_true (scm_thunk_p (thunk)), thunk, SCM_ARG1, s_call_with_new_thread); @@ -557,7 +557,7 @@ scm_call_with_new_thread (SCM argl) if (!SCM_CONSP (args)) SCM_WRONG_NUM_ARGS (); handler = SCM_CAR (args); - SCM_ASSERT (SCM_NFALSEP (scm_procedure_p (handler)), + SCM_ASSERT (scm_is_true (scm_procedure_p (handler)), handler, SCM_ARG2, s_call_with_new_thread); @@ -677,7 +677,7 @@ scm_unlock_mutex (SCM mx) else { SCM next = dequeue (m->waiting); - if (!SCM_FALSEP (next)) + if (scm_is_true (next)) { m->owner = next; unblock (SCM_THREAD_DATA (next)); @@ -763,7 +763,7 @@ scm_timed_wait_condition_variable (SCM cv, SCM mx, SCM t) else res = timed_block (&waittime); scm_lock_mutex (mx); - return SCM_BOOL (res); + return scm_from_bool (res); } #undef FUNC_NAME @@ -778,7 +778,7 @@ scm_signal_condition_variable (SCM cv) SCM_ARG1, s_signal_condition_variable); c = SCM_CONDVAR_DATA (cv); - if (!SCM_FALSEP (th = dequeue (c->waiting))) + if (scm_is_true (th = dequeue (c->waiting))) unblock (SCM_THREAD_DATA (th)); return SCM_BOOL_T; } @@ -795,7 +795,7 @@ scm_broadcast_condition_variable (SCM cv) SCM_ARG1, s_signal_condition_variable); c = SCM_CONDVAR_DATA (cv); - while (!SCM_FALSEP (th = dequeue (c->waiting))) + while (scm_is_true (th = dequeue (c->waiting))) unblock (SCM_THREAD_DATA (th)); return SCM_BOOL_T; } diff --git a/libguile/coop-threads.c b/libguile/coop-threads.c index 646aa8871..cd50b45aa 100644 --- a/libguile/coop-threads.c +++ b/libguile/coop-threads.c @@ -220,7 +220,7 @@ scm_call_with_new_thread (SCM argl) if (!SCM_CONSP (args)) SCM_WRONG_NUM_ARGS (); thunk = SCM_CAR (args); - SCM_ASSERT (SCM_NFALSEP (scm_thunk_p (thunk)), + SCM_ASSERT (scm_is_true (scm_thunk_p (thunk)), thunk, SCM_ARG1, s_call_with_new_thread); @@ -228,7 +228,7 @@ scm_call_with_new_thread (SCM argl) if (!SCM_CONSP (args)) SCM_WRONG_NUM_ARGS (); handler = SCM_CAR (args); - SCM_ASSERT (SCM_NFALSEP (scm_procedure_p (handler)), + SCM_ASSERT (scm_is_true (scm_procedure_p (handler)), handler, SCM_ARG2, s_call_with_new_thread); @@ -452,7 +452,7 @@ SCM scm_try_mutex (SCM m) { SCM_ASSERT (SCM_MUTEXP (m), m, SCM_ARG1, s_lock_mutex); - return SCM_BOOL (coop_mutex_trylock (SCM_MUTEX_DATA (m))); + return scm_from_bool (coop_mutex_trylock (SCM_MUTEX_DATA (m))); } SCM @@ -509,7 +509,7 @@ scm_timed_wait_condition_variable (SCM c, SCM m, SCM t) SCM_VALIDATE_UINT_COPY (3, t, waittime.tv_sec); waittime.tv_nsec = 0; } - return SCM_BOOL( + return scm_from_bool( coop_condition_variable_timed_wait_mutex (cv, mx, &waittime)); } else diff --git a/libguile/debug.c b/libguile/debug.c index 8fda04c7c..52e507ae6 100644 --- a/libguile/debug.c +++ b/libguile/debug.c @@ -134,7 +134,7 @@ SCM_DEFINE (scm_memoized_p, "memoized?", 1, 0, 0, "Return @code{#t} if @var{obj} is memoized.") #define FUNC_NAME s_scm_memoized_p { - return SCM_BOOL(SCM_MEMOIZEDP (obj)); + return scm_from_bool(SCM_MEMOIZEDP (obj)); } #undef FUNC_NAME @@ -301,10 +301,10 @@ SCM_DEFINE (scm_procedure_name, "procedure-name", 1, 0, 0, #if 0 /* Source property scm_sym_procname not implemented yet... */ SCM name = scm_source_property (SCM_CAR (SCM_CLOSURE_BODY (proc)), scm_sym_procname); - if (SCM_FALSEP (name)) + if (scm_is_false (name)) name = scm_procedure_property (proc, scm_sym_name); #endif - if (SCM_FALSEP (name) && SCM_CLOSUREP (proc)) + if (scm_is_false (name) && SCM_CLOSUREP (proc)) name = scm_reverse_lookup (SCM_ENV (proc), proc); return name; } @@ -326,7 +326,7 @@ SCM_DEFINE (scm_procedure_source, "procedure-source", 1, 0, 0, const SCM body = SCM_CLOSURE_BODY (proc); const SCM src = scm_source_property (body, scm_sym_copy); - if (!SCM_FALSEP (src)) + if (scm_is_true (src)) { return scm_cons2 (scm_sym_lambda, formals, src); } @@ -356,7 +356,7 @@ SCM_DEFINE (scm_procedure_source, "procedure-source", 1, 0, 0, case scm_tc7_pws: { SCM src = scm_procedure_property (proc, scm_sym_source); - if (!SCM_FALSEP (src)) + if (scm_is_true (src)) return src; proc = SCM_PROCEDURE (proc); goto again; @@ -493,7 +493,7 @@ SCM_DEFINE (scm_debug_object_p, "debug-object?", 1, 0, 0, "Return @code{#t} if @var{obj} is a debug object.") #define FUNC_NAME s_scm_debug_object_p { - return SCM_BOOL(SCM_DEBUGOBJP (obj)); + return scm_from_bool(SCM_DEBUGOBJP (obj)); } #undef FUNC_NAME diff --git a/libguile/debug.h b/libguile/debug.h index 426215cc6..81e1fb3f1 100644 --- a/libguile/debug.h +++ b/libguile/debug.h @@ -68,11 +68,11 @@ SCM_API int scm_check_exit_p; #define SCM_RESET_DEBUG_MODE \ do {\ scm_check_entry_p = (SCM_ENTER_FRAME_P || SCM_BREAKPOINTS_P)\ - && !SCM_FALSEP (SCM_ENTER_FRAME_HDLR);\ + && scm_is_true (SCM_ENTER_FRAME_HDLR);\ scm_check_apply_p = (SCM_APPLY_FRAME_P || SCM_TRACE_P)\ - && !SCM_FALSEP (SCM_APPLY_FRAME_HDLR);\ + && scm_is_true (SCM_APPLY_FRAME_HDLR);\ scm_check_exit_p = (SCM_EXIT_FRAME_P || SCM_TRACE_P)\ - && !SCM_FALSEP (SCM_EXIT_FRAME_HDLR);\ + && scm_is_true (SCM_EXIT_FRAME_HDLR);\ scm_debug_mode_p = SCM_DEVAL_P\ || scm_check_entry_p || scm_check_apply_p || scm_check_exit_p;\ } while (0) diff --git a/libguile/deprecated.c b/libguile/deprecated.c index 042debaa6..c3dc8bbee 100644 --- a/libguile/deprecated.c +++ b/libguile/deprecated.c @@ -429,7 +429,7 @@ scm_create_hook (const char *name, int n_args) ("'scm_create_hook' is deprecated. " "Use 'scm_make_hook' and 'scm_c_define' instead."); { - SCM hook = scm_make_hook (SCM_MAKINUM (n_args)); + SCM hook = scm_make_hook (scm_from_int (n_args)); scm_c_define (name, hook); return scm_permanent_object (hook); } @@ -467,7 +467,7 @@ SCM_DEFINE (scm_sloppy_memv, "sloppy-memv", 2, 0, 0, for(; SCM_CONSP (lst); lst = SCM_CDR(lst)) { - if (! SCM_FALSEP (scm_eqv_p (SCM_CAR (lst), x))) + if (! scm_is_false (scm_eqv_p (SCM_CAR (lst), x))) return lst; } return lst; @@ -487,7 +487,7 @@ SCM_DEFINE (scm_sloppy_member, "sloppy-member", 2, 0, 0, for(; SCM_CONSP (lst); lst = SCM_CDR(lst)) { - if (! SCM_FALSEP (scm_equal_p (SCM_CAR (lst), x))) + if (! scm_is_false (scm_equal_p (SCM_CAR (lst), x))) return lst; } return lst; @@ -712,7 +712,7 @@ scm_sym2ovcell (SCM sym, SCM obarray) "Use hashtables instead."); answer = scm_sym2ovcell_soft (sym, obarray); - if (!SCM_FALSEP (answer)) + if (scm_is_true (answer)) return answer; SCM_MISC_ERROR ("uninterned symbol: ~S", scm_list_1 (sym)); return SCM_UNSPECIFIED; /* not reached */ @@ -751,7 +751,7 @@ scm_intern_obarray_soft (const char *name,size_t len,SCM obarray,unsigned int so scm_c_issue_deprecation_warning ("`scm_intern_obarray_soft' is deprecated. " "Use hashtables instead."); - if (SCM_FALSEP (obarray)) + if (scm_is_false (obarray)) { if (softness) return SCM_BOOL_F; @@ -826,14 +826,14 @@ SCM_DEFINE (scm_string_to_obarray_symbol, "string->obarray-symbol", 2, 1, 0, int softness; SCM_VALIDATE_STRING (2, s); - SCM_ASSERT (SCM_BOOLP (o) || SCM_VECTORP (o), o, SCM_ARG1, FUNC_NAME); + SCM_ASSERT (scm_is_bool (o) || SCM_VECTORP (o), o, SCM_ARG1, FUNC_NAME); scm_c_issue_deprecation_warning ("`string->obarray-symbol' is deprecated. " "Use hashtables instead."); - softness = (!SCM_UNBNDP (softp) && !SCM_FALSEP(softp)); + softness = (!SCM_UNBNDP (softp) && scm_is_true(softp)); /* iron out some screwy calling conventions */ - if (SCM_FALSEP (o)) + if (scm_is_false (o)) { /* nothing interesting to do here. */ return scm_string_to_symbol (s); @@ -845,7 +845,7 @@ SCM_DEFINE (scm_string_to_obarray_symbol, "string->obarray-symbol", 2, 1, 0, SCM_STRING_LENGTH (s), o, softness); - if (SCM_FALSEP (vcell)) + if (scm_is_false (vcell)) return vcell; answer = SCM_CAR (vcell); return answer; @@ -861,7 +861,7 @@ SCM_DEFINE (scm_intern_symbol, "intern-symbol", 2, 0, 0, { size_t hval; SCM_VALIDATE_SYMBOL (2,s); - if (SCM_FALSEP (o)) + if (scm_is_false (o)) return SCM_UNSPECIFIED; scm_c_issue_deprecation_warning ("`intern-symbol' is deprecated. " @@ -907,7 +907,7 @@ SCM_DEFINE (scm_unintern_symbol, "unintern-symbol", 2, 0, 0, "Use hashtables instead."); SCM_VALIDATE_SYMBOL (2,s); - if (SCM_FALSEP (o)) + if (scm_is_false (o)) return SCM_BOOL_F; SCM_VALIDATE_VECTOR (1,o); hval = SCM_SYMBOL_HASH (s) % SCM_VECTOR_LENGTH (o); @@ -924,7 +924,7 @@ SCM_DEFINE (scm_unintern_symbol, "unintern-symbol", 2, 0, 0, if (SCM_EQ_P (SCM_CAR (sym), s)) { /* Found the symbol to unintern. */ - if (SCM_FALSEP (lsym_follow)) + if (scm_is_false (lsym_follow)) SCM_VECTOR_SET (o, hval, lsym); else SCM_SETCDR (lsym_follow, SCM_CDR(lsym)); @@ -952,7 +952,7 @@ SCM_DEFINE (scm_symbol_binding, "symbol-binding", 2, 0, 0, "Use hashtables instead."); SCM_VALIDATE_SYMBOL (2,s); - if (SCM_FALSEP (o)) + if (scm_is_false (o)) return scm_variable_ref (scm_lookup (s)); SCM_VALIDATE_VECTOR (1,o); vcell = scm_sym2ovcell (s, o); @@ -973,7 +973,7 @@ SCM_DEFINE (scm_symbol_interned_p, "symbol-interned?", 2, 0, 0, "Use hashtables instead."); SCM_VALIDATE_SYMBOL (2,s); - if (SCM_FALSEP (o)) + if (scm_is_false (o)) { SCM var = scm_sym2var (s, SCM_BOOL_F, SCM_BOOL_F); if (var != SCM_BOOL_F) @@ -1005,7 +1005,7 @@ SCM_DEFINE (scm_symbol_bound_p, "symbol-bound?", 2, 0, 0, "Use hashtables instead."); SCM_VALIDATE_SYMBOL (2,s); - if (SCM_FALSEP (o)) + if (scm_is_false (o)) { SCM var = scm_sym2var (s, SCM_BOOL_F, SCM_BOOL_F); if (SCM_VARIABLEP(var) && !SCM_UNBNDP(SCM_VARIABLE_REF(var))) @@ -1014,7 +1014,7 @@ SCM_DEFINE (scm_symbol_bound_p, "symbol-bound?", 2, 0, 0, } SCM_VALIDATE_VECTOR (1,o); vcell = scm_sym2ovcell_soft (s, o); - return SCM_BOOL (SCM_NIMP (vcell) && !SCM_UNBNDP (SCM_CDR (vcell))); + return scm_from_bool (SCM_NIMP (vcell) && !SCM_UNBNDP (SCM_CDR (vcell))); } #undef FUNC_NAME @@ -1032,7 +1032,7 @@ SCM_DEFINE (scm_symbol_set_x, "symbol-set!", 3, 0, 0, "Use the module system instead."); SCM_VALIDATE_SYMBOL (2,s); - if (SCM_FALSEP (o)) + if (scm_is_false (o)) { scm_define (s, v); return SCM_UNSPECIFIED; @@ -1089,7 +1089,7 @@ SCM_DEFINE (scm_gentemp, "gentemp", 0, 2, 0, FUNC_NAME); do n_digits = scm_iint2str (gentemp_counter++, 10, &name[len]); - while (!SCM_FALSEP (scm_intern_obarray_soft (name, + while (scm_is_true (scm_intern_obarray_soft (name, len + n_digits, obarray, 1))); @@ -1105,6 +1105,16 @@ SCM_DEFINE (scm_gentemp, "gentemp", 0, 2, 0, } #undef FUNC_NAME +#if 0 +SCM +SCM_MAKINUM (scm_t_signed_bits val) +{ + scm_c_issue_deprecation_warning + ("SCM_MAKINUM is deprecated. Use scm_from_int or similar instead."); + return scm_from_int (val); +} +#endif + void scm_i_init_deprecated () { diff --git a/libguile/deprecation.c b/libguile/deprecation.c index e4597dfd2..2c7d2a413 100644 --- a/libguile/deprecation.c +++ b/libguile/deprecation.c @@ -142,7 +142,7 @@ SCM_DEFINE(scm_include_deprecated_features, "in public interfaces.") #define FUNC_NAME s_scm_include_deprecated_features { - return SCM_BOOL (SCM_ENABLE_DEPRECATED == 1); + return scm_from_bool (SCM_ENABLE_DEPRECATED == 1); } #undef FUNC_NAME diff --git a/libguile/dynl.c b/libguile/dynl.c index d6175a76c..16431b0cc 100644 --- a/libguile/dynl.c +++ b/libguile/dynl.c @@ -163,7 +163,7 @@ SCM_DEFINE (scm_dynamic_object_p, "dynamic-object?", 1, 0, 0, "or @code{#f} otherwise.") #define FUNC_NAME s_scm_dynamic_object_p { - return SCM_BOOL (SCM_TYP16_PREDICATE (scm_tc16_dynamic_obj, obj)); + return scm_from_bool (SCM_TYP16_PREDICATE (scm_tc16_dynamic_obj, obj)); } #undef FUNC_NAME diff --git a/libguile/dynwind.c b/libguile/dynwind.c index 5f13c9242..8dc5a4e03 100644 --- a/libguile/dynwind.c +++ b/libguile/dynwind.c @@ -98,7 +98,7 @@ SCM_DEFINE (scm_dynamic_wind, "dynamic-wind", 3, 0, 0, #define FUNC_NAME s_scm_dynamic_wind { SCM ans; - SCM_ASSERT (SCM_NFALSEP (scm_thunk_p (out_guard)), + SCM_ASSERT (scm_is_true (scm_thunk_p (out_guard)), out_guard, SCM_ARG3, FUNC_NAME); scm_call_0 (in_guard); diff --git a/libguile/environments.c b/libguile/environments.c index 7086a0c96..92b46f570 100644 --- a/libguile/environments.c +++ b/libguile/environments.c @@ -106,7 +106,7 @@ SCM_DEFINE (scm_environment_p, "environment?", 1, 0, 0, "otherwise.") #define FUNC_NAME s_scm_environment_p { - return SCM_BOOL (SCM_ENVIRONMENT_P (obj)); + return scm_from_bool (SCM_ENVIRONMENT_P (obj)); } #undef FUNC_NAME @@ -120,7 +120,7 @@ SCM_DEFINE (scm_environment_bound_p, "environment-bound?", 2, 0, 0, SCM_ASSERT (SCM_ENVIRONMENT_P (env), env, SCM_ARG1, FUNC_NAME); SCM_ASSERT (SCM_SYMBOLP (sym), sym, SCM_ARG2, FUNC_NAME); - return SCM_BOOL (SCM_ENVIRONMENT_BOUND_P (env, sym)); + return scm_from_bool (SCM_ENVIRONMENT_BOUND_P (env, sym)); } #undef FUNC_NAME @@ -330,9 +330,9 @@ SCM_DEFINE (scm_environment_cell, "environment-cell", 3, 0, 0, SCM_ASSERT (SCM_ENVIRONMENT_P (env), env, SCM_ARG1, FUNC_NAME); SCM_ASSERT (SCM_SYMBOLP (sym), sym, SCM_ARG2, FUNC_NAME); - SCM_ASSERT (SCM_BOOLP (for_write), for_write, SCM_ARG3, FUNC_NAME); + SCM_ASSERT (scm_is_bool (for_write), for_write, SCM_ARG3, FUNC_NAME); - location = SCM_ENVIRONMENT_CELL (env, sym, !SCM_FALSEP (for_write)); + location = SCM_ENVIRONMENT_CELL (env, sym, scm_is_true (for_write)); if (!SCM_IMP (location)) return location; else if (SCM_UNBNDP (location)) @@ -921,7 +921,7 @@ leaf_environment_undefine (SCM env, SCM sym) SCM obarray = LEAF_ENVIRONMENT (env)->obarray; SCM removed = obarray_remove (obarray, sym); - if (!SCM_FALSEP (removed)) + if (scm_is_true (removed)) core_environments_broadcast (env); return SCM_ENVIRONMENT_SUCCESS; @@ -1037,7 +1037,7 @@ SCM_DEFINE (scm_leaf_environment_p, "leaf-environment?", 1, 0, 0, "otherwise.") #define FUNC_NAME s_scm_leaf_environment_p { - return SCM_BOOL (SCM_LEAF_ENVIRONMENT_P (object)); + return scm_from_bool (SCM_LEAF_ENVIRONMENT_P (object)); } #undef FUNC_NAME @@ -1439,7 +1439,7 @@ SCM_DEFINE (scm_eval_environment_p, "eval-environment?", 1, 0, 0, "otherwise.") #define FUNC_NAME s_scm_eval_environment_p { - return SCM_BOOL (SCM_EVAL_ENVIRONMENT_P (object)); + return scm_from_bool (SCM_EVAL_ENVIRONMENT_P (object)); } #undef FUNC_NAME @@ -1851,7 +1851,7 @@ SCM_DEFINE (scm_import_environment_p, "import-environment?", 1, 0, 0, "@code{#f} otherwise.") #define FUNC_NAME s_scm_import_environment_p { - return SCM_BOOL (SCM_IMPORT_ENVIRONMENT_P (object)); + return scm_from_bool (SCM_IMPORT_ENVIRONMENT_P (object)); } #undef FUNC_NAME @@ -1946,7 +1946,7 @@ export_environment_ref (SCM env, SCM sym) struct export_environment *body = EXPORT_ENVIRONMENT (env); SCM entry = scm_assq (sym, body->signature); - if (SCM_FALSEP (entry)) + if (scm_is_false (entry)) return SCM_UNDEFINED; else return SCM_ENVIRONMENT_REF (body->private, sym); @@ -1999,7 +1999,7 @@ export_environment_set_x (SCM env, SCM sym, SCM val) struct export_environment *body = EXPORT_ENVIRONMENT (env); SCM entry = scm_assq (sym, body->signature); - if (SCM_FALSEP (entry)) + if (scm_is_false (entry)) { return SCM_UNDEFINED; } @@ -2021,7 +2021,7 @@ export_environment_cell (SCM env, SCM sym, int for_write) struct export_environment *body = EXPORT_ENVIRONMENT (env); SCM entry = scm_assq (sym, body->signature); - if (SCM_FALSEP (entry)) + if (scm_is_false (entry)) { return SCM_UNDEFINED; } @@ -2177,7 +2177,7 @@ SCM_DEFINE (scm_export_environment_p, "export-environment?", 1, 0, 0, "@code{#f} otherwise.") #define FUNC_NAME s_scm_export_environment_p { - return SCM_BOOL (SCM_EXPORT_ENVIRONMENT_P (object)); + return scm_from_bool (SCM_EXPORT_ENVIRONMENT_P (object)); } #undef FUNC_NAME diff --git a/libguile/eq.c b/libguile/eq.c index 40d5d86ec..7f368ed1a 100644 --- a/libguile/eq.c +++ b/libguile/eq.c @@ -47,7 +47,7 @@ SCM_DEFINE1 (scm_eq_p, "eq?", scm_tc7_rpsubr, "@code{eqv?}.") #define FUNC_NAME s_scm_eq_p { - return SCM_BOOL (SCM_EQ_P (x, y)); + return scm_from_bool (SCM_EQ_P (x, y)); } #undef FUNC_NAME @@ -90,12 +90,12 @@ SCM_PRIMITIVE_GENERIC_1 (scm_eqv_p, "eqv?", scm_tc7_rpsubr, if (SCM_INEXACTP (x)) { if (SCM_REALP (x)) - return SCM_BOOL (SCM_COMPLEXP (y) + return scm_from_bool (SCM_COMPLEXP (y) && real_eqv (SCM_REAL_VALUE (x), SCM_COMPLEX_REAL (y)) && SCM_COMPLEX_IMAG (y) == 0.0); else - return SCM_BOOL (SCM_REALP (y) + return scm_from_bool (SCM_REALP (y) && real_eqv (SCM_COMPLEX_REAL (x), SCM_REAL_VALUE (y)) && SCM_COMPLEX_IMAG (x) == 0.0); @@ -108,13 +108,13 @@ SCM_PRIMITIVE_GENERIC_1 (scm_eqv_p, "eqv?", scm_tc7_rpsubr, if (SCM_NUMP (x)) { if (SCM_BIGP (x)) { - return SCM_BOOL (scm_i_bigcmp (x, y) == 0); + return scm_from_bool (scm_i_bigcmp (x, y) == 0); } else if (SCM_REALP (x)) { - return SCM_BOOL (real_eqv (SCM_REAL_VALUE (x), SCM_REAL_VALUE (y))); + return scm_from_bool (real_eqv (SCM_REAL_VALUE (x), SCM_REAL_VALUE (y))); } else if (SCM_FRACTIONP (x)) { return scm_i_fraction_equalp (x, y); } else { /* complex */ - return SCM_BOOL (real_eqv (SCM_COMPLEX_REAL (x), + return scm_from_bool (real_eqv (SCM_COMPLEX_REAL (x), SCM_COMPLEX_REAL (y)) && real_eqv (SCM_COMPLEX_IMAG (x), SCM_COMPLEX_IMAG (y))); @@ -149,7 +149,7 @@ SCM_PRIMITIVE_GENERIC_1 (scm_equal_p, "equal?", scm_tc7_rpsubr, return SCM_BOOL_F; if (SCM_CONSP (x) && SCM_CONSP (y)) { - if (SCM_FALSEP (scm_equal_p (SCM_CAR (x), SCM_CAR (y)))) + if (scm_is_false (scm_equal_p (SCM_CAR (x), SCM_CAR (y)))) return SCM_BOOL_F; x = SCM_CDR(x); y = SCM_CDR(y); @@ -164,11 +164,11 @@ SCM_PRIMITIVE_GENERIC_1 (scm_equal_p, "equal?", scm_tc7_rpsubr, if (SCM_INEXACTP (x) && SCM_INEXACTP (y)) { if (SCM_REALP (x)) - return SCM_BOOL (SCM_COMPLEXP (y) + return scm_from_bool (SCM_COMPLEXP (y) && SCM_REAL_VALUE (x) == SCM_COMPLEX_REAL (y) && SCM_COMPLEX_IMAG (y) == 0.0); else - return SCM_BOOL (SCM_REALP (y) + return scm_from_bool (SCM_REALP (y) && SCM_COMPLEX_REAL (x) == SCM_REAL_VALUE (y) && SCM_COMPLEX_IMAG (x) == 0.0); } @@ -177,17 +177,17 @@ SCM_PRIMITIVE_GENERIC_1 (scm_equal_p, "equal?", scm_tc7_rpsubr, else if ((SCM_FRACTIONP (x)) && (SCM_INEXACTP (y))) { if (SCM_REALP (y)) - return SCM_BOOL (scm_i_fraction2double (x) == SCM_REAL_VALUE (y)); + return scm_from_bool (scm_i_fraction2double (x) == SCM_REAL_VALUE (y)); else - return SCM_BOOL (SCM_COMPLEX_REAL (y) == scm_i_fraction2double (x) + return scm_from_bool (SCM_COMPLEX_REAL (y) == scm_i_fraction2double (x) && SCM_COMPLEX_IMAG (y) == 0.0); } else if ((SCM_FRACTIONP (y)) && (SCM_INEXACTP (x))) { if (SCM_REALP (x)) - return SCM_BOOL (scm_i_fraction2double (y) == SCM_REAL_VALUE (x)); + return scm_from_bool (scm_i_fraction2double (y) == SCM_REAL_VALUE (x)); else - return SCM_BOOL (SCM_COMPLEX_REAL (x) == scm_i_fraction2double (y) + return scm_from_bool (SCM_COMPLEX_REAL (x) == scm_i_fraction2double (y) && SCM_COMPLEX_IMAG (x) == 0.0); } diff --git a/libguile/error.c b/libguile/error.c index fd6d70709..76023a232 100644 --- a/libguile/error.c +++ b/libguile/error.c @@ -102,7 +102,7 @@ SCM_DEFINE (scm_error_scm, "scm-error", 5, 0, 0, SCM_VALIDATE_SYMBOL (1, key); - if (SCM_FALSEP (subr)) + if (scm_is_false (subr)) { szSubr = NULL; } @@ -116,7 +116,7 @@ SCM_DEFINE (scm_error_scm, "scm-error", 5, 0, 0, szSubr = SCM_STRING_CHARS (subr); } - if (SCM_FALSEP (message)) + if (scm_is_false (message)) { szMessage = NULL; } @@ -163,7 +163,7 @@ scm_syserror (const char *subr) subr, "~A", scm_cons (scm_makfrom0str (SCM_I_STRERROR (save_errno)), SCM_EOL), - scm_cons (SCM_MAKINUM (save_errno), SCM_EOL)); + scm_cons (scm_from_int (save_errno), SCM_EOL)); } void @@ -173,7 +173,7 @@ scm_syserror_msg (const char *subr, const char *message, SCM args, int eno) subr, message, args, - scm_cons (SCM_MAKINUM (eno), SCM_EOL)); + scm_cons (scm_from_int (eno), SCM_EOL)); } SCM_GLOBAL_SYMBOL (scm_num_overflow_key, "numerical-overflow"); diff --git a/libguile/eval.c b/libguile/eval.c index 1267aebe1..d7b37f4b9 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -266,7 +266,7 @@ syntax_error (const char* const msg, const SCM form, const SCM expr) linenr = scm_source_property (form, scm_sym_line); } - if (SCM_FALSEP (filename) && SCM_FALSEP (linenr) && SCM_CONSP (expr)) + if (scm_is_false (filename) && scm_is_false (linenr) && SCM_CONSP (expr)) { filename = scm_source_property (expr, scm_sym_filename); linenr = scm_source_property (expr, scm_sym_line); @@ -274,12 +274,12 @@ syntax_error (const char* const msg, const SCM form, const SCM expr) if (!SCM_UNBNDP (expr)) { - if (!SCM_FALSEP (filename)) + if (scm_is_true (filename)) { format = "In file ~S, line ~S: ~A ~S in expression ~S."; args = scm_list_5 (filename, linenr, msg_string, form, expr); } - else if (!SCM_FALSEP (linenr)) + else if (scm_is_true (linenr)) { format = "In line ~S: ~A ~S in expression ~S."; args = scm_list_4 (linenr, msg_string, form, expr); @@ -292,12 +292,12 @@ syntax_error (const char* const msg, const SCM form, const SCM expr) } else { - if (!SCM_FALSEP (filename)) + if (scm_is_true (filename)) { format = "In file ~S, line ~S: ~A ~S."; args = scm_list_4 (filename, linenr, msg_string, form); } - else if (!SCM_FALSEP (linenr)) + else if (scm_is_true (linenr)) { format = "In line ~S: ~A ~S."; args = scm_list_3 (linenr, msg_string, form); @@ -369,7 +369,7 @@ SCM_DEFINE (scm_dbg_make_iloc, "dbg-make-iloc", 3, 0, 0, SCM_VALIDATE_INUM (2, binding); return SCM_MAKE_ILOC (SCM_INUM (frame), SCM_INUM (binding), - !SCM_FALSEP (cdrp)); + scm_is_true (cdrp)); } #undef FUNC_NAME @@ -380,7 +380,7 @@ SCM_DEFINE (scm_dbg_iloc_p, "dbg-iloc?", 1, 0, 0, "Return @code{#t} if @var{obj} is an iloc.") #define FUNC_NAME s_scm_dbg_iloc_p { - return SCM_BOOL (SCM_ILOCP (obj)); + return scm_from_bool (SCM_ILOCP (obj)); } #undef FUNC_NAME @@ -450,7 +450,7 @@ static SCM lookup_global_symbol (const SCM symbol, const SCM top_level) { const SCM variable = scm_sym2var (symbol, top_level, SCM_BOOL_F); - if (SCM_FALSEP (variable)) + if (scm_is_false (variable)) return SCM_UNDEFINED; else return variable; @@ -555,7 +555,7 @@ unmemoize_expression (const SCM expr, const SCM env) else if (SCM_VARIABLEP (expr)) { const SCM sym = scm_module_reverse_lookup (scm_env_module (env), expr); - return !SCM_FALSEP (sym) ? sym : sym_three_question_marks; + return scm_is_true (sym) ? sym : sym_three_question_marks; } else if (SCM_VECTORP (expr)) { @@ -995,7 +995,7 @@ scm_m_case (SCM expr, SCM env) for (; !SCM_NULLP (all_labels); all_labels = SCM_CDR (all_labels)) { const SCM label = SCM_CAR (all_labels); - ASSERT_SYNTAX_2 (SCM_FALSEP (scm_c_memq (label, SCM_CDR (all_labels))), + ASSERT_SYNTAX_2 (scm_is_false (scm_c_memq (label, SCM_CDR (all_labels))), s_duplicate_case_label, label, expr); } @@ -1207,7 +1207,7 @@ scm_m_define (SCM expr, SCM env) tmp = SCM_MACRO_CODE (tmp); if (SCM_CLOSUREP (tmp) /* Only the first definition determines the name. */ - && SCM_FALSEP (scm_procedure_property (tmp, scm_sym_name))) + && scm_is_false (scm_procedure_property (tmp, scm_sym_name))) scm_set_procedure_property_x (tmp, scm_sym_name, variable); } @@ -1311,7 +1311,7 @@ scm_m_do (SCM expr, SCM env SCM_UNUSED) const SCM init = SCM_CADR (binding); const SCM step = (length == 2) ? name : SCM_CADDR (binding); ASSERT_SYNTAX_2 (SCM_SYMBOLP (name), s_bad_variable, name, expr); - ASSERT_SYNTAX_2 (SCM_FALSEP (scm_c_memq (name, variables)), + ASSERT_SYNTAX_2 (scm_is_false (scm_c_memq (name, variables)), s_duplicate_binding, name, expr); variables = scm_cons (name, variables); @@ -1546,7 +1546,7 @@ transform_bindings ( const SCM binding = SCM_CAR (binding_idx); const SCM cdr_binding = SCM_CDR (binding); const SCM name = SCM_CAR (binding); - ASSERT_SYNTAX_2 (SCM_FALSEP (scm_c_memq (name, rvariables)), + ASSERT_SYNTAX_2 (scm_is_false (scm_c_memq (name, rvariables)), s_duplicate_binding, name, expr); rvariables = scm_cons (name, rvariables); rinits = scm_cons (SCM_CAR (cdr_binding), rinits); @@ -2028,7 +2028,7 @@ scm_m_atbind (SCM expr, SCM env) * while the second call wont. */ const SCM variable = SCM_CAR (variable_idx); SCM new_variable = scm_sym2var (variable, top_level, SCM_BOOL_F); - if (SCM_FALSEP (new_variable)) + if (scm_is_false (new_variable)) new_variable = scm_sym2var (variable, top_level, SCM_BOOL_T); SCM_SETCAR (variable_idx, new_variable); } @@ -2408,7 +2408,7 @@ scm_i_unmemocopy_expr (SCM expr, SCM env) const SCM source_properties = scm_whash_lookup (scm_source_whash, expr); const SCM um_expr = unmemoize_expression (expr, env); - if (!SCM_FALSEP (source_properties)) + if (scm_is_true (source_properties)) scm_whash_insert (scm_source_whash, um_expr, source_properties); return um_expr; @@ -2420,7 +2420,7 @@ scm_i_unmemocopy_body (SCM forms, SCM env) const SCM source_properties = scm_whash_lookup (scm_source_whash, forms); const SCM um_forms = unmemoize_exprs (forms, env); - if (!SCM_FALSEP (source_properties)) + if (scm_is_true (source_properties)) scm_whash_insert (scm_source_whash, um_forms, source_properties); return um_forms; @@ -2459,7 +2459,7 @@ scm_m_undefine (SCM expr, SCM env) variable = SCM_CAR (cdr_expr); ASSERT_SYNTAX_2 (SCM_SYMBOLP (variable), s_bad_variable, variable, expr); location = scm_sym2var (variable, scm_env_top_level (env), SCM_BOOL_F); - ASSERT_SYNTAX_2 (!SCM_FALSEP (location) + ASSERT_SYNTAX_2 (scm_is_true (location) && !SCM_UNBNDP (SCM_VARIABLE_REF (location)), "variable already unbound ", variable, expr); SCM_VARIABLE_SET (location, SCM_UNDEFINED); @@ -2493,7 +2493,7 @@ scm_unmemocar (SCM form, SCM env) if (SCM_VARIABLEP (c)) { SCM sym = scm_module_reverse_lookup (scm_env_module (env), c); - if (SCM_FALSEP (sym)) + if (scm_is_false (sym)) sym = sym_three_question_marks; SCM_SETCAR (form, sym); } @@ -2812,7 +2812,7 @@ scm_lookupcar1 (SCM vloc, SCM genv, int check) else top_thunk = SCM_BOOL_F; real_var = scm_sym2var (var, top_thunk, SCM_BOOL_F); - if (SCM_FALSEP (real_var)) + if (scm_is_false (real_var)) goto errout; if (!SCM_NULLP (env) || SCM_UNBNDP (SCM_VARIABLE_REF (real_var))) @@ -2878,7 +2878,7 @@ lazy_memoize_variable (const SCM symbol, const SCM environment) const SCM top_level = scm_env_top_level (environment); const SCM variable = scm_sym2var (symbol, top_level, SCM_BOOL_F); - if (SCM_FALSEP (variable)) + if (scm_is_false (variable)) error_unbound_variable (symbol); else return variable; @@ -2978,7 +2978,7 @@ do { \ if (scm_check_apply_p && SCM_TRAPS_P)\ if (SCM_APPLY_FRAME_P || (SCM_TRACE_P && PROCTRACEP (proc)))\ {\ - SCM tmp, tail = SCM_BOOL(SCM_TRACED_FRAME_P (debug)); \ + SCM tmp, tail = scm_from_bool(SCM_TRACED_FRAME_P (debug)); \ SCM_SET_TRACED_FRAME (debug); \ SCM_TRAPS_P = 0;\ if (SCM_CHEAPTRAPS_P)\ @@ -3229,7 +3229,7 @@ start: || (SCM_BREAKPOINTS_P && scm_c_source_property_breakpoint_p (x))) { SCM stackrep; - SCM tail = SCM_BOOL (SCM_TAILRECP (debug)); + SCM tail = scm_from_bool (SCM_TAILRECP (debug)); SCM_SET_TAILREC (debug); if (SCM_CHEAPTRAPS_P) stackrep = scm_make_debugobj (&debug); @@ -3272,7 +3272,7 @@ dispatch: while (!SCM_NULLP (SCM_CDR (x))) { SCM test_result = EVALCAR (x, env); - if (SCM_FALSEP (test_result) || SCM_NILP (test_result)) + if (scm_is_false (test_result) || SCM_NILP (test_result)) RETURN (SCM_BOOL_F); else x = SCM_CDR (x); @@ -3368,7 +3368,7 @@ dispatch: { const SCM label = SCM_CAR (labels); if (SCM_EQ_P (label, key) - || !SCM_FALSEP (scm_eqv_p (label, key))) + || scm_is_true (scm_eqv_p (label, key))) { x = SCM_CDR (clause); PREP_APPLY (SCM_UNDEFINED, SCM_EOL); @@ -3396,7 +3396,7 @@ dispatch: else { arg1 = EVALCAR (clause, env); - if (!SCM_FALSEP (arg1) && !SCM_NILP (arg1)) + if (scm_is_true (arg1) && !SCM_NILP (arg1)) { x = SCM_CDR (clause); if (SCM_NULLP (x)) @@ -3443,7 +3443,7 @@ dispatch: SCM test_result = EVALCAR (test_form, env); - while (SCM_FALSEP (test_result) || SCM_NILP (test_result)) + while (scm_is_false (test_result) || SCM_NILP (test_result)) { { /* Evaluate body forms. */ @@ -3497,7 +3497,7 @@ dispatch: { SCM test_result = EVALCAR (x, env); x = SCM_CDR (x); /* then expression */ - if (SCM_FALSEP (test_result) || SCM_NILP (test_result)) + if (scm_is_false (test_result) || SCM_NILP (test_result)) { x = SCM_CDR (x); /* else expression */ if (SCM_NULLP (x)) @@ -3572,7 +3572,7 @@ dispatch: while (!SCM_NULLP (SCM_CDR (x))) { SCM val = EVALCAR (x, env); - if (!SCM_FALSEP (val) && !SCM_NILP (val)) + if (scm_is_true (val) && !SCM_NILP (val)) RETURN (val); else x = SCM_CDR (x); @@ -3853,7 +3853,7 @@ dispatch: while (!SCM_NULL_OR_NIL_P (x)) { SCM test_result = EVALCAR (test_form, env); - if (!(SCM_FALSEP (test_result) + if (!(scm_is_false (test_result) || SCM_NULL_OR_NIL_P (test_result))) { if (SCM_EQ_P (SCM_CAR (x), SCM_UNSPECIFIED)) @@ -4409,12 +4409,12 @@ dispatch: while (SCM_NIMP (arg2)); RETURN (arg1); case scm_tc7_rpsubr: - if (SCM_FALSEP (SCM_SUBRF (proc) (arg1, arg2))) + if (scm_is_false (SCM_SUBRF (proc) (arg1, arg2))) RETURN (SCM_BOOL_F); arg1 = SCM_CDDR (debug.info->a.args); do { - if (SCM_FALSEP (SCM_SUBRF (proc) (arg2, SCM_CAR (arg1)))) + if (scm_is_false (SCM_SUBRF (proc) (arg2, SCM_CAR (arg1)))) RETURN (SCM_BOOL_F); arg2 = SCM_CAR (arg1); arg1 = SCM_CDR (arg1); @@ -4471,12 +4471,12 @@ dispatch: while (!SCM_NULLP (x)); RETURN (arg1); case scm_tc7_rpsubr: - if (SCM_FALSEP (SCM_SUBRF (proc) (arg1, arg2))) + if (scm_is_false (SCM_SUBRF (proc) (arg1, arg2))) RETURN (SCM_BOOL_F); do { arg1 = EVALCAR (x, env); - if (SCM_FALSEP (SCM_SUBRF (proc) (arg2, arg1))) + if (scm_is_false (SCM_SUBRF (proc) (arg2, arg1))) RETURN (SCM_BOOL_F); arg2 = arg1; x = SCM_CDR (x); @@ -4893,7 +4893,7 @@ tail: while (SCM_NIMP (args)) { SCM_ASSERT (SCM_CONSP (args), args, SCM_ARG2, "apply"); - if (SCM_FALSEP (SCM_SUBRF (proc) (arg1, SCM_CAR (args)))) + if (scm_is_false (SCM_SUBRF (proc) (arg1, SCM_CAR (args)))) RETURN (SCM_BOOL_F); arg1 = SCM_CAR (args); args = SCM_CDR (args); @@ -5629,7 +5629,7 @@ SCM_DEFINE (scm_promise_p, "promise?", 1, 0, 0, "(@pxref{Delayed evaluation,,,r5rs.info,The Revised^5 Report on Scheme}).") #define FUNC_NAME s_scm_promise_p { - return SCM_BOOL (SCM_TYP16_PREDICATE (scm_tc16_promise, obj)); + return scm_from_bool (SCM_TYP16_PREDICATE (scm_tc16_promise, obj)); } #undef FUNC_NAME @@ -5645,7 +5645,7 @@ SCM_DEFINE (scm_cons_source, "cons-source", 3, 0, 0, z = scm_cons (x, y); /* Copy source properties possibly associated with xorig. */ p = scm_whash_lookup (scm_source_whash, xorig); - if (!SCM_FALSEP (p)) + if (scm_is_true (p)) scm_whash_insert (scm_source_whash, z, p); return z; } @@ -5886,7 +5886,7 @@ SCM_DEFINE (scm_primitive_eval, "primitive-eval", 1, 0, 0, { SCM env; SCM transformer = scm_current_module_transformer (); - if (!SCM_FALSEP (transformer)) + if (scm_is_true (transformer)) exp = scm_call_1 (transformer, exp); env = scm_top_level_env (scm_current_module_lookup_closure ()); return scm_i_eval (exp, env); diff --git a/libguile/evalext.c b/libguile/evalext.c index 0590f48c9..c6e6dea76 100644 --- a/libguile/evalext.c +++ b/libguile/evalext.c @@ -49,7 +49,7 @@ SCM_DEFINE (scm_defined_p, "defined?", 1, 1, 0, { SCM_ASSERT (SCM_CONSP (frames), env, SCM_ARG2, FUNC_NAME); b = SCM_CAR (frames); - if (!SCM_FALSEP (scm_procedure_p (b))) + if (scm_is_true (scm_procedure_p (b))) break; SCM_ASSERT (SCM_CONSP (b), env, SCM_ARG2, FUNC_NAME); for (b = SCM_CAR (b); SCM_NIMP (b); b = SCM_CDR (b)) @@ -70,7 +70,7 @@ SCM_DEFINE (scm_defined_p, "defined?", 1, 1, 0, SCM_BOOL_F); } - return (SCM_FALSEP (var) || SCM_UNBNDP (SCM_VARIABLE_REF (var)) + return (scm_is_false (var) || SCM_UNBNDP (SCM_VARIABLE_REF (var)) ? SCM_BOOL_F : SCM_BOOL_T); } @@ -93,7 +93,7 @@ SCM_DEFINE (scm_self_evaluating_p, "self-evaluating?", 1, 0, 0, return SCM_BOOL_T; case scm_tc3_imm24: /* characters, booleans, other immediates */ - return SCM_BOOL (!SCM_NULLP (obj)); + return scm_from_bool (!SCM_NULLP (obj)); case scm_tc3_cons: switch (SCM_TYP7 (obj)) { diff --git a/libguile/filesys.c b/libguile/filesys.c index 3c58d1f79..69414043e 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -388,7 +388,7 @@ SCM_DEFINE (scm_close, "close", 1, 0, 0, not an error. */ if (rv < 0 && errno != EBADF) SCM_SYSERROR; - return SCM_BOOL (rv >= 0); + return scm_from_bool (rv >= 0); } #undef FUNC_NAME @@ -785,7 +785,7 @@ SCM_DEFINE (scm_directory_stream_p, "directory-stream?", 1, 0, 0, "stream as returned by @code{opendir}.") #define FUNC_NAME s_scm_directory_stream_p { - return SCM_BOOL (SCM_DIRP (obj)); + return scm_from_bool (SCM_DIRP (obj)); } #undef FUNC_NAME @@ -1209,7 +1209,7 @@ SCM_DEFINE (scm_select, "select", 3, 2, 0, timeout.tv_usec = 0; time_ptr = &timeout; } - else if (SCM_UNBNDP (secs) || SCM_FALSEP (secs)) + else if (SCM_UNBNDP (secs) || scm_is_false (secs)) time_ptr = 0; else { diff --git a/libguile/fluids.c b/libguile/fluids.c index 6cae477cc..da4b317e0 100644 --- a/libguile/fluids.c +++ b/libguile/fluids.c @@ -113,7 +113,7 @@ SCM_DEFINE (scm_fluid_p, "fluid?", 1, 0, 0, "@code{#f}.") #define FUNC_NAME s_scm_fluid_p { - return SCM_BOOL(SCM_FLUIDP (obj)); + return scm_from_bool(SCM_FLUIDP (obj)); } #undef FUNC_NAME diff --git a/libguile/fports.c b/libguile/fports.c index e30d7bb8c..3077318e5 100644 --- a/libguile/fports.c +++ b/libguile/fports.c @@ -228,7 +228,7 @@ SCM_DEFINE (scm_file_port_p, "file-port?", 1, 0, 0, "Determine whether @var{obj} is a port that is related to a file.") #define FUNC_NAME s_scm_file_port_p { - return SCM_BOOL (SCM_FPORTP (obj)); + return scm_from_bool (SCM_FPORTP (obj)); } #undef FUNC_NAME diff --git a/libguile/gc.c b/libguile/gc.c index 2eebbb59c..c8709e03b 100644 --- a/libguile/gc.c +++ b/libguile/gc.c @@ -181,7 +181,7 @@ SCM_DEFINE (scm_set_debug_cell_accesses_x, "set-debug-cell-accesses!", 1, 0, 0, "@code{SCM_DEBUG_CELL_ACCESSES} was set to 1.") #define FUNC_NAME s_scm_set_debug_cell_accesses_x { - if (SCM_FALSEP (flag)) + if (scm_is_false (flag)) { scm_debug_cell_accesses_p = 0; } @@ -745,7 +745,7 @@ scm_gc_unprotect_object (SCM obj) handle = scm_hashq_get_handle (scm_protects, obj); - if (SCM_FALSEP (handle)) + if (scm_is_false (handle)) { fprintf (stderr, "scm_unprotect_object called on unprotected object\n"); abort (); @@ -791,7 +791,7 @@ scm_gc_unregister_root (SCM *p) handle = scm_hashv_get_handle (scm_gc_registered_roots, key); - if (SCM_FALSEP (handle)) + if (scm_is_false (handle)) { fprintf (stderr, "scm_gc_unregister_root called on unregistered root\n"); abort (); diff --git a/libguile/gh_data.c b/libguile/gh_data.c index 4db7ea273..e08207ffe 100644 --- a/libguile/gh_data.c +++ b/libguile/gh_data.c @@ -31,7 +31,7 @@ SCM gh_bool2scm (int x) { - return SCM_BOOL(x); + return scm_from_bool(x); } SCM gh_int2scm (int x) @@ -182,7 +182,7 @@ gh_doubles2dvect (const double *d, long n) int gh_scm2bool (SCM obj) { - return (SCM_FALSEP (obj)) ? 0 : 1; + return (scm_is_false (obj)) ? 0 : 1; } unsigned long gh_scm2ulong (SCM obj) diff --git a/libguile/gh_predicates.c b/libguile/gh_predicates.c index cd4290505..655bd8b2c 100644 --- a/libguile/gh_predicates.c +++ b/libguile/gh_predicates.c @@ -24,74 +24,74 @@ int gh_boolean_p (SCM val) { - return (SCM_NFALSEP (scm_boolean_p (val))); + return (scm_is_true (scm_boolean_p (val))); } int gh_symbol_p (SCM val) { - return (SCM_NFALSEP (scm_symbol_p (val))); + return (scm_is_true (scm_symbol_p (val))); } int gh_char_p (SCM val) { - return (SCM_NFALSEP (scm_char_p (val))); + return (scm_is_true (scm_char_p (val))); } int gh_vector_p (SCM val) { - return (SCM_NFALSEP (scm_vector_p (val))); + return (scm_is_true (scm_vector_p (val))); } int gh_pair_p (SCM val) { - return (SCM_NFALSEP (scm_pair_p (val))); + return (scm_is_true (scm_pair_p (val))); } int gh_number_p (SCM val) { - return (SCM_NFALSEP (scm_number_p (val))); + return (scm_is_true (scm_number_p (val))); } int gh_string_p (SCM val) { - return (SCM_NFALSEP (scm_string_p (val))); + return (scm_is_true (scm_string_p (val))); } int gh_procedure_p (SCM val) { - return (SCM_NFALSEP (scm_procedure_p (val))); + return (scm_is_true (scm_procedure_p (val))); } int gh_list_p (SCM val) { - return (SCM_NFALSEP (scm_list_p (val))); + return (scm_is_true (scm_list_p (val))); } int gh_inexact_p (SCM val) { - return (SCM_NFALSEP (scm_inexact_p (val))); + return (scm_is_true (scm_inexact_p (val))); } int gh_exact_p (SCM val) { - return (SCM_NFALSEP (scm_exact_p (val))); + return (scm_is_true (scm_exact_p (val))); } /* the three types of equality */ int gh_eq_p (SCM x, SCM y) { - return (SCM_NFALSEP (scm_eq_p (x, y))); + return (scm_is_true (scm_eq_p (x, y))); } int gh_eqv_p (SCM x, SCM y) { - return (SCM_NFALSEP (scm_eqv_p (x, y))); + return (scm_is_true (scm_eqv_p (x, y))); } int gh_equal_p (SCM x, SCM y) { - return (SCM_NFALSEP (scm_equal_p (x, y))); + return (scm_is_true (scm_equal_p (x, y))); } /* equivalent to (string=? ...), but returns 0 or 1 rather than Scheme @@ -99,7 +99,7 @@ gh_equal_p (SCM x, SCM y) int gh_string_equal_p(SCM s1, SCM s2) { - return (SCM_NFALSEP (scm_string_equal_p(s1, s2))); + return (scm_is_true (scm_string_equal_p(s1, s2))); } /* equivalent to (null? ...), but returns 0 or 1 rather than Scheme @@ -107,7 +107,7 @@ gh_string_equal_p(SCM s1, SCM s2) int gh_null_p(SCM l) { - return (SCM_NFALSEP(scm_null_p(l))); + return (scm_is_true(scm_null_p(l))); } /* diff --git a/libguile/goops.c b/libguile/goops.c index 092e876af..a8c6132e5 100644 --- a/libguile/goops.c +++ b/libguile/goops.c @@ -95,7 +95,7 @@ #define TEST_CHANGE_CLASS(obj, class) \ { \ class = SCM_CLASS_OF (obj); \ - if (!SCM_FALSEP (SCM_OBJ_CLASS_REDEF (obj))) \ + if (scm_is_true (SCM_OBJ_CLASS_REDEF (obj))) \ { \ scm_change_object_class (obj, class, SCM_OBJ_CLASS_REDEF (obj));\ class = SCM_CLASS_OF (obj); \ @@ -182,7 +182,7 @@ filter_cpl (SCM ls) while (!SCM_NULLP (ls)) { SCM el = SCM_CAR (ls); - if (SCM_FALSEP (scm_c_memq (el, res))) + if (scm_is_false (scm_c_memq (el, res))) res = scm_cons (el, res); ls = SCM_CDR (ls); } @@ -221,7 +221,7 @@ remove_duplicate_slots (SCM l, SCM res, SCM slots_already_seen) if (!SCM_SYMBOLP (tmp)) scm_misc_error ("%compute-slots", "bad slot name ~S", scm_list_1 (tmp)); - if (SCM_FALSEP (scm_c_memq (tmp, slots_already_seen))) { + if (scm_is_false (scm_c_memq (tmp, slots_already_seen))) { res = scm_cons (SCM_CAR (l), res); slots_already_seen = scm_cons (tmp, slots_already_seen); } @@ -431,7 +431,7 @@ SCM_DEFINE (scm_sys_initialize_object, "%initialize-object", 2, 0, 0, { /* set slot to its :init-form if it exists */ tmp = SCM_CADAR (get_n_set); - if (!SCM_FALSEP (tmp)) + if (scm_is_true (tmp)) { slot_value = get_slot_value (class, obj, SCM_CAR (get_n_set)); if (SCM_GOOPS_UNBOUNDP (slot_value)) @@ -511,7 +511,7 @@ SCM_DEFINE (scm_sys_prep_layout_x, "%prep-layout!", 1, 0, 0, type = scm_i_get_keyword (k_class, SCM_CDAR (slots), len, SCM_BOOL_F, FUNC_NAME); /* determine slot GC protection and access mode */ - if (SCM_FALSEP (type)) + if (scm_is_false (type)) { p = 'p'; a = 'w'; @@ -822,7 +822,7 @@ SCM_DEFINE (scm_instance_p, "instance?", 1, 0, 0, "Return @code{#t} if @var{obj} is an instance.") #define FUNC_NAME s_scm_instance_p { - return SCM_BOOL (SCM_INSTANCEP (obj)); + return scm_from_bool (SCM_INSTANCEP (obj)); } #undef FUNC_NAME @@ -1160,7 +1160,7 @@ static SCM get_slot_value_using_name (SCM class, SCM obj, SCM slot_name) { SCM slotdef = slot_definition_using_name (class, slot_name); - if (!SCM_FALSEP (slotdef)) + if (scm_is_true (slotdef)) return get_slot_value (class, obj, slotdef); else return CALL_GF3 ("slot-missing", class, obj, slot_name); @@ -1201,7 +1201,7 @@ static SCM set_slot_value_using_name (SCM class, SCM obj, SCM slot_name, SCM value) { SCM slotdef = slot_definition_using_name (class, slot_name); - if (!SCM_FALSEP (slotdef)) + if (scm_is_true (slotdef)) return set_slot_value (class, obj, slotdef, value); else return CALL_GF4 ("slot-missing", class, obj, slot_name, value); @@ -1651,7 +1651,7 @@ SCM_DEFINE (scm_sys_invalidate_method_cache_x, "%invalidate-method-cache!", 1, 0 SCM used_by; SCM_ASSERT (SCM_PUREGENERICP (gf), gf, SCM_ARG1, FUNC_NAME); used_by = SCM_SLOT (gf, scm_si_used_by); - if (!SCM_FALSEP (used_by)) + if (scm_is_true (used_by)) { SCM methods = SCM_SLOT (gf, scm_si_methods); for (; SCM_CONSP (used_by); used_by = SCM_CDR (used_by)) @@ -1674,7 +1674,7 @@ SCM_DEFINE (scm_generic_capability_p, "generic-capability?", 1, 0, 0, "") #define FUNC_NAME s_scm_generic_capability_p { - SCM_ASSERT (!SCM_FALSEP (scm_procedure_p (proc)), + SCM_ASSERT (scm_is_true (scm_procedure_p (proc)), proc, SCM_ARG1, FUNC_NAME); return (scm_subr_p (proc) && SCM_SUBR_GENERIC (proc) ? SCM_BOOL_T @@ -1792,7 +1792,7 @@ static int applicablep (SCM actual, SCM formal) { /* We already know that the cpl is well formed. */ - return !SCM_FALSEP (scm_c_memq (formal, SCM_SLOT (actual, scm_si_cpl))); + return scm_is_true (scm_c_memq (formal, SCM_SLOT (actual, scm_si_cpl))); } static int @@ -2035,7 +2035,7 @@ call_memoize_method (void *a) * the cache miss and locking the mutex. */ SCM cmethod = scm_mcache_lookup_cmethod (x, SCM_CDDR (args)); - if (!SCM_FALSEP (cmethod)) + if (scm_is_true (cmethod)) return cmethod; /*fixme* Use scm_apply */ return CALL_GF3 ("memoize-method!", gf, SCM_CDDR (args), x); @@ -2101,7 +2101,7 @@ SCM_DEFINE (scm_make, "make", 0, 0, 1, if (class == scm_class_accessor) { SCM setter = scm_get_keyword (k_setter, args, SCM_BOOL_F); - if (!SCM_FALSEP (setter)) + if (scm_is_true (setter)) scm_sys_set_object_setter_x (z, setter); } } @@ -2217,7 +2217,7 @@ fix_cpl (SCM c, SCM before, SCM after) SCM cpl = SCM_SLOT (c, scm_si_cpl); SCM ls = scm_c_memq (after, cpl); SCM tail = scm_delq1_x (before, SCM_CDR (ls)); - if (SCM_FALSEP (ls)) + if (scm_is_false (ls)) /* if this condition occurs, fix_cpl should not be applied this way */ abort (); SCM_SETCAR (ls, before); @@ -2465,7 +2465,7 @@ make_class_from_template (char const *template, char const *type_name, SCM super /* Only define name if doesn't already exist. */ if (!SCM_GOOPS_UNBOUNDP (name) - && SCM_FALSEP (scm_call_2 (scm_goops_lookup_closure, name, SCM_BOOL_F))) + && scm_is_false (scm_call_2 (scm_goops_lookup_closure, name, SCM_BOOL_F))) DEFVAR (name, class); return class; } @@ -2490,7 +2490,7 @@ scm_i_inherit_applicable (SCM c) SCM cpl = SCM_SLOT (c, scm_si_cpl); /* patch scm_class_applicable into direct-supers */ SCM top = scm_c_memq (scm_class_top, dsupers); - if (SCM_FALSEP (top)) + if (scm_is_false (top)) dsupers = scm_append (scm_list_2 (dsupers, scm_list_1 (scm_class_applicable))); else @@ -2501,7 +2501,7 @@ scm_i_inherit_applicable (SCM c) SCM_SET_SLOT (c, scm_si_direct_supers, dsupers); /* patch scm_class_applicable into cpl */ top = scm_c_memq (scm_class_top, cpl); - if (SCM_FALSEP (top)) + if (scm_is_false (top)) abort (); else { @@ -2578,7 +2578,7 @@ static SCM make_struct_class (void *closure SCM_UNUSED, SCM vtable, SCM data, SCM prev SCM_UNUSED) { - if (!SCM_FALSEP (SCM_STRUCT_TABLE_NAME (data))) + if (scm_is_true (SCM_STRUCT_TABLE_NAME (data))) SCM_SET_STRUCT_TABLE_CLASS (data, scm_make_extended_class (SCM_SYMBOL_CHARS (SCM_STRUCT_TABLE_NAME (data)), @@ -2784,7 +2784,7 @@ SCM_DEFINE (scm_pure_generic_p, "pure-generic?", 1, 0, 0, "Return @code{#t} if @var{obj} is a pure generic.") #define FUNC_NAME s_scm_pure_generic_p { - return SCM_BOOL (SCM_PUREGENERICP (obj)); + return scm_from_bool (SCM_PUREGENERICP (obj)); } #undef FUNC_NAME diff --git a/libguile/goops.h b/libguile/goops.h index 710abb941..2130d7dbd 100644 --- a/libguile/goops.h +++ b/libguile/goops.h @@ -122,7 +122,7 @@ typedef struct scm_t_method { #define SCM_INSTANCE_HASH(c, i) (SCM_INST (c) [scm_si_hashsets + (i)]) #define SCM_SET_HASHSET(c, i, h) (SCM_INST (c) [scm_si_hashsets + (i)] = (h)) -#define SCM_SUBCLASSP(c1, c2) (!SCM_FALSEP (scm_c_memq (c2, SCM_SLOT (c1, scm_si_cpl)))) +#define SCM_SUBCLASSP(c1, c2) (scm_is_true (scm_c_memq (c2, SCM_SLOT (c1, scm_si_cpl)))) #define SCM_IS_A_P(x, c) \ (SCM_INSTANCEP (x) && SCM_SUBCLASSP (SCM_CLASS_OF (x), c)) diff --git a/libguile/guardians.c b/libguile/guardians.c index 7fe01af7b..01db7dfbb 100644 --- a/libguile/guardians.c +++ b/libguile/guardians.c @@ -209,7 +209,7 @@ guardian_apply (SCM guardian, SCM obj, SCM throw_p) return scm_guard (guardian, obj, (SCM_UNBNDP (throw_p) ? 1 - : !SCM_FALSEP (throw_p))); + : scm_is_true (throw_p))); else return scm_get_one_zombie (guardian); } @@ -229,7 +229,7 @@ scm_guard (SCM guardian, SCM obj, int throw_p) if (GREEDY_P (g)) { - if (!SCM_FALSEP (scm_hashq_get_handle + if (scm_is_true (scm_hashq_get_handle (greedily_guarded_whash, obj))) { SCM_ALLOW_INTS; @@ -268,7 +268,7 @@ scm_get_one_zombie (SCM guardian) if (!TCONC_EMPTYP (g->zombies)) TCONC_OUT (g->zombies, res); - if (!SCM_FALSEP (res) && GREEDY_P (g)) + if (scm_is_true (res) && GREEDY_P (g)) scm_hashq_remove_x (greedily_guarded_whash, res); SCM_ALLOW_INTS; @@ -319,7 +319,7 @@ SCM_DEFINE (scm_make_guardian, "make-guardian", 0, 1, 0, g->flags = 0L; /* [cmm] the UNBNDP check below is redundant but I like it. */ - if (SCM_UNBNDP (greedy_p) || !SCM_FALSEP (greedy_p)) + if (SCM_UNBNDP (greedy_p) || scm_is_true (greedy_p)) SET_GREEDY (g); SCM_NEWSMOB (z, tc16_guardian, g); @@ -339,7 +339,7 @@ SCM_DEFINE (scm_guardian_destroyed_p, "guardian-destroyed?", 1, 0, 0, /* This critical section barrier will be replaced by a mutex. */ SCM_DEFER_INTS; - res = SCM_BOOL (DESTROYED_P (GUARDIAN_DATA (guardian))); + res = scm_from_bool (DESTROYED_P (GUARDIAN_DATA (guardian))); SCM_ALLOW_INTS; @@ -352,7 +352,7 @@ SCM_DEFINE (scm_guardian_greedy_p, "guardian-greedy?", 1, 0, 0, "Return @code{#t} if @var{guardian} is a greedy guardian, otherwise @code{#f}.") #define FUNC_NAME s_scm_guardian_greedy_p { - return SCM_BOOL (GREEDY_P (GUARDIAN_DATA (guardian))); + return scm_from_bool (GREEDY_P (GUARDIAN_DATA (guardian))); } #undef FUNC_NAME diff --git a/libguile/hashtab.c b/libguile/hashtab.c index 44e99630a..ce077a397 100644 --- a/libguile/hashtab.c +++ b/libguile/hashtab.c @@ -389,7 +389,7 @@ SCM_DEFINE (scm_hash_table_p, "hash-table?", 1, 0, 0, "Return @code{#t} if @var{obj} is a hash table.") #define FUNC_NAME s_scm_hash_table_p { - return SCM_BOOL (SCM_HASHTABLE_P (obj)); + return scm_from_bool (SCM_HASHTABLE_P (obj)); } #undef FUNC_NAME @@ -403,7 +403,7 @@ SCM_DEFINE (scm_weak_key_hash_table_p, "weak-key-hash-table?", 1, 0, 0, "nor a weak value hash table.") #define FUNC_NAME s_scm_weak_key_hash_table_p { - return SCM_BOOL (SCM_HASHTABLE_P (obj) && SCM_HASHTABLE_WEAK_KEY_P (obj)); + return scm_from_bool (SCM_HASHTABLE_P (obj) && SCM_HASHTABLE_WEAK_KEY_P (obj)); } #undef FUNC_NAME @@ -413,7 +413,7 @@ SCM_DEFINE (scm_weak_value_hash_table_p, "weak-value-hash-table?", 1, 0, 0, "Return @code{#t} if @var{obj} is a weak value hash table.") #define FUNC_NAME s_scm_weak_value_hash_table_p { - return SCM_BOOL (SCM_HASHTABLE_P (obj) && SCM_HASHTABLE_WEAK_VALUE_P (obj)); + return scm_from_bool (SCM_HASHTABLE_P (obj) && SCM_HASHTABLE_WEAK_VALUE_P (obj)); } #undef FUNC_NAME @@ -423,7 +423,7 @@ SCM_DEFINE (scm_doubly_weak_hash_table_p, "doubly-weak-hash-table?", 1, 0, 0, "Return @code{#t} if @var{obj} is a doubly weak hash table.") #define FUNC_NAME s_scm_doubly_weak_hash_table_p { - return SCM_BOOL (SCM_HASHTABLE_P (obj) && SCM_HASHTABLE_DOUBLY_WEAK_P (obj)); + return scm_from_bool (SCM_HASHTABLE_P (obj) && SCM_HASHTABLE_DOUBLY_WEAK_P (obj)); } #undef FUNC_NAME @@ -473,7 +473,7 @@ scm_hash_fn_create_handle_x (SCM table, SCM obj, SCM init, unsigned long (*hash_ if (k >= SCM_VECTOR_LENGTH (buckets)) scm_out_of_range ("hash_fn_create_handle_x", scm_ulong2num (k)); it = assoc_fn (obj, SCM_VELTS (buckets)[k], closure); - if (!SCM_FALSEP (it)) + if (scm_is_true (it)) return it; else { @@ -542,7 +542,7 @@ scm_hash_fn_remove_x (SCM table, SCM obj, unsigned long (*hash_fn)(), SCM (*asso if (k >= SCM_VECTOR_LENGTH (buckets)) scm_out_of_range ("hash_fn_remove_x", scm_ulong2num (k)); h = assoc_fn (obj, SCM_VELTS (buckets)[k], closure); - if (!SCM_FALSEP (h)) + if (scm_is_true (h)) { SCM_VECTOR_SET (buckets, k, delete_fn (h, SCM_VELTS (buckets)[k])); if (table != buckets) diff --git a/libguile/hooks.c b/libguile/hooks.c index d94901cb9..0804d05ee 100644 --- a/libguile/hooks.c +++ b/libguile/hooks.c @@ -136,7 +136,7 @@ hook_print (SCM hook, SCM port, scm_print_state *pstate) { scm_putc (' ', port); name = scm_procedure_name (SCM_CAR (ls)); - if (!SCM_FALSEP (name)) + if (scm_is_true (name)) scm_iprin1 (name, port, pstate); else scm_putc ('?', port); @@ -177,7 +177,7 @@ SCM_DEFINE (scm_hook_p, "hook?", 1, 0, 0, "Return @code{#t} if @var{x} is a hook, @code{#f} otherwise.") #define FUNC_NAME s_scm_hook_p { - return SCM_BOOL (SCM_HOOKP (x)); + return scm_from_bool (SCM_HOOKP (x)); } #undef FUNC_NAME @@ -189,7 +189,7 @@ SCM_DEFINE (scm_hook_empty_p, "hook-empty?", 1, 0, 0, #define FUNC_NAME s_scm_hook_empty_p { SCM_VALIDATE_HOOK (1, hook); - return SCM_BOOL (SCM_NULLP (SCM_HOOK_PROCEDURES (hook))); + return scm_from_bool (SCM_NULLP (SCM_HOOK_PROCEDURES (hook))); } #undef FUNC_NAME @@ -205,17 +205,17 @@ SCM_DEFINE (scm_add_hook_x, "add-hook!", 2, 1, 0, SCM arity, rest; int n_args; SCM_VALIDATE_HOOK (1, hook); - SCM_ASSERT (!SCM_FALSEP (arity = scm_i_procedure_arity (proc)), + SCM_ASSERT (scm_is_true (arity = scm_i_procedure_arity (proc)), proc, SCM_ARG2, FUNC_NAME); n_args = SCM_HOOK_ARITY (hook); if (SCM_INUM (SCM_CAR (arity)) > n_args - || (SCM_FALSEP (SCM_CADDR (arity)) + || (scm_is_false (SCM_CADDR (arity)) && (SCM_INUM (SCM_CAR (arity)) + SCM_INUM (SCM_CADR (arity)) < n_args))) scm_wrong_type_arg (FUNC_NAME, 2, proc); rest = scm_delq_x (proc, SCM_HOOK_PROCEDURES (hook)); SCM_SET_HOOK_PROCEDURES (hook, - (!SCM_UNBNDP (append_p) && !SCM_FALSEP (append_p) + (!SCM_UNBNDP (append_p) && scm_is_true (append_p) ? scm_append_x (scm_list_2 (rest, scm_list_1 (proc))) : scm_cons (proc, rest))); return SCM_UNSPECIFIED; diff --git a/libguile/init.c b/libguile/init.c index f808c00cb..89f47ea9a 100644 --- a/libguile/init.c +++ b/libguile/init.c @@ -256,7 +256,7 @@ scm_standard_stream_to_port (int fdes, char *mode, char *name) body_data.name = name; port = scm_internal_catch (SCM_BOOL_T, stream_body, &body_data, stream_handler, NULL); - if (SCM_FALSEP (port)) + if (scm_is_false (port)) port = scm_void_port (mode); return port; } @@ -316,7 +316,7 @@ scm_load_startup_files () scm_primitive_load_path (scm_makfrom0str ("ice-9/boot-9.scm")); /* Load the init.scm file. */ - if (SCM_NFALSEP (init_path)) + if (scm_is_true (init_path)) scm_primitive_load (init_path); } } diff --git a/libguile/ioext.c b/libguile/ioext.c index 66e32cb91..59460afa7 100644 --- a/libguile/ioext.c +++ b/libguile/ioext.c @@ -204,7 +204,7 @@ SCM_DEFINE (scm_isatty_p, "isatty?", 1, 0, 0, return SCM_BOOL_F; rv = isatty (SCM_FPORT_FDES (port)); - return SCM_BOOL(rv); + return scm_from_bool(rv); } #undef FUNC_NAME diff --git a/libguile/keywords.c b/libguile/keywords.c index cea6c53b5..fb29bb081 100644 --- a/libguile/keywords.c +++ b/libguile/keywords.c @@ -58,7 +58,7 @@ SCM_DEFINE (scm_make_keyword_from_dash_symbol, "make-keyword-from-dash-symbol", SCM_DEFER_INTS; keyword = scm_hashq_ref (scm_keyword_obarray, symbol, SCM_BOOL_F); - if (SCM_FALSEP (keyword)) + if (scm_is_false (keyword)) { SCM_NEWSMOB (keyword, scm_tc16_keyword, SCM_UNPACK (symbol)); scm_hashq_set_x (scm_keyword_obarray, symbol, keyword); @@ -88,7 +88,7 @@ SCM_DEFINE (scm_keyword_p, "keyword?", 1, 0, 0, "@code{#f}.") #define FUNC_NAME s_scm_keyword_p { - return SCM_BOOL (SCM_KEYWORDP (obj)); + return scm_from_bool (SCM_KEYWORDP (obj)); } #undef FUNC_NAME diff --git a/libguile/list.c b/libguile/list.c index 213613712..74093427f 100644 --- a/libguile/list.c +++ b/libguile/list.c @@ -143,7 +143,7 @@ SCM_DEFINE (scm_null_p, "null?", 1, 0, 0, "Return @code{#t} iff @var{x} is the empty list, else @code{#f}.") #define FUNC_NAME s_scm_null_p { - return SCM_BOOL (SCM_NULL_OR_NIL_P (x)); + return scm_from_bool (SCM_NULL_OR_NIL_P (x)); } #undef FUNC_NAME @@ -153,7 +153,7 @@ SCM_DEFINE (scm_list_p, "list?", 1, 0, 0, "Return @code{#t} iff @var{x} is a proper list, else @code{#f}.") #define FUNC_NAME s_scm_list_p { - return SCM_BOOL (scm_ilength (x) >= 0); + return scm_from_bool (scm_ilength (x) >= 0); } #undef FUNC_NAME @@ -607,7 +607,7 @@ SCM_DEFINE (scm_memv, "memv", 2, 0, 0, SCM_VALIDATE_LIST (2, lst); for (; !SCM_NULL_OR_NIL_P (lst); lst = SCM_CDR (lst)) { - if (! SCM_FALSEP (scm_eqv_p (SCM_CAR (lst), x))) + if (! scm_is_false (scm_eqv_p (SCM_CAR (lst), x))) return lst; } return SCM_BOOL_F; @@ -628,7 +628,7 @@ SCM_DEFINE (scm_member, "member", 2, 0, 0, SCM_VALIDATE_LIST (2, lst); for (; !SCM_NULL_OR_NIL_P (lst); lst = SCM_CDR (lst)) { - if (! SCM_FALSEP (scm_equal_p (SCM_CAR (lst), x))) + if (! scm_is_false (scm_equal_p (SCM_CAR (lst), x))) return lst; } return SCM_BOOL_F; @@ -681,7 +681,7 @@ SCM_DEFINE (scm_delv_x, "delv!", 2, 0, 0, SCM_CONSP (walk); walk = SCM_CDR (walk)) { - if (! SCM_FALSEP (scm_eqv_p (SCM_CAR (walk), item))) + if (! scm_is_false (scm_eqv_p (SCM_CAR (walk), item))) *prev = SCM_CDR (walk); else prev = SCM_CDRLOC (walk); @@ -706,7 +706,7 @@ SCM_DEFINE (scm_delete_x, "delete!", 2, 0, 0, SCM_CONSP (walk); walk = SCM_CDR (walk)) { - if (! SCM_FALSEP (scm_equal_p (SCM_CAR (walk), item))) + if (! scm_is_false (scm_equal_p (SCM_CAR (walk), item))) *prev = SCM_CDR (walk); else prev = SCM_CDRLOC (walk); @@ -802,7 +802,7 @@ SCM_DEFINE (scm_delv1_x, "delv1!", 2, 0, 0, SCM_CONSP (walk); walk = SCM_CDR (walk)) { - if (! SCM_FALSEP (scm_eqv_p (SCM_CAR (walk), item))) + if (! scm_is_false (scm_eqv_p (SCM_CAR (walk), item))) { *prev = SCM_CDR (walk); break; @@ -830,7 +830,7 @@ SCM_DEFINE (scm_delete1_x, "delete1!", 2, 0, 0, SCM_CONSP (walk); walk = SCM_CDR (walk)) { - if (! SCM_FALSEP (scm_equal_p (SCM_CAR (walk), item))) + if (! scm_is_false (scm_equal_p (SCM_CAR (walk), item))) { *prev = SCM_CDR (walk); break; @@ -866,7 +866,7 @@ SCM_DEFINE (scm_filter, "filter", 2, 0, 0, SCM_CONSP (walk); walk = SCM_CDR (walk)) { - if (!SCM_FALSEP (call (pred, SCM_CAR (walk)))) + if (scm_is_true (call (pred, SCM_CAR (walk)))) { *prev = scm_cons (SCM_CAR (walk), SCM_EOL); prev = SCM_CDRLOC (*prev); @@ -892,7 +892,7 @@ SCM_DEFINE (scm_filter_x, "filter!", 2, 0, 0, SCM_CONSP (walk); walk = SCM_CDR (walk)) { - if (!SCM_FALSEP (call (pred, SCM_CAR (walk)))) + if (scm_is_true (call (pred, SCM_CAR (walk)))) prev = SCM_CDRLOC (walk); else *prev = SCM_CDR (walk); diff --git a/libguile/load.c b/libguile/load.c index 71715263b..74eaaca9b 100644 --- a/libguile/load.c +++ b/libguile/load.c @@ -93,11 +93,11 @@ SCM_DEFINE (scm_primitive_load, "primitive-load", 1, 0, 0, { SCM hook = *scm_loc_load_hook; SCM_VALIDATE_STRING (1, filename); - if (!SCM_FALSEP (hook) && !SCM_EQ_P (scm_procedure_p (hook), SCM_BOOL_T)) + if (scm_is_true (hook) && !SCM_EQ_P (scm_procedure_p (hook), SCM_BOOL_T)) SCM_MISC_ERROR ("value of %load-hook is neither a procedure nor #f", SCM_EOL); - if (! SCM_FALSEP (hook)) + if (! scm_is_false (hook)) scm_call_1 (hook, filename); { /* scope */ @@ -211,12 +211,12 @@ SCM_DEFINE (scm_parse_path, "parse-path", 1, 1, 0, "is returned.") #define FUNC_NAME s_scm_parse_path { - SCM_ASSERT (SCM_FALSEP (path) || (SCM_STRINGP (path)), + SCM_ASSERT (scm_is_false (path) || (SCM_STRINGP (path)), path, SCM_ARG1, FUNC_NAME); if (SCM_UNBNDP (tail)) tail = SCM_EOL; - return (SCM_FALSEP (path) + return (scm_is_false (path) ? tail : scm_internal_parse_path (SCM_STRING_CHARS (path), tail)); } @@ -451,7 +451,7 @@ SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 1, 0, 0, full_filename = scm_sys_search_load_path (filename); - if (SCM_FALSEP (full_filename)) + if (scm_is_false (full_filename)) { int absolute = (SCM_STRING_LENGTH (filename) >= 1 #ifdef __MINGW32__ diff --git a/libguile/macros.c b/libguile/macros.c index a7c695567..37d4782cf 100644 --- a/libguile/macros.c +++ b/libguile/macros.c @@ -38,8 +38,8 @@ macro_print (SCM macro, SCM port, scm_print_state *pstate) { SCM code = SCM_MACRO_CODE (macro); if (!SCM_CLOSUREP (code) - || SCM_FALSEP (scm_procedure_p (SCM_PRINT_CLOSURE)) - || SCM_FALSEP (scm_printer_apply (SCM_PRINT_CLOSURE, + || scm_is_false (scm_procedure_p (SCM_PRINT_CLOSURE)) + || scm_is_false (scm_printer_apply (SCM_PRINT_CLOSURE, macro, port, pstate))) { if (!SCM_CLOSUREP (code)) @@ -165,7 +165,7 @@ SCM_DEFINE (scm_macro_p, "macro?", 1, 0, 0, "syntax transformer.") #define FUNC_NAME s_scm_macro_p { - return SCM_BOOL (SCM_SMOB_PREDICATE (scm_tc16_macro, obj)); + return scm_from_bool (SCM_SMOB_PREDICATE (scm_tc16_macro, obj)); } #undef FUNC_NAME diff --git a/libguile/modules.c b/libguile/modules.c index 951ee413e..98f5b8ea6 100644 --- a/libguile/modules.c +++ b/libguile/modules.c @@ -219,7 +219,7 @@ scm_env_top_level (SCM env) while (SCM_CONSP (env)) { SCM car_env = SCM_CAR (env); - if (!SCM_CONSP (car_env) && !SCM_FALSEP (scm_procedure_p (car_env))) + if (!SCM_CONSP (car_env) && scm_is_true (scm_procedure_p (car_env))) return car_env; env = SCM_CDR (env); } @@ -242,14 +242,14 @@ the_root_module () SCM scm_lookup_closure_module (SCM proc) { - if (SCM_FALSEP (proc)) + if (scm_is_false (proc)) return the_root_module (); else if (SCM_EVAL_CLOSURE_P (proc)) return SCM_PACK (SCM_SMOB_DATA (proc)); else { SCM mod = scm_procedure_property (proc, sym_module); - if (SCM_FALSEP (mod)) + if (scm_is_false (mod)) mod = the_root_module (); return mod; } @@ -277,7 +277,7 @@ static SCM module_variable (SCM module, SCM sym) { #define SCM_BOUND_THING_P(b) \ - (!SCM_FALSEP (b)) + (scm_is_true (b)) /* 1. Check module obarray */ SCM b = scm_hashq_ref (SCM_MODULE_OBARRAY (module), sym, SCM_UNDEFINED); @@ -285,7 +285,7 @@ module_variable (SCM module, SCM sym) return b; { SCM binder = SCM_MODULE_BINDER (module); - if (!SCM_FALSEP (binder)) + if (scm_is_true (binder)) /* 2. Custom binder */ { b = scm_call_3 (binder, module, sym, SCM_BOOL_F); @@ -320,7 +320,7 @@ SCM scm_eval_closure_lookup (SCM eclo, SCM sym, SCM definep) { SCM module = SCM_PACK (SCM_SMOB_DATA (eclo)); - if (!SCM_FALSEP (definep)) + if (scm_is_true (definep)) { if (SCM_EVAL_CLOSURE_INTERFACE_P (eclo)) return SCM_BOOL_F; @@ -355,7 +355,7 @@ SCM_DEFINE (scm_standard_interface_eval_closure, SCM scm_module_lookup_closure (SCM module) { - if (SCM_FALSEP (module)) + if (scm_is_false (module)) return SCM_BOOL_F; else return SCM_MODULE_EVAL_CLOSURE (module); @@ -373,7 +373,7 @@ scm_current_module_lookup_closure () SCM scm_module_transformer (SCM module) { - if (SCM_FALSEP (module)) + if (scm_is_false (module)) return SCM_BOOL_F; else return SCM_MODULE_TRANSFORMER (module); @@ -393,7 +393,7 @@ SCM_DEFINE (scm_module_import_interface, "module-import-interface", 2, 0, 0, "") #define FUNC_NAME s_scm_module_import_interface { -#define SCM_BOUND_THING_P(b) (!SCM_FALSEP (b)) +#define SCM_BOUND_THING_P(b) (scm_is_true (b)) SCM uses; SCM_VALIDATE_MODULE (SCM_ARG1, module); /* Search the use list */ @@ -407,7 +407,7 @@ SCM_DEFINE (scm_module_import_interface, "module-import-interface", 2, 0, 0, return _interface; { SCM binder = SCM_MODULE_BINDER (_interface); - if (!SCM_FALSEP (binder)) + if (scm_is_true (binder)) /* 2. Custom binder */ { b = scm_call_3 (binder, _interface, sym, SCM_BOOL_F); @@ -417,7 +417,7 @@ SCM_DEFINE (scm_module_import_interface, "module-import-interface", 2, 0, 0, } /* 3. Search use list recursively. */ _interface = scm_module_import_interface (_interface, sym); - if (!SCM_FALSEP (_interface)) + if (scm_is_true (_interface)) return _interface; uses = SCM_CDR (uses); } @@ -460,14 +460,14 @@ scm_sym2var (SCM sym, SCM proc, SCM definep) { SCM handle; - if (SCM_FALSEP (definep)) + if (scm_is_false (definep)) var = scm_hashq_ref (scm_pre_modules_obarray, sym, SCM_BOOL_F); else { handle = scm_hashq_create_handle_x (scm_pre_modules_obarray, sym, SCM_BOOL_F); var = SCM_CDR (handle); - if (SCM_FALSEP (var)) + if (scm_is_false (var)) { var = scm_make_variable (SCM_UNDEFINED); SCM_SETCDR (handle, var); @@ -475,7 +475,7 @@ scm_sym2var (SCM sym, SCM proc, SCM definep) } } - if (!SCM_FALSEP (var) && !SCM_VARIABLEP (var)) + if (scm_is_true (var) && !SCM_VARIABLEP (var)) SCM_MISC_ERROR ("~S is not bound to a variable", scm_list_1 (sym)); return var; @@ -496,7 +496,7 @@ scm_module_lookup (SCM module, SCM sym) SCM_VALIDATE_MODULE (1, module); var = scm_sym2var (sym, scm_module_lookup_closure (module), SCM_BOOL_F); - if (SCM_FALSEP (var)) + if (scm_is_false (var)) SCM_MISC_ERROR ("unbound variable: ~S", scm_list_1 (sym)); return var; } @@ -513,7 +513,7 @@ scm_lookup (SCM sym) { SCM var = scm_sym2var (sym, scm_current_module_lookup_closure (), SCM_BOOL_F); - if (SCM_FALSEP (var)) + if (scm_is_false (var)) scm_misc_error ("scm_lookup", "unbound variable: ~S", scm_list_1 (sym)); return var; } @@ -559,7 +559,7 @@ scm_module_reverse_lookup (SCM module, SCM variable) SCM obarray; long i, n; - if (SCM_FALSEP (module)) + if (scm_is_false (module)) obarray = scm_pre_modules_obarray; else { @@ -593,7 +593,7 @@ scm_module_reverse_lookup (SCM module, SCM variable) while (SCM_CONSP (uses)) { SCM sym = scm_module_reverse_lookup (SCM_CAR (uses), variable); - if (!SCM_FALSEP (sym)) + if (scm_is_true (sym)) return sym; uses = SCM_CDR (uses); } @@ -620,9 +620,9 @@ SCM scm_system_module_env_p (SCM env) { SCM proc = scm_env_top_level (env); - if (SCM_FALSEP (proc)) + if (scm_is_false (proc)) return SCM_BOOL_T; - return ((!SCM_FALSEP (scm_procedure_property (proc, + return ((scm_is_true (scm_procedure_property (proc, scm_sym_system_module))) ? SCM_BOOL_T : SCM_BOOL_F); diff --git a/libguile/net_db.c b/libguile/net_db.c index 7ae33f037..35abb95f2 100644 --- a/libguile/net_db.c +++ b/libguile/net_db.c @@ -357,7 +357,7 @@ SCM_DEFINE (scm_sethost, "sethost", 0, 1, 0, if (SCM_UNBNDP (stayopen)) endhostent (); else - sethostent (!SCM_FALSEP (stayopen)); + sethostent (scm_is_true (stayopen)); return SCM_UNSPECIFIED; } #undef FUNC_NAME @@ -373,7 +373,7 @@ SCM_DEFINE (scm_setnet, "setnet", 0, 1, 0, if (SCM_UNBNDP (stayopen)) endnetent (); else - setnetent (!SCM_FALSEP (stayopen)); + setnetent (scm_is_true (stayopen)); return SCM_UNSPECIFIED; } #undef FUNC_NAME @@ -389,7 +389,7 @@ SCM_DEFINE (scm_setproto, "setproto", 0, 1, 0, if (SCM_UNBNDP (stayopen)) endprotoent (); else - setprotoent (!SCM_FALSEP (stayopen)); + setprotoent (scm_is_true (stayopen)); return SCM_UNSPECIFIED; } #undef FUNC_NAME @@ -405,7 +405,7 @@ SCM_DEFINE (scm_setserv, "setserv", 0, 1, 0, if (SCM_UNBNDP (stayopen)) endservent (); else - setservent (!SCM_FALSEP (stayopen)); + setservent (scm_is_true (stayopen)); return SCM_UNSPECIFIED; } #undef FUNC_NAME diff --git a/libguile/objects.c b/libguile/objects.c index f655470da..f999a4f37 100644 --- a/libguile/objects.c +++ b/libguile/objects.c @@ -71,7 +71,7 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0, case scm_tc3_imm24: if (SCM_CHARP (x)) return scm_class_char; - else if (SCM_BOOLP (x)) + else if (scm_is_bool (x)) return scm_class_boolean; else if (SCM_NULLP (x)) return scm_class_null; @@ -154,7 +154,7 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0, else if (SCM_OBJ_CLASS_FLAGS (x) & SCM_CLASSF_GOOPS) { /* Goops object */ - if (! SCM_FALSEP (SCM_OBJ_CLASS_REDEF (x))) + if (! scm_is_false (SCM_OBJ_CLASS_REDEF (x))) scm_change_object_class (x, SCM_CLASS_OF (x), /* old */ SCM_OBJ_CLASS_REDEF (x)); /* new */ @@ -164,12 +164,12 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0, { /* ordinary struct */ SCM handle = scm_struct_create_handle (SCM_STRUCT_VTABLE (x)); - if (!SCM_FALSEP (SCM_STRUCT_TABLE_CLASS (SCM_CDR (handle)))) + if (scm_is_true (SCM_STRUCT_TABLE_CLASS (SCM_CDR (handle)))) return SCM_STRUCT_TABLE_CLASS (SCM_CDR (handle)); else { SCM name = SCM_STRUCT_TABLE_NAME (SCM_CDR (handle)); - SCM class = scm_make_extended_class (!SCM_FALSEP (name) + SCM class = scm_make_extended_class (scm_is_true (name) ? SCM_SYMBOL_CHARS (name) : 0, SCM_I_OPERATORP (x)); @@ -297,7 +297,7 @@ SCM scm_mcache_compute_cmethod (SCM cache, SCM args) { SCM cmethod = scm_mcache_lookup_cmethod (cache, args); - if (SCM_FALSEP (cmethod)) + if (scm_is_false (cmethod)) /* No match - memoize */ return scm_memoize_method (cache, args); return cmethod; @@ -342,7 +342,7 @@ SCM_DEFINE (scm_entity_p, "entity?", 1, 0, 0, "Return @code{#t} if @var{obj} is an entity.") #define FUNC_NAME s_scm_entity_p { - return SCM_BOOL(SCM_STRUCTP (obj) && SCM_I_ENTITYP (obj)); + return scm_from_bool(SCM_STRUCTP (obj) && SCM_I_ENTITYP (obj)); } #undef FUNC_NAME @@ -351,7 +351,7 @@ SCM_DEFINE (scm_operator_p, "operator?", 1, 0, 0, "Return @code{#t} if @var{obj} is an operator.") #define FUNC_NAME s_scm_operator_p { - return SCM_BOOL(SCM_STRUCTP (obj) + return scm_from_bool(SCM_STRUCTP (obj) && SCM_I_OPERATORP (obj) && !SCM_I_ENTITYP (obj)); } diff --git a/libguile/options.c b/libguile/options.c index 115d074b0..02357e08e 100644 --- a/libguile/options.c +++ b/libguile/options.c @@ -239,7 +239,7 @@ scm_options (SCM args, scm_t_option options[], unsigned int n, const char *s) else { SCM old_setting; - SCM_ASSERT (!SCM_FALSEP (scm_list_p (args)), args, 1, s); + SCM_ASSERT (scm_is_true (scm_list_p (args)), args, 1, s); old_setting = get_option_setting (options, n); change_option_setting (args, options, n, s); return old_setting; diff --git a/libguile/pairs.c b/libguile/pairs.c index 8d6d36e9b..52abd6c7c 100644 --- a/libguile/pairs.c +++ b/libguile/pairs.c @@ -74,7 +74,7 @@ SCM_DEFINE (scm_pair_p, "pair?", 1, 0, 0, "@code{#f}.") #define FUNC_NAME s_scm_pair_p { - return SCM_BOOL (SCM_CONSP (x)); + return scm_from_bool (SCM_CONSP (x)); } #undef FUNC_NAME diff --git a/libguile/ports.c b/libguile/ports.c index d92aaaa4e..7da3c704f 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -262,7 +262,7 @@ SCM_DEFINE (scm_char_ready_p, "char-ready?", 0, 1, 0, scm_t_ptob_descriptor *ptob = &scm_ptobs[SCM_PTOBNUM (port)]; if (ptob->input_waiting) - return SCM_BOOL(ptob->input_waiting (port)); + return scm_from_bool(ptob->input_waiting (port)); else return SCM_BOOL_T; } @@ -749,7 +749,7 @@ SCM_DEFINE (scm_close_port, "close-port", 1, 0, 0, scm_remove_from_port_table (port); scm_mutex_unlock (&scm_i_port_table_mutex); SCM_CLR_PORT_OPEN_FLAG (port); - return SCM_BOOL (rv >= 0); + return scm_from_bool (rv >= 0); } #undef FUNC_NAME @@ -838,7 +838,7 @@ SCM_DEFINE (scm_input_port_p, "input-port?", 1, 0, 0, "@code{port?}.") #define FUNC_NAME s_scm_input_port_p { - return SCM_BOOL (SCM_INPUT_PORT_P (x)); + return scm_from_bool (SCM_INPUT_PORT_P (x)); } #undef FUNC_NAME @@ -850,7 +850,7 @@ SCM_DEFINE (scm_output_port_p, "output-port?", 1, 0, 0, #define FUNC_NAME s_scm_output_port_p { x = SCM_COERCE_OUTPORT (x); - return SCM_BOOL (SCM_OUTPUT_PORT_P (x)); + return scm_from_bool (SCM_OUTPUT_PORT_P (x)); } #undef FUNC_NAME @@ -861,7 +861,7 @@ SCM_DEFINE (scm_port_p, "port?", 1, 0, 0, "@var{x}))}.") #define FUNC_NAME s_scm_port_p { - return SCM_BOOL (SCM_PORTP (x)); + return scm_from_bool (SCM_PORTP (x)); } #undef FUNC_NAME @@ -872,7 +872,7 @@ SCM_DEFINE (scm_port_closed_p, "port-closed?", 1, 0, 0, #define FUNC_NAME s_scm_port_closed_p { SCM_VALIDATE_PORT (1, port); - return SCM_BOOL (!SCM_OPPORTP (port)); + return scm_from_bool (!SCM_OPPORTP (port)); } #undef FUNC_NAME @@ -882,7 +882,7 @@ SCM_DEFINE (scm_eof_object_p, "eof-object?", 1, 0, 0, "return @code{#f}.") #define FUNC_NAME s_scm_eof_object_p { - return SCM_BOOL(SCM_EOF_OBJECT_P (x)); + return scm_from_bool(SCM_EOF_OBJECT_P (x)); } #undef FUNC_NAME diff --git a/libguile/posix.c b/libguile/posix.c index 6a53599ba..b02098fef 100644 --- a/libguile/posix.c +++ b/libguile/posix.c @@ -310,7 +310,7 @@ SCM_DEFINE (scm_getpwuid, "getpw", 0, 1, 0, struct passwd *entry; SCM result = scm_c_make_vector (7, SCM_UNSPECIFIED); - if (SCM_UNBNDP (user) || SCM_FALSEP (user)) + if (SCM_UNBNDP (user) || scm_is_false (user)) { SCM_SYSCALL (entry = getpwent ()); if (! entry) @@ -357,7 +357,7 @@ SCM_DEFINE (scm_setpwent, "setpw", 0, 1, 0, "@code{endpwent} procedures are implemented on top of this.") #define FUNC_NAME s_scm_setpwent { - if (SCM_UNBNDP (arg) || SCM_FALSEP (arg)) + if (SCM_UNBNDP (arg) || scm_is_false (arg)) endpwent (); else setpwent (); @@ -379,7 +379,7 @@ SCM_DEFINE (scm_getgrgid, "getgr", 0, 1, 0, struct group *entry; SCM result = scm_c_make_vector (4, SCM_UNSPECIFIED); - if (SCM_UNBNDP (name) || SCM_FALSEP (name)) + if (SCM_UNBNDP (name) || scm_is_false (name)) { SCM_SYSCALL (entry = getgrent ()); if (! entry) @@ -414,7 +414,7 @@ SCM_DEFINE (scm_setgrent, "setgr", 0, 1, 0, "@code{endgrent} procedures are implemented on top of this.") #define FUNC_NAME s_scm_setgrent { - if (SCM_UNBNDP (arg) || SCM_FALSEP (arg)) + if (SCM_UNBNDP (arg) || scm_is_false (arg)) endgrent (); else setgrent (); @@ -1220,7 +1220,7 @@ SCM_DEFINE (scm_access, "access?", 2, 0, 0, SCM_VALIDATE_STRING (1, path); SCM_VALIDATE_INUM (2, how); rv = access (SCM_STRING_CHARS (path), SCM_INUM (how)); - return SCM_NEGATE_BOOL(rv); + return scm_from_bool (!rv); } #undef FUNC_NAME diff --git a/libguile/print.c b/libguile/print.c index 7586f2cc6..1974b318c 100644 --- a/libguile/print.c +++ b/libguile/print.c @@ -177,7 +177,7 @@ scm_make_print_state () } scm_i_plugin_mutex_unlock (&print_state_mutex); - return SCM_FALSEP (answer) ? make_print_state () : answer; + return scm_is_false (answer) ? make_print_state () : answer; } void @@ -286,7 +286,7 @@ scm_print_symbol_name (const char *str, size_t len, SCM port) if (len == 0 || str[0] == '\'' || str[0] == '`' || str[0] == ',' || str[0] == ':' || str[len-1] == ':' || (str[0] == '.' && len == 1) || - !SCM_FALSEP (scm_i_mem2number(str, len, 10))) + scm_is_true (scm_i_mem2number(str, len, 10))) { scm_lfwrite ("#{", 2, port); weird = 1; @@ -442,8 +442,8 @@ scm_iprin1 (SCM exp, SCM port, scm_print_state *pstate) print_circref (port, pstate, exp); break; case scm_tcs_closures: - if (SCM_FALSEP (scm_procedure_p (SCM_PRINT_CLOSURE)) - || SCM_FALSEP (scm_printer_apply (SCM_PRINT_CLOSURE, + if (scm_is_false (scm_procedure_p (SCM_PRINT_CLOSURE)) + || scm_is_false (scm_printer_apply (SCM_PRINT_CLOSURE, exp, port, pstate))) { SCM formals = SCM_CLOSURE_FORMALS (exp); @@ -603,7 +603,7 @@ scm_iprin1 (SCM exp, SCM port, scm_print_state *pstate) /* Print gsubrs as primitives */ SCM name = scm_procedure_name (exp); scm_puts ("#revealed) + if (scm_is_true (handle) && !pstate->revealed) { scm_i_plugin_mutex_lock (&print_state_mutex); SCM_SETCDR (handle, print_state_pool); @@ -920,7 +920,7 @@ SCM_DEFINE (scm_simple_format, "simple-format", 2, 0, 1, { destination = port = scm_cur_outp; } - else if (SCM_FALSEP (destination)) + else if (scm_is_false (destination)) { fReturnString = 1; port = scm_mkstrport (SCM_INUM0, diff --git a/libguile/procprop.c b/libguile/procprop.c index 4632182d6..5f30c30b2 100644 --- a/libguile/procprop.c +++ b/libguile/procprop.c @@ -130,7 +130,7 @@ scm_i_procedure_arity (SCM proc) default: return SCM_BOOL_F; } - return scm_list_3 (SCM_MAKINUM (a), SCM_MAKINUM (o), SCM_BOOL(r)); + return scm_list_3 (SCM_MAKINUM (a), SCM_MAKINUM (o), scm_from_bool(r)); } static SCM @@ -138,7 +138,7 @@ scm_stand_in_scm_proc(SCM proc) { SCM answer; answer = scm_assq (proc, scm_stand_in_procs); - if (SCM_FALSEP (answer)) + if (scm_is_false (answer)) { answer = scm_closure (scm_list_2 (SCM_EOL, SCM_BOOL_F), SCM_EOL); scm_stand_in_procs = scm_acons (proc, answer, scm_stand_in_procs); @@ -183,7 +183,7 @@ SCM_DEFINE (scm_procedure_property, "procedure-property", 2, 0, 0, if (SCM_EQ_P (k, scm_sym_arity)) { SCM arity; - SCM_ASSERT (SCM_NFALSEP (arity = scm_i_procedure_arity (p)), + SCM_ASSERT (scm_is_true (arity = scm_i_procedure_arity (p)), p, SCM_ARG1, FUNC_NAME); return arity; } diff --git a/libguile/procs.c b/libguile/procs.c index cc0ee2dac..68da589ac 100644 --- a/libguile/procs.c +++ b/libguile/procs.c @@ -176,7 +176,7 @@ SCM_DEFINE (scm_procedure_p, "procedure?", 1, 0, 0, case scm_tc7_pws: return SCM_BOOL_T; case scm_tc7_smob: - return SCM_BOOL (SCM_SMOB_DESCRIPTOR (obj).apply); + return scm_from_bool (SCM_SMOB_DESCRIPTOR (obj).apply); default: return SCM_BOOL_F; } @@ -189,7 +189,7 @@ SCM_DEFINE (scm_closure_p, "closure?", 1, 0, 0, "Return @code{#t} if @var{obj} is a closure.") #define FUNC_NAME s_scm_closure_p { - return SCM_BOOL (SCM_CLOSUREP (obj)); + return scm_from_bool (SCM_CLOSUREP (obj)); } #undef FUNC_NAME @@ -204,7 +204,7 @@ SCM_DEFINE (scm_thunk_p, "thunk?", 1, 0, 0, switch (SCM_TYP7 (obj)) { case scm_tcs_closures: - return SCM_BOOL (!SCM_CONSP (SCM_CLOSURE_FORMALS (obj))); + return scm_from_bool (!SCM_CONSP (SCM_CLOSURE_FORMALS (obj))); case scm_tc7_subr_0: case scm_tc7_subr_1o: case scm_tc7_lsubr: @@ -284,7 +284,7 @@ SCM_DEFINE (scm_procedure_with_setter_p, "procedure-with-setter?", 1, 0, 0, "associated setter procedure.") #define FUNC_NAME s_scm_procedure_with_setter_p { - return SCM_BOOL(SCM_PROCEDURE_WITH_SETTER_P (obj)); + return scm_from_bool(SCM_PROCEDURE_WITH_SETTER_P (obj)); } #undef FUNC_NAME diff --git a/libguile/properties.c b/libguile/properties.c index e94f1f213..ba0c2a437 100644 --- a/libguile/properties.c +++ b/libguile/properties.c @@ -64,19 +64,19 @@ SCM_DEFINE (scm_primitive_property_ref, "primitive-property-ref", 2, 0, 0, SCM_VALIDATE_CONS (SCM_ARG1, prop); h = scm_hashq_get_handle (scm_properties_whash, obj); - if (!SCM_FALSEP (h)) + if (scm_is_true (h)) { SCM assoc = scm_assq (prop, SCM_CDR (h)); - if (!SCM_FALSEP (assoc)) + if (scm_is_true (assoc)) return SCM_CDR (assoc); } - if (SCM_FALSEP (SCM_CAR (prop))) + if (scm_is_false (SCM_CAR (prop))) return SCM_BOOL_F; else { SCM val = scm_call_2 (SCM_CAR (prop), prop, obj); - if (SCM_FALSEP (h)) + if (scm_is_false (h)) h = scm_hashq_create_handle_x (scm_properties_whash, obj, SCM_EOL); SCM_SETCDR (h, scm_acons (prop, val, SCM_CDR (h))); return val; @@ -114,7 +114,7 @@ SCM_DEFINE (scm_primitive_property_del_x, "primitive-property-del!", 2, 0, 0, SCM h; SCM_VALIDATE_CONS (SCM_ARG1, prop); h = scm_hashq_get_handle (scm_properties_whash, obj); - if (!SCM_FALSEP (h)) + if (scm_is_true (h)) SCM_SETCDR (h, scm_assq_remove_x (SCM_CDR (h), prop)); return SCM_UNSPECIFIED; } diff --git a/libguile/ramap.c b/libguile/ramap.c index c8f194a12..8f057fc0c 100644 --- a/libguile/ramap.c +++ b/libguile/ramap.c @@ -486,7 +486,7 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore SCM_UNUSED) if (1 == inc && (n >= SCM_LONG_BIT || n == SCM_BITVECTOR_LENGTH (ra))) { i = base / SCM_LONG_BIT; - if (SCM_FALSEP (fill)) + if (scm_is_false (fill)) { if (base % SCM_LONG_BIT) /* leading partial word */ ve[i++] &= ~(~0L << (base % SCM_LONG_BIT)); @@ -509,7 +509,7 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore SCM_UNUSED) } else { - if (SCM_FALSEP (fill)) + if (scm_is_false (fill)) for (i = base; n--; i += inc) ve[i / SCM_LONG_BIT] &= ~(1L << (i % SCM_LONG_BIT)); else if (SCM_EQ_P (fill, SCM_BOOL_T)) @@ -837,7 +837,7 @@ scm_ra_eqp (SCM ra0, SCM ras) SCM e1 = SCM_UNDEFINED, e2 = SCM_UNDEFINED; for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2) if (SCM_BITVEC_REF (ra0, i0)) - if (SCM_FALSEP(scm_eq_p (RVREF (ra1, i1, e1), RVREF (ra2, i2, e2)))) + if (scm_is_false(scm_eq_p (RVREF (ra1, i1, e1), RVREF (ra2, i2, e2)))) SCM_BITVEC_CLR (ra0, i0); break; } @@ -897,8 +897,8 @@ ra_compare (SCM ra0, SCM ra1, SCM ra2, int opt) for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2) if (SCM_BITVEC_REF (ra0, i0)) if (opt ? - SCM_NFALSEP (scm_less_p (RVREF (ra1, i1, e1), RVREF (ra2, i2, e2))) : - SCM_FALSEP (scm_less_p (RVREF (ra1, i1, e1), RVREF (ra2, i2, e2)))) + scm_is_true (scm_less_p (RVREF (ra1, i1, e1), RVREF (ra2, i2, e2))) : + scm_is_false (scm_less_p (RVREF (ra1, i1, e1), RVREF (ra2, i2, e2)))) SCM_BITVEC_CLR (ra0, i0); break; } @@ -1323,7 +1323,7 @@ ramap_rp (SCM ra0, SCM proc, SCM ras) default: for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2) if (SCM_BITVEC_REF (ra0, i0)) - if (SCM_FALSEP (SCM_SUBRF (proc) (RVREF (ra1, i1, e1), RVREF (ra2, i2, e2)))) + if (scm_is_false (SCM_SUBRF (proc) (RVREF (ra1, i1, e1), RVREF (ra2, i2, e2)))) SCM_BITVEC_CLR (ra0, i0); break; case scm_tc7_uvect: @@ -1337,7 +1337,7 @@ ramap_rp (SCM ra0, SCM proc, SCM ras) */ SCM n1 = SCM_MAKINUM (((long *) SCM_UNPACK (SCM_CDR (ra1)))[i1]); SCM n2 = SCM_MAKINUM (((long *) SCM_UNPACK (SCM_CDR (ra2)))[i2]); - if (SCM_FALSEP (SCM_SUBRF (proc) (n1, n2))) + if (scm_is_false (SCM_SUBRF (proc) (n1, n2))) SCM_BITVEC_CLR (ra0, i0); } break; @@ -1349,7 +1349,7 @@ ramap_rp (SCM ra0, SCM proc, SCM ras) { SCM_REAL_VALUE (a1) = ((float *) SCM_VELTS (ra1))[i1]; SCM_REAL_VALUE (a2) = ((float *) SCM_VELTS (ra2))[i2]; - if (SCM_FALSEP (SCM_SUBRF (proc) (a1, a2))) + if (scm_is_false (SCM_SUBRF (proc) (a1, a2))) SCM_BITVEC_CLR (ra0, i0); } break; @@ -1363,7 +1363,7 @@ ramap_rp (SCM ra0, SCM proc, SCM ras) { SCM_REAL_VALUE (a1) = ((double *) SCM_VELTS (ra1))[i1]; SCM_REAL_VALUE (a2) = ((double *) SCM_VELTS (ra2))[i2]; - if (SCM_FALSEP (SCM_SUBRF (proc) (a1, a2))) + if (scm_is_false (SCM_SUBRF (proc) (a1, a2))) SCM_BITVEC_CLR (ra0, i0); } break; @@ -1379,7 +1379,7 @@ ramap_rp (SCM ra0, SCM proc, SCM ras) SCM_COMPLEX_IMAG (a1) = ((double *) SCM_VELTS (ra1))[2 * i1 + 1]; SCM_COMPLEX_REAL (a2) = ((double *) SCM_VELTS (ra2))[2 * i2]; SCM_COMPLEX_IMAG (a2) = ((double *) SCM_VELTS (ra2))[2 * i2 + 1]; - if (SCM_FALSEP (SCM_SUBRF (proc) (a1, a2))) + if (scm_is_false (SCM_SUBRF (proc) (a1, a2))) SCM_BITVEC_CLR (ra0, i0); } break; @@ -1518,7 +1518,7 @@ SCM_DEFINE (scm_array_map_x, "array-map!", 2, 0, 1, case scm_tc7_rpsubr: { ra_iproc *p; - if (SCM_FALSEP (scm_array_p (ra0, SCM_BOOL_T))) + if (scm_is_false (scm_array_p (ra0, SCM_BOOL_T))) goto gencase; scm_array_fill_x (ra0, SCM_BOOL_T); for (p = ra_rpsubrs; p->name; p++) @@ -1781,12 +1781,12 @@ raeql_1 (SCM ra0, SCM as_equal, SCM ra1) default: for (; n--; i0 += inc0, i1 += inc1) { - if (SCM_FALSEP (as_equal)) + if (scm_is_false (as_equal)) { - if (SCM_FALSEP (scm_array_equal_p (RVREF (ra0, i0, e0), RVREF (ra1, i1, e1)))) + if (scm_is_false (scm_array_equal_p (RVREF (ra0, i0, e0), RVREF (ra1, i1, e1)))) return 0; } - else if (SCM_FALSEP (scm_equal_p (RVREF (ra0, i0, e0), RVREF (ra1, i1, e1)))) + else if (scm_is_false (scm_equal_p (RVREF (ra0, i0, e0), RVREF (ra1, i1, e1)))) return 0; } return 1; @@ -1942,7 +1942,7 @@ raeql (SCM ra0, SCM as_equal, SCM ra1) SCM scm_raequal (SCM ra0, SCM ra1) { - return SCM_BOOL(raeql (ra0, SCM_BOOL_T, ra1)); + return scm_from_bool(raeql (ra0, SCM_BOOL_T, ra1)); } #if 0 @@ -2007,7 +2007,7 @@ scm_array_equal_p (SCM ra0, SCM ra1) if (!SCM_ARRAYP (ra1)) goto callequal; } - return SCM_BOOL(raeql (ra0, SCM_BOOL_F, ra1)); + return scm_from_bool(raeql (ra0, SCM_BOOL_F, ra1)); } diff --git a/libguile/rdelim.c b/libguile/rdelim.c index 6b0050c25..4e991539f 100644 --- a/libguile/rdelim.c +++ b/libguile/rdelim.c @@ -81,7 +81,7 @@ SCM_DEFINE (scm_read_delimited_x, "%read-delimited!", 3, 3, 0, { if (cdelims[k] == c) { - if (SCM_FALSEP (gobble)) + if (scm_is_false (gobble)) scm_ungetc (c, port); return scm_cons (SCM_MAKE_CHAR (c), diff --git a/libguile/read.c b/libguile/read.c index 0bf4533c0..ebaf1ed29 100644 --- a/libguile/read.c +++ b/libguile/read.c @@ -233,7 +233,7 @@ recsexpr (SCM obj, long line, int column, SCM filename) /* If this sexpr is visible in the read:sharp source, we want to keep that information, so only record non-constant cons cells which haven't previously been read by the reader. */ - if (SCM_FALSEP (scm_whash_lookup (scm_source_whash, obj))) + if (scm_is_false (scm_whash_lookup (scm_source_whash, obj))) { if (SCM_COPY_SOURCE_P) { @@ -381,7 +381,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy) /* Check for user-defined hash procedure first, to allow overriding of builtin hash read syntaxes. */ SCM sharp = scm_get_hash_procedure (c); - if (!SCM_FALSEP (sharp)) + if (scm_is_true (sharp)) { int line = SCM_LINUM (port); int column = SCM_COL (port) - 2; @@ -439,7 +439,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy) case '*': j = scm_read_token (c, tok_buf, port, 0); p = scm_istr2bve (SCM_STRING_CHARS (*tok_buf) + 1, (long) (j - 1)); - if (!SCM_FALSEP (p)) + if (scm_is_true (p)) return p; else goto unkshrp; @@ -482,7 +482,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy) { SCM sharp = scm_get_hash_procedure (c); - if (!SCM_FALSEP (sharp)) + if (scm_is_true (sharp)) { int line = SCM_LINUM (port); int column = SCM_COL (port) - 2; @@ -595,7 +595,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy) goto tok; p = scm_i_mem2number (SCM_STRING_CHARS (*tok_buf), j, 10); - if (!SCM_FALSEP (p)) + if (scm_is_true (p)) return p; if (c == '#') { @@ -858,7 +858,7 @@ SCM_DEFINE (scm_read_hash_extend, "read-hash-extend", 2, 0, 0, SCM prev; SCM_VALIDATE_CHAR (1, chr); - SCM_ASSERT (SCM_FALSEP (proc) + SCM_ASSERT (scm_is_false (proc) || SCM_EQ_P (scm_procedure_p (proc), SCM_BOOL_T), proc, SCM_ARG2, FUNC_NAME); @@ -870,7 +870,7 @@ SCM_DEFINE (scm_read_hash_extend, "read-hash-extend", 2, 0, 0, if (SCM_NULLP (this)) { /* not found, so add it to the beginning. */ - if (!SCM_FALSEP (proc)) + if (scm_is_true (proc)) { *scm_read_hash_procedures = scm_cons (scm_cons (chr, proc), *scm_read_hash_procedures); @@ -880,10 +880,10 @@ SCM_DEFINE (scm_read_hash_extend, "read-hash-extend", 2, 0, 0, if (SCM_EQ_P (chr, SCM_CAAR (this))) { /* already in the alist. */ - if (SCM_FALSEP (proc)) + if (scm_is_false (proc)) { /* remove it. */ - if (SCM_FALSEP (prev)) + if (scm_is_false (prev)) { *scm_read_hash_procedures = SCM_CDR (*scm_read_hash_procedures); diff --git a/libguile/regex-posix.c b/libguile/regex-posix.c index 91529183f..56616fced 100644 --- a/libguile/regex-posix.c +++ b/libguile/regex-posix.c @@ -116,7 +116,7 @@ SCM_DEFINE (scm_regexp_p, "regexp?", 1, 0, 0, "or @code{#f} otherwise.") #define FUNC_NAME s_scm_regexp_p { - return SCM_BOOL(SCM_RGXP (obj)); + return scm_from_bool(SCM_RGXP (obj)); } #undef FUNC_NAME diff --git a/libguile/scmsigs.c b/libguile/scmsigs.c index 0e554428e..296cd4e10 100644 --- a/libguile/scmsigs.c +++ b/libguile/scmsigs.c @@ -153,7 +153,7 @@ scm_delq_spine_x (SCM cell, SCM list) prev = s; s = SCM_CDR (s); } - if (SCM_FALSEP (prev)) + if (scm_is_false (prev)) return SCM_CDR (cell); else { @@ -184,7 +184,7 @@ really_install_handler (void *data) /* Make sure we have a cell. */ cell = SCM_VECTOR_REF (signal_handler_cells, signum); - if (SCM_FALSEP (cell)) + if (scm_is_false (cell)) { cell = scm_cons (SCM_BOOL_F, SCM_EOL); SCM_VECTOR_SET (signal_handler_cells, signum, cell); @@ -195,12 +195,12 @@ really_install_handler (void *data) if (!SCM_EQ_P (thread, old_thread)) { scm_root_state *r; - if (!SCM_FALSEP (old_thread)) + if (scm_is_true (old_thread)) { r = scm_i_thread_root (old_thread); r->signal_asyncs = scm_delq_spine_x (cell, r->signal_asyncs); } - if (!SCM_FALSEP (thread)) + if (scm_is_true (thread)) { r = scm_i_thread_root (thread); SCM_SETCDR (cell, r->signal_asyncs); @@ -214,7 +214,7 @@ really_install_handler (void *data) } /* Set the new handler. */ - if (SCM_FALSEP (handler)) + if (scm_is_false (handler)) { SCM_VECTOR_SET (*signal_handlers, signum, SCM_BOOL_F); SCM_VECTOR_SET (signal_cell_handlers, signum, SCM_BOOL_F); @@ -232,7 +232,7 @@ really_install_handler (void *data) following code will install the new handler, so we have no problem. */ - if (!SCM_FALSEP (SCM_CAR (cell))) + if (scm_is_true (SCM_CAR (cell))) SCM_SETCAR (cell, SCM_VECTOR_REF (signal_cell_handlers, signum)); /* Phfew. That should be it. */ @@ -346,7 +346,7 @@ SCM_DEFINE (scm_sigaction_for_thread, "sigaction", 1, 3, 0, else SCM_OUT_OF_RANGE (2, handler); } - else if (SCM_FALSEP (handler)) + else if (scm_is_false (handler)) { /* restore the default handler. */ #ifdef HAVE_SIGACTION diff --git a/libguile/script.c b/libguile/script.c index b56de0f8d..537faeaac 100644 --- a/libguile/script.c +++ b/libguile/script.c @@ -605,7 +605,7 @@ scm_compile_shell_switches (int argc, char **argv) scm_set_program_arguments (argc ? argc - i : 0, argv + i, argv0); /* If the --emacs switch was set, now is when we process it. */ - scm_c_define ("use-emacs-interface", SCM_BOOL (use_emacs_interface)); + scm_c_define ("use-emacs-interface", scm_from_bool (use_emacs_interface)); /* Handle the `-e' switch, if it was specified. */ if (!SCM_NULLP (entry_point)) diff --git a/libguile/simpos.c b/libguile/simpos.c index 356d78673..ee17fbd3e 100644 --- a/libguile/simpos.c +++ b/libguile/simpos.c @@ -68,7 +68,7 @@ SCM_DEFINE (scm_system, "system", 0, 1, 0, if (SCM_UNBNDP (cmd)) { rv = system (NULL); - return SCM_BOOL(rv); + return scm_from_bool(rv); } SCM_VALIDATE_STRING (1, cmd); errno = 0; diff --git a/libguile/sort.c b/libguile/sort.c index 7ef9a8873..cf4c885ad 100644 --- a/libguile/sort.c +++ b/libguile/sort.c @@ -135,13 +135,13 @@ quicksort (SCM *const base_ptr, size_t nr_elems, scm_t_trampoline_2 cmp, SCM les size_t mid = lo + (hi - lo) / 2; - if (!SCM_FALSEP ((*cmp) (less, base_ptr[mid], base_ptr[lo]))) + if (scm_is_true ((*cmp) (less, base_ptr[mid], base_ptr[lo]))) SWAP (base_ptr[mid], base_ptr[lo]); - if (!SCM_FALSEP ((*cmp) (less, base_ptr[hi], base_ptr[mid]))) + if (scm_is_true ((*cmp) (less, base_ptr[hi], base_ptr[mid]))) SWAP (base_ptr[mid], base_ptr[hi]); else goto jump_over; - if (!SCM_FALSEP ((*cmp) (less, base_ptr[mid], base_ptr[lo]))) + if (scm_is_true ((*cmp) (less, base_ptr[mid], base_ptr[lo]))) SWAP (base_ptr[mid], base_ptr[lo]); jump_over:; @@ -153,7 +153,7 @@ quicksort (SCM *const base_ptr, size_t nr_elems, scm_t_trampoline_2 cmp, SCM les that this algorithm runs much faster than others. */ do { - while (!SCM_FALSEP ((*cmp) (less, base_ptr[left], base_ptr[mid]))) + while (scm_is_true ((*cmp) (less, base_ptr[left], base_ptr[mid]))) { left++; /* The comparison predicate may be buggy */ @@ -161,7 +161,7 @@ quicksort (SCM *const base_ptr, size_t nr_elems, scm_t_trampoline_2 cmp, SCM les scm_misc_error (NULL, s_buggy_less, SCM_EOL); } - while (!SCM_FALSEP ((*cmp) (less, base_ptr[mid], base_ptr[right]))) + while (scm_is_true ((*cmp) (less, base_ptr[mid], base_ptr[right]))) { right--; /* The comparison predicate may be buggy */ @@ -233,7 +233,7 @@ quicksort (SCM *const base_ptr, size_t nr_elems, scm_t_trampoline_2 cmp, SCM les and the operation speeds up insertion sort's inner loop. */ for (run = tmp + 1; run <= thresh; run++) - if (!SCM_FALSEP ((*cmp) (less, base_ptr[run], base_ptr[tmp]))) + if (scm_is_true ((*cmp) (less, base_ptr[run], base_ptr[tmp]))) tmp = run; if (tmp != 0) @@ -245,7 +245,7 @@ quicksort (SCM *const base_ptr, size_t nr_elems, scm_t_trampoline_2 cmp, SCM les while (++run <= end) { tmp = run - 1; - while (!SCM_FALSEP ((*cmp) (less, base_ptr[run], base_ptr[tmp]))) + while (scm_is_true ((*cmp) (less, base_ptr[run], base_ptr[tmp]))) { /* The comparison predicate may be buggy */ if (tmp == 0) @@ -343,7 +343,7 @@ SCM_DEFINE (scm_sorted_p, "sorted?", 2, 0, 0, j = len - 1; while (j > 0) { - if (!SCM_FALSEP ((*cmp) (less, SCM_CAR (rest), item))) + if (scm_is_true ((*cmp) (less, SCM_CAR (rest), item))) return SCM_BOOL_F; else { @@ -363,7 +363,7 @@ SCM_DEFINE (scm_sorted_p, "sorted?", 2, 0, 0, j = len - 1; while (j > 0) { - if (!SCM_FALSEP ((*cmp) (less, vp[1], vp[0]))) + if (scm_is_true ((*cmp) (less, vp[1], vp[0]))) return SCM_BOOL_F; else { @@ -409,7 +409,7 @@ SCM_DEFINE (scm_merge, "merge", 3, 0, 0, SCM_VALIDATE_NONEMPTYLIST_COPYLEN (1, alist, alen); SCM_VALIDATE_NONEMPTYLIST_COPYLEN (2, blist, blen); - if (!SCM_FALSEP ((*cmp) (less, SCM_CAR (blist), SCM_CAR (alist)))) + if (scm_is_true ((*cmp) (less, SCM_CAR (blist), SCM_CAR (alist)))) { build = scm_cons (SCM_CAR (blist), SCM_EOL); blist = SCM_CDR (blist); @@ -424,7 +424,7 @@ SCM_DEFINE (scm_merge, "merge", 3, 0, 0, last = build; while ((alen > 0) && (blen > 0)) { - if (!SCM_FALSEP ((*cmp) (less, SCM_CAR (blist), SCM_CAR (alist)))) + if (scm_is_true ((*cmp) (less, SCM_CAR (blist), SCM_CAR (alist)))) { SCM_SETCDR (last, scm_cons (SCM_CAR (blist), SCM_EOL)); blist = SCM_CDR (blist); @@ -461,7 +461,7 @@ scm_merge_list_x (SCM alist, SCM blist, return alist; else { - if (!SCM_FALSEP ((*cmp) (less, SCM_CAR (blist), SCM_CAR (alist)))) + if (scm_is_true ((*cmp) (less, SCM_CAR (blist), SCM_CAR (alist)))) { build = blist; blist = SCM_CDR (blist); @@ -476,7 +476,7 @@ scm_merge_list_x (SCM alist, SCM blist, last = build; while ((alen > 0) && (blen > 0)) { - if (!SCM_FALSEP ((*cmp) (less, SCM_CAR (blist), SCM_CAR (alist)))) + if (scm_is_true ((*cmp) (less, SCM_CAR (blist), SCM_CAR (alist)))) { SCM_SETCDR (last, blist); blist = SCM_CDR (blist); @@ -551,7 +551,7 @@ scm_merge_list_step (SCM * seq, scm_t_trampoline_2 cmp, SCM less, long n) SCM y = SCM_CAR (SCM_CDR (*seq)); *seq = SCM_CDR (rest); SCM_SETCDR (rest, SCM_EOL); - if (!SCM_FALSEP ((*cmp) (less, y, x))) + if (scm_is_true ((*cmp) (less, y, x))) { SCM_SETCAR (p, y); SCM_SETCAR (rest, x); @@ -668,7 +668,7 @@ scm_merge_vector_x (SCM vec, */ register SCM *vp = SCM_WRITABLE_VELTS(vec); - if (!SCM_FALSEP ((*cmp) (less, vp[i2], vp[i1]))) + if (scm_is_true ((*cmp) (less, vp[i2], vp[i1]))) temp[it] = vp[i2++]; else temp[it] = vp[i1++]; diff --git a/libguile/srcprop.c b/libguile/srcprop.c index 7eee11f1c..0c74f84bd 100644 --- a/libguile/srcprop.c +++ b/libguile/srcprop.c @@ -143,7 +143,7 @@ scm_srcprops_to_plist (SCM obj) plist = scm_acons (scm_sym_filename, SRCPROPFNAME (obj), plist); plist = scm_acons (scm_sym_column, SCM_MAKINUM (SRCPROPCOL (obj)), plist); plist = scm_acons (scm_sym_line, SCM_MAKINUM (SRCPROPLINE (obj)), plist); - plist = scm_acons (scm_sym_breakpoint, SCM_BOOL (SRCPROPBRK (obj)), plist); + plist = scm_acons (scm_sym_breakpoint, scm_from_bool (SRCPROPBRK (obj)), plist); return plist; } @@ -202,7 +202,7 @@ SCM_DEFINE (scm_source_property, "source-property", 2, 0, 0, p = scm_hashq_ref (scm_source_whash, obj, SCM_EOL); if (!SRCPROPSP (p)) goto plist; - if (SCM_EQ_P (scm_sym_breakpoint, key)) p = SCM_BOOL (SRCPROPBRK (p)); + if (SCM_EQ_P (scm_sym_breakpoint, key)) p = scm_from_bool (SRCPROPBRK (p)); else if (SCM_EQ_P (scm_sym_line, key)) p = SCM_MAKINUM (SRCPROPLINE (p)); else if (SCM_EQ_P (scm_sym_column, key)) p = SCM_MAKINUM (SRCPROPCOL (p)); else if (SCM_EQ_P (scm_sym_filename, key)) p = SRCPROPFNAME (p); @@ -243,7 +243,7 @@ SCM_DEFINE (scm_set_source_property_x, "set-source-property!", 3, 0, 0, { if (SRCPROPSP (p)) { - if (SCM_FALSEP (datum)) + if (scm_is_false (datum)) CLEARSRCPROPBRK (p); else SETSRCPROPBRK (p); @@ -252,7 +252,7 @@ SCM_DEFINE (scm_set_source_property_x, "set-source-property!", 3, 0, 0, { SCM sp = scm_make_srcprops (0, 0, SCM_UNDEFINED, SCM_UNDEFINED, p); SCM_WHASHSET (scm_source_whash, h, sp); - if (SCM_FALSEP (datum)) + if (scm_is_false (datum)) CLEARSRCPROPBRK (sp); else SETSRCPROPBRK (sp); diff --git a/libguile/srcprop.h b/libguile/srcprop.h index bd6918bf4..47c05ffb2 100644 --- a/libguile/srcprop.h +++ b/libguile/srcprop.h @@ -35,7 +35,7 @@ #define scm_whash_handle SCM #define scm_whash_get_handle(whash, key) scm_hash_fn_get_handle (whash, key, scm_ihashq, scm_sloppy_assq, 0) -#define SCM_WHASHFOUNDP(h) (!SCM_FALSEP (h)) +#define SCM_WHASHFOUNDP(h) (scm_is_true (h)) #define SCM_WHASHREF(whash, handle) SCM_CDR (handle) #define SCM_WHASHSET(whash, handle, obj) SCM_SETCDR (handle, obj) #define scm_whash_create_handle(whash, key) scm_hash_fn_create_handle_x (whash, key, SCM_UNSPECIFIED, scm_ihashq, scm_sloppy_assq, 0) @@ -88,7 +88,7 @@ typedef struct scm_t_srcprops_chunk #define SETSRCPROPLINE(p, l) SETSRCPROPPOS (p, l, SRCPROPCOL (p)) #define SETSRCPROPCOL(p, c) SETSRCPROPPOS (p, SRCPROPLINE (p), c) -#define PROCTRACEP(x) (!SCM_FALSEP (scm_procedure_property (x, scm_sym_trace))) +#define PROCTRACEP(x) (scm_is_true (scm_procedure_property (x, scm_sym_trace))) SCM_API SCM scm_sym_filename; SCM_API SCM scm_sym_copy; diff --git a/libguile/stacks.c b/libguile/stacks.c index 6db780f46..d6a8ad838 100644 --- a/libguile/stacks.c +++ b/libguile/stacks.c @@ -205,7 +205,7 @@ do { \ && SCM_EQ_P (SCM_MEMOIZED_EXP (iframe->source), applybody)) \ { \ iframe->source = SCM_BOOL_F; \ - if (SCM_FALSEP (iframe->proc)) \ + if (scm_is_false (iframe->proc)) \ { \ --iframe; \ ++n; \ @@ -332,7 +332,7 @@ narrow_stack (SCM stack, long inner, SCM inner_key, long outer, SCM outer_key) SCM m = s->frames[i].source; if (SCM_MEMOIZEDP (m) && !SCM_IMP (SCM_MEMOIZED_ENV (m)) - && SCM_FALSEP (scm_system_module_env_p (SCM_MEMOIZED_ENV (m)))) + && scm_is_false (scm_system_module_env_p (SCM_MEMOIZED_ENV (m)))) { /* Back up in order to include any non-source frames */ while (i > 0) @@ -342,8 +342,8 @@ narrow_stack (SCM stack, long inner, SCM inner_key, long outer, SCM outer_key) break; m = s->frames[i - 1].proc; - if (!SCM_FALSEP (scm_procedure_p (m)) - && !SCM_FALSEP (scm_procedure_property + if (scm_is_true (scm_procedure_p (m)) + && scm_is_true (scm_procedure_property (m, scm_sym_system_procedure))) break; @@ -384,7 +384,7 @@ SCM_DEFINE (scm_stack_p, "stack?", 1, 0, 0, "Return @code{#t} if @var{obj} is a calling stack.") #define FUNC_NAME s_scm_stack_p { - return SCM_BOOL(SCM_STACKP (obj)); + return scm_from_bool(SCM_STACKP (obj)); } #undef FUNC_NAME @@ -577,7 +577,7 @@ SCM_DEFINE (scm_frame_p, "frame?", 1, 0, 0, "Return @code{#t} if @var{obj} is a stack frame.") #define FUNC_NAME s_scm_frame_p { - return SCM_BOOL(SCM_FRAMEP (obj)); + return scm_from_bool(SCM_FRAMEP (obj)); } #undef FUNC_NAME @@ -706,7 +706,7 @@ SCM_DEFINE (scm_frame_real_p, "frame-real?", 1, 0, 0, #define FUNC_NAME s_scm_frame_real_p { SCM_VALIDATE_FRAME (1, frame); - return SCM_BOOL(SCM_FRAME_REAL_P (frame)); + return scm_from_bool(SCM_FRAME_REAL_P (frame)); } #undef FUNC_NAME @@ -716,7 +716,7 @@ SCM_DEFINE (scm_frame_procedure_p, "frame-procedure?", 1, 0, 0, #define FUNC_NAME s_scm_frame_procedure_p { SCM_VALIDATE_FRAME (1, frame); - return SCM_BOOL(SCM_FRAME_PROC_P (frame)); + return scm_from_bool(SCM_FRAME_PROC_P (frame)); } #undef FUNC_NAME @@ -726,7 +726,7 @@ SCM_DEFINE (scm_frame_evaluating_args_p, "frame-evaluating-args?", 1, 0, 0, #define FUNC_NAME s_scm_frame_evaluating_args_p { SCM_VALIDATE_FRAME (1, frame); - return SCM_BOOL(SCM_FRAME_EVAL_ARGS_P (frame)); + return scm_from_bool(SCM_FRAME_EVAL_ARGS_P (frame)); } #undef FUNC_NAME @@ -736,7 +736,7 @@ SCM_DEFINE (scm_frame_overflow_p, "frame-overflow?", 1, 0, 0, #define FUNC_NAME s_scm_frame_overflow_p { SCM_VALIDATE_FRAME (1, frame); - return SCM_BOOL(SCM_FRAME_OVERFLOW_P (frame)); + return scm_from_bool(SCM_FRAME_OVERFLOW_P (frame)); } #undef FUNC_NAME diff --git a/libguile/stime.c b/libguile/stime.c index 568f577c2..1b6d5331e 100644 --- a/libguile/stime.c +++ b/libguile/stime.c @@ -457,7 +457,7 @@ bdtime2c (SCM sbd_time, struct tm *lt, int pos, const char *subr) { SCM_ASSERT (SCM_INUMP (velts[i]), sbd_time, pos, subr); } - SCM_ASSERT (SCM_FALSEP (velts[10]) || SCM_STRINGP (velts[10]), + SCM_ASSERT (scm_is_false (velts[10]) || SCM_STRINGP (velts[10]), sbd_time, pos, subr); lt->tm_sec = SCM_INUM (velts[0]); @@ -471,7 +471,7 @@ bdtime2c (SCM sbd_time, struct tm *lt, int pos, const char *subr) lt->tm_isdst = SCM_INUM (velts[8]); #ifdef HAVE_TM_ZONE lt->tm_gmtoff = SCM_INUM (velts[9]); - if (SCM_FALSEP (velts[10])) + if (scm_is_false (velts[10])) lt->tm_zone = NULL; else lt->tm_zone = SCM_STRING_CHARS (velts[10]); @@ -619,7 +619,7 @@ SCM_DEFINE (scm_strftime, "strftime", 2, 0, 0, SCM *velts = (SCM *) SCM_VELTS (stime); int have_zone = 0; - if (!SCM_FALSEP (velts[10]) && *SCM_STRING_CHARS (velts[10]) != 0) + if (scm_is_true (velts[10]) && *SCM_STRING_CHARS (velts[10]) != 0) { /* it's not required that the TZ setting be correct, just that it has the right name. so try something like TZ=EST0. diff --git a/libguile/strings.c b/libguile/strings.c index d38959413..8bde1bd09 100644 --- a/libguile/strings.c +++ b/libguile/strings.c @@ -37,7 +37,7 @@ SCM_DEFINE (scm_string_p, "string?", 1, 0, 0, "Return @code{#t} if @var{obj} is a string, else @code{#f}.") #define FUNC_NAME s_scm_string_p { - return SCM_BOOL (SCM_STRINGP (obj)); + return scm_from_bool (SCM_STRINGP (obj)); } #undef FUNC_NAME diff --git a/libguile/strop.c b/libguile/strop.c index cb844a3a2..8950a482d 100644 --- a/libguile/strop.c +++ b/libguile/strop.c @@ -60,7 +60,7 @@ scm_i_index (SCM *str, SCM chr, int direction, SCM sub_start, SCM_ASSERT (SCM_STRINGP (*str), *str, SCM_ARG1, why); SCM_ASSERT (SCM_CHARP (chr), chr, SCM_ARG2, why); - if (SCM_FALSEP (sub_start)) + if (scm_is_false (sub_start)) sub_start = SCM_MAKINUM (0); SCM_ASSERT (SCM_INUMP (sub_start), sub_start, SCM_ARG3, why); @@ -68,7 +68,7 @@ scm_i_index (SCM *str, SCM chr, int direction, SCM sub_start, if (lower < 0 || lower > SCM_STRING_LENGTH (*str)) scm_out_of_range (why, sub_start); - if (SCM_FALSEP (sub_end)) + if (scm_is_false (sub_end)) sub_end = SCM_MAKINUM (SCM_STRING_LENGTH (*str)); SCM_ASSERT (SCM_INUMP (sub_end), sub_end, SCM_ARG4, why); @@ -227,7 +227,7 @@ SCM_DEFINE (scm_string_null_p, "string-null?", 1, 0, 0, #define FUNC_NAME s_scm_string_null_p { SCM_VALIDATE_STRING (1, str); - return SCM_BOOL (SCM_STRING_LENGTH (str) == 0); + return scm_from_bool (SCM_STRING_LENGTH (str) == 0); } #undef FUNC_NAME @@ -394,7 +394,7 @@ string_capitalize_x (SCM str) len = SCM_STRING_LENGTH(str); sz = SCM_STRING_UCHARS (str); for(i=0; i 0) return SCM_BOOL_F; } - return SCM_BOOL (length1 < length2); + return scm_from_bool (length1 < length2); } @@ -147,7 +147,7 @@ SCM_DEFINE1 (scm_string_leq_p, "string<=?", scm_tc7_rpsubr, SCM_VALIDATE_STRING (1, s1); SCM_VALIDATE_STRING (2, s2); - return SCM_BOOL_NOT (string_less_p (s2, s1)); + return scm_not (string_less_p (s2, s1)); } #undef FUNC_NAME @@ -175,7 +175,7 @@ SCM_DEFINE1 (scm_string_geq_p, "string>=?", scm_tc7_rpsubr, SCM_VALIDATE_STRING (1, s1); SCM_VALIDATE_STRING (2, s2); - return SCM_BOOL_NOT (string_less_p (s1, s2)); + return scm_not (string_less_p (s1, s2)); } #undef FUNC_NAME @@ -200,7 +200,7 @@ string_ci_less_p (SCM s1, SCM s2) if (c > 0) return SCM_BOOL_F; } - return SCM_BOOL (length1 < length2); + return scm_from_bool (length1 < length2); } @@ -229,7 +229,7 @@ SCM_DEFINE1 (scm_string_ci_leq_p, "string-ci<=?", scm_tc7_rpsubr, SCM_VALIDATE_STRING (1, s1); SCM_VALIDATE_STRING (2, s2); - return SCM_BOOL_NOT (string_ci_less_p (s2, s1)); + return scm_not (string_ci_less_p (s2, s1)); } #undef FUNC_NAME @@ -259,7 +259,7 @@ SCM_DEFINE1 (scm_string_ci_geq_p, "string-ci>=?", scm_tc7_rpsubr, SCM_VALIDATE_STRING (1, s1); SCM_VALIDATE_STRING (2, s2); - return SCM_BOOL_NOT (string_ci_less_p (s1, s2)); + return scm_not (string_ci_less_p (s1, s2)); } #undef FUNC_NAME diff --git a/libguile/struct.c b/libguile/struct.c index b41fd1e08..5a4fe9cbe 100644 --- a/libguile/struct.c +++ b/libguile/struct.c @@ -222,7 +222,7 @@ SCM_DEFINE (scm_struct_p, "struct?", 1, 0, 0, "@code{#f}.") #define FUNC_NAME s_scm_struct_p { - return SCM_BOOL(SCM_STRUCTP (x)); + return scm_from_bool(SCM_STRUCTP (x)); } #undef FUNC_NAME @@ -248,7 +248,7 @@ SCM_DEFINE (scm_struct_vtable_p, "struct-vtable?", 1, 0, 0, mem = SCM_STRUCT_DATA (x); - return SCM_BOOL (SCM_SYMBOLP (SCM_PACK (mem[scm_vtable_index_layout]))); + return scm_from_bool (SCM_SYMBOLP (SCM_PACK (mem[scm_vtable_index_layout]))); } #undef FUNC_NAME @@ -726,7 +726,7 @@ scm_struct_create_handle (SCM obj) scm_struct_ihashq, scm_sloppy_assq, 0); - if (SCM_FALSEP (SCM_CDR (handle))) + if (scm_is_false (SCM_CDR (handle))) SCM_SETCDR (handle, scm_cons (SCM_BOOL_F, SCM_BOOL_F)); return handle; } @@ -760,14 +760,14 @@ SCM_DEFINE (scm_set_struct_vtable_name_x, "set-struct-vtable-name!", 2, 0, 0, void scm_print_struct (SCM exp, SCM port, scm_print_state *pstate) { - if (SCM_NFALSEP (scm_procedure_p (SCM_STRUCT_PRINTER (exp)))) + if (scm_is_true (scm_procedure_p (SCM_STRUCT_PRINTER (exp)))) scm_printer_apply (SCM_STRUCT_PRINTER (exp), exp, port, pstate); else { SCM vtable = SCM_STRUCT_VTABLE (exp); SCM name = scm_struct_vtable_name (vtable); scm_puts ("#<", port); - if (SCM_NFALSEP (name)) + if (scm_is_true (name)) scm_display (name, port); else scm_puts ("struct", port); diff --git a/libguile/symbols.c b/libguile/symbols.c index c84030179..d76888fe0 100644 --- a/libguile/symbols.c +++ b/libguile/symbols.c @@ -162,7 +162,7 @@ SCM_DEFINE (scm_symbol_p, "symbol?", 1, 0, 0, "@code{#f}.") #define FUNC_NAME s_scm_symbol_p { - return SCM_BOOL (SCM_SYMBOLP (obj)); + return scm_from_bool (SCM_SYMBOLP (obj)); } #undef FUNC_NAME @@ -173,7 +173,7 @@ SCM_DEFINE (scm_symbol_interned_p, "symbol-interned?", 1, 0, 0, #define FUNC_NAME s_scm_symbol_interned_p { SCM_VALIDATE_SYMBOL (1, symbol); - return SCM_BOOL (SCM_SYMBOL_INTERNED_P (symbol)); + return scm_from_bool (SCM_SYMBOL_INTERNED_P (symbol)); } #undef FUNC_NAME diff --git a/libguile/threads.c b/libguile/threads.c index 32d7daad2..11e3fdd39 100644 --- a/libguile/threads.c +++ b/libguile/threads.c @@ -428,8 +428,8 @@ SCM_DEFINE (scm_call_with_new_thread, "call-with-new-thread", 2, 0, 0, "All the evaluation rules for dynamic roots apply to threads.") #define FUNC_NAME s_scm_call_with_new_thread { - SCM_ASSERT (SCM_NFALSEP (scm_thunk_p (thunk)), thunk, SCM_ARG1, FUNC_NAME); - SCM_ASSERT (SCM_NFALSEP (scm_procedure_p (handler)), handler, SCM_ARG2, + SCM_ASSERT (scm_is_true (scm_thunk_p (thunk)), thunk, SCM_ARG1, FUNC_NAME); + SCM_ASSERT (scm_is_true (scm_procedure_p (handler)), handler, SCM_ARG2, FUNC_NAME); return create_thread ((scm_t_catch_body) scm_call_0, thunk, @@ -443,7 +443,7 @@ SCM_DEFINE (scm_yield, "yield", 0, 0, 0, "Move the calling thread to the end of the scheduling queue.") #define FUNC_NAME s_scm_yield { - return SCM_BOOL (scm_thread_yield ()); + return scm_from_bool (scm_thread_yield ()); } #undef FUNC_NAME @@ -592,7 +592,7 @@ fair_mutex_unlock (fair_mutex *m) else { SCM next = dequeue (m->waiting); - if (!SCM_FALSEP (next)) + if (scm_is_true (next)) { m->owner = next; unblock (SCM_THREAD_DATA (next)); @@ -667,7 +667,7 @@ fair_cond_signal (fair_cond *c) { SCM th; scm_i_plugin_mutex_lock (&c->lock); - if (!SCM_FALSEP (th = dequeue (c->waiting))) + if (scm_is_true (th = dequeue (c->waiting))) unblock (SCM_THREAD_DATA (th)); scm_i_plugin_mutex_unlock (&c->lock); return 0; @@ -678,7 +678,7 @@ fair_cond_broadcast (fair_cond *c) { SCM th; scm_i_plugin_mutex_lock (&c->lock); - while (!SCM_FALSEP (th = dequeue (c->waiting))) + while (scm_is_true (th = dequeue (c->waiting))) unblock (SCM_THREAD_DATA (th)); scm_i_plugin_mutex_unlock (&c->lock); return 0; @@ -1172,7 +1172,7 @@ SCM_DEFINE (scm_thread_exited_p, "thread-exited?", 1, 0, 0, "Return @code{#t} iff @var{thread} has exited.\n") #define FUNC_NAME s_scm_thread_exited_p { - return SCM_BOOL (scm_c_thread_exited_p (thread)); + return scm_from_bool (scm_c_thread_exited_p (thread)); } #undef FUNC_NAME diff --git a/libguile/throw.c b/libguile/throw.c index f278350af..c40000bdd 100644 --- a/libguile/throw.c +++ b/libguile/throw.c @@ -374,7 +374,7 @@ scm_exit_status (SCM args) if (SCM_INUMP (cqa)) return (SCM_INUM (cqa)); - else if (SCM_FALSEP (cqa)) + else if (scm_is_false (cqa)) return 1; } return 0; @@ -395,7 +395,7 @@ handler_message (void *handler_data, SCM tag, SCM args) SCM parts = SCM_CADDR (args); SCM rest = SCM_CDDDR (args); - if (SCM_BACKTRACE_P && SCM_NFALSEP (stack)) + if (SCM_BACKTRACE_P && scm_is_true (stack)) { scm_puts ("Backtrace:\n", p); scm_display_backtrace (stack, p, SCM_UNDEFINED, SCM_UNDEFINED); @@ -444,7 +444,7 @@ handler_message (void *handler_data, SCM tag, SCM args) SCM scm_handle_by_message (void *handler_data, SCM tag, SCM args) { - if (SCM_NFALSEP (scm_eq_p (tag, scm_str2symbol ("quit")))) + if (scm_is_true (scm_eq_p (tag, scm_str2symbol ("quit")))) { exit (scm_exit_status (args)); } diff --git a/libguile/unif.c b/libguile/unif.c index 912186d4a..5268062da 100644 --- a/libguile/unif.c +++ b/libguile/unif.c @@ -263,7 +263,7 @@ SCM_DEFINE (scm_array_p, "array?", 1, 1, 0, v = SCM_ARRAY_V (v); } if (nprot) - return SCM_BOOL(nprot); + return scm_from_bool(nprot); else { int protp = 0; @@ -316,7 +316,7 @@ SCM_DEFINE (scm_array_p, "array?", 1, 1, 0, /* no default */ ; } - return SCM_BOOL(protp); + return scm_from_bool(protp); } } #undef FUNC_NAME @@ -1038,7 +1038,7 @@ tail: { unsigned long int length = SCM_INUM (scm_uniform_vector_length (v)); SCM_ASRTGO (SCM_NULLP (args) && SCM_INUMP (ind), wna); - return SCM_BOOL(pos >= 0 && pos < length); + return scm_from_bool(pos >= 0 && pos < length); } } } @@ -1269,7 +1269,7 @@ SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1, case scm_tc7_smob: /* enclosed */ goto badarg1; case scm_tc7_bvect: - if (SCM_FALSEP (obj)) + if (scm_is_false (obj)) SCM_BITVEC_CLR(v, pos); else if (SCM_EQ_P (obj, SCM_BOOL_T)) SCM_BITVEC_SET(v, pos); @@ -1762,7 +1762,7 @@ SCM_DEFINE (scm_bit_count, "bit-count", 2, 0, 0, unsigned long int count = 0; unsigned long int i = (SCM_BITVECTOR_LENGTH (bitvector) - 1) / SCM_LONG_BIT; unsigned long int w = SCM_UNPACK (SCM_VELTS (bitvector)[i]); - if (SCM_FALSEP (b)) { + if (scm_is_false (b)) { w = ~w; }; w <<= SCM_LONG_BIT - 1 - ((SCM_BITVECTOR_LENGTH (bitvector) - 1) % SCM_LONG_BIT); @@ -1776,7 +1776,7 @@ SCM_DEFINE (scm_bit_count, "bit-count", 2, 0, 0, } else { --i; w = SCM_UNPACK (SCM_VELTS (bitvector)[i]); - if (SCM_FALSEP (b)) { + if (scm_is_false (b)) { w = ~w; } } @@ -1813,7 +1813,7 @@ SCM_DEFINE (scm_bit_position, "bit-position", 3, 0, 0, lenw = (SCM_BITVECTOR_LENGTH (v) - 1) / SCM_LONG_BIT; /* watch for part words */ i = pos / SCM_LONG_BIT; w = SCM_UNPACK (SCM_VELTS (v)[i]); - if (SCM_FALSEP (item)) + if (scm_is_false (item)) w = ~w; xbits = (pos % SCM_LONG_BIT); pos -= xbits; @@ -1847,7 +1847,7 @@ SCM_DEFINE (scm_bit_position, "bit-position", 3, 0, 0, break; pos += SCM_LONG_BIT; w = SCM_UNPACK (SCM_VELTS (v)[i]); - if (SCM_FALSEP (item)) + if (scm_is_false (item)) w = ~w; } return SCM_BOOL_F; @@ -1894,7 +1894,7 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0, badarg2:SCM_WRONG_TYPE_ARG (2, kv); case scm_tc7_uvect: vlen = SCM_BITVECTOR_LENGTH (v); - if (SCM_FALSEP (obj)) + if (scm_is_false (obj)) for (i = SCM_UVECTOR_LENGTH (kv); i;) { k = SCM_UNPACK (SCM_VELTS (kv)[--i]); @@ -1915,7 +1915,7 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0, break; case scm_tc7_bvect: SCM_ASSERT (SCM_BITVECTOR_LENGTH (v) == SCM_BITVECTOR_LENGTH (kv), v, SCM_ARG1, FUNC_NAME); - if (SCM_FALSEP (obj)) + if (scm_is_false (obj)) for (k = (SCM_BITVECTOR_LENGTH (v) + SCM_LONG_BIT - 1) / SCM_LONG_BIT; k--;) SCM_BITVECTOR_BASE (v) [k] &= ~SCM_BITVECTOR_BASE (kv) [k]; else if (SCM_EQ_P (obj, SCM_BOOL_T)) @@ -1964,7 +1964,7 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0, SCM_WRONG_TYPE_ARG (2, kv); case scm_tc7_uvect: vlen = SCM_BITVECTOR_LENGTH (v); - if (SCM_FALSEP (obj)) + if (scm_is_false (obj)) for (i = SCM_UVECTOR_LENGTH (kv); i;) { k = SCM_UNPACK (SCM_VELTS (kv)[--i]); @@ -1989,7 +1989,7 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0, SCM_ASSERT (SCM_BITVECTOR_LENGTH (v) == SCM_BITVECTOR_LENGTH (kv), v, SCM_ARG1, FUNC_NAME); if (0 == SCM_BITVECTOR_LENGTH (v)) return SCM_INUM0; - SCM_ASRTGO (SCM_BOOLP (obj), badarg3); + SCM_ASRTGO (scm_is_bool (obj), badarg3); fObj = SCM_EQ_P (obj, SCM_BOOL_T); i = (SCM_BITVECTOR_LENGTH (v) - 1) / SCM_LONG_BIT; k = SCM_UNPACK (SCM_VELTS (kv)[i]) & (fObj ? SCM_UNPACK (SCM_VELTS (v)[i]) : ~ SCM_UNPACK (SCM_VELTS (v)[i])); @@ -2116,9 +2116,9 @@ SCM_DEFINE (scm_array_to_list, "array->list", 1, 0, 0, register unsigned long mask; for (k = (SCM_BITVECTOR_LENGTH (v) - 1) / SCM_LONG_BIT; k > 0; k--) for (mask = 1UL << (SCM_LONG_BIT - 1); mask; mask >>= 1) - res = scm_cons (SCM_BOOL(((long *) data)[k] & mask), res); + res = scm_cons (scm_from_bool(((long *) data)[k] & mask), res); for (mask = 1L << ((SCM_BITVECTOR_LENGTH (v) % SCM_LONG_BIT) - 1); mask; mask >>= 1) - res = scm_cons (SCM_BOOL(((long *) data)[k] & mask), res); + res = scm_cons (scm_from_bool(((long *) data)[k] & mask), res); return res; } case scm_tc7_byvect: diff --git a/libguile/validate.h b/libguile/validate.h index e3dd57411..99a63deda 100644 --- a/libguile/validate.h +++ b/libguile/validate.h @@ -135,11 +135,14 @@ #define SCM_VALIDATE_NIM(pos, scm) SCM_MAKE_VALIDATE_MSG (pos, scm, NIMP, "non-immediate") -#define SCM_VALIDATE_BOOL(pos, flag) SCM_MAKE_VALIDATE_MSG(pos, flag, BOOLP, "boolean") +#define SCM_VALIDATE_BOOL(pos, flag) \ + do { \ + SCM_ASSERT_TYPE (scm_is_bool (flag), flag, pos, FUNC_NAME, "boolean"); \ + } while (0) #define SCM_VALIDATE_BOOL_COPY(pos, flag, cvar) \ do { \ - SCM_ASSERT (SCM_BOOLP (flag), flag, pos, FUNC_NAME); \ + SCM_ASSERT (scm_is_bool (flag), flag, pos, FUNC_NAME); \ cvar = SCM_EQ_P (flag, SCM_BOOL_T) ? 1 : 0; \ } while (0) @@ -358,7 +361,7 @@ #define SCM_VALIDATE_THUNK(pos, thunk) \ do { \ - SCM_ASSERT (!SCM_FALSEP (scm_thunk_p (thunk)), thunk, pos, FUNC_NAME); \ + SCM_ASSERT (scm_is_true (scm_thunk_p (thunk)), thunk, pos, FUNC_NAME); \ } while (0) #define SCM_VALIDATE_SYMBOL(pos, sym) SCM_MAKE_VALIDATE_MSG (pos, sym, SYMBOLP, "symbol") @@ -427,7 +430,7 @@ #define SCM_VALIDATE_ARRAY(pos, v) \ do { \ SCM_ASSERT (!SCM_IMP (v) \ - && !SCM_FALSEP (scm_array_p (v, SCM_UNDEFINED)), \ + && scm_is_true (scm_array_p (v, SCM_UNDEFINED)), \ v, pos, FUNC_NAME); \ } while (0) @@ -444,7 +447,7 @@ #define SCM_VALIDATE_VTABLE(pos, v) \ do { \ - SCM_ASSERT (!SCM_IMP (v) && !SCM_FALSEP (scm_struct_vtable_p (v)), \ + SCM_ASSERT (!SCM_IMP (v) && scm_is_true (scm_struct_vtable_p (v)), \ v, pos, FUNC_NAME); \ } while (0) diff --git a/libguile/variable.c b/libguile/variable.c index a3d06024d..c63d1dbf4 100644 --- a/libguile/variable.c +++ b/libguile/variable.c @@ -73,7 +73,7 @@ SCM_DEFINE (scm_variable_p, "variable?", 1, 0, 0, "return @code{#f}.") #define FUNC_NAME s_scm_variable_p { - return SCM_BOOL (SCM_VARIABLEP (obj)); + return scm_from_bool (SCM_VARIABLEP (obj)); } #undef FUNC_NAME @@ -114,7 +114,7 @@ SCM_DEFINE (scm_variable_bound_p, "variable-bound?", 1, 0, 0, #define FUNC_NAME s_scm_variable_bound_p { SCM_VALIDATE_VARIABLE (1, var); - return SCM_BOOL (SCM_VARIABLE_REF (var) != SCM_UNDEFINED); + return scm_from_bool (SCM_VARIABLE_REF (var) != SCM_UNDEFINED); } #undef FUNC_NAME diff --git a/libguile/vectors.c b/libguile/vectors.c index efcd98405..894a8320e 100644 --- a/libguile/vectors.c +++ b/libguile/vectors.c @@ -35,7 +35,7 @@ SCM_DEFINE (scm_vector_p, "vector?", 1, 0, 0, "@code{#f}.") #define FUNC_NAME s_scm_vector_p { - return SCM_BOOL (SCM_VECTORP (obj)); + return scm_from_bool (SCM_VECTORP (obj)); } #undef FUNC_NAME @@ -245,7 +245,7 @@ scm_vector_equal_p(SCM x, SCM y) { long i; for(i = SCM_VECTOR_LENGTH (x) - 1; i >= 0; i--) - if (SCM_FALSEP (scm_equal_p (SCM_VELTS (x)[i], SCM_VELTS (y)[i]))) + if (scm_is_false (scm_equal_p (SCM_VELTS (x)[i], SCM_VELTS (y)[i]))) return SCM_BOOL_F; return SCM_BOOL_T; } diff --git a/libguile/vports.c b/libguile/vports.c index a693d5323..7841cbe8a 100644 --- a/libguile/vports.c +++ b/libguile/vports.c @@ -65,7 +65,7 @@ sf_flush (SCM port) { SCM f = SCM_VELTS (stream)[2]; - if (!SCM_FALSEP (f)) + if (scm_is_true (f)) scm_call_0 (f); } } @@ -91,7 +91,7 @@ sf_fill_input (SCM port) SCM ans; ans = scm_call_0 (SCM_VELTS (p)[3]); /* get char. */ - if (SCM_FALSEP (ans) || SCM_EOF_OBJECT_P (ans)) + if (scm_is_false (ans) || SCM_EOF_OBJECT_P (ans)) return EOF; SCM_ASSERT (SCM_CHARP (ans), ans, SCM_ARG1, "sf_fill_input"); { @@ -110,11 +110,11 @@ sf_close (SCM port) { SCM p = SCM_PACK (SCM_STREAM (port)); SCM f = SCM_VELTS (p)[4]; - if (SCM_FALSEP (f)) + if (scm_is_false (f)) return 0; f = scm_call_0 (f); errno = 0; - return SCM_FALSEP (f) ? EOF : 0; + return scm_is_false (f) ? EOF : 0; } @@ -125,7 +125,7 @@ sf_input_waiting (SCM port) if (SCM_VECTOR_LENGTH (p) >= 6) { SCM f = SCM_VELTS (p)[5]; - if (SCM_NFALSEP (f)) + if (scm_is_true (f)) return scm_num2int (scm_call_0 (f), SCM_ARGn, NULL); } /* Default is such that char-ready? for soft ports returns #t, as it diff --git a/libguile/weaks.c b/libguile/weaks.c index a39b587ff..99ff92b55 100644 --- a/libguile/weaks.c +++ b/libguile/weaks.c @@ -173,7 +173,7 @@ SCM_DEFINE (scm_weak_vector_p, "weak-vector?", 1, 0, 0, "weak hashes are also weak vectors.") #define FUNC_NAME s_scm_weak_vector_p { - return SCM_BOOL (SCM_WVECTP (obj) && !SCM_IS_WHVEC (obj)); + return scm_from_bool (SCM_WVECTP (obj) && !SCM_IS_WHVEC (obj)); } #undef FUNC_NAME @@ -230,7 +230,7 @@ SCM_DEFINE (scm_weak_key_alist_vector_p, "weak-key-alist-vector?", 1, 0, 0, "nor a weak value hash table.") #define FUNC_NAME s_scm_weak_key_alist_vector_p { - return SCM_BOOL (SCM_WVECTP (obj) && SCM_IS_WHVEC (obj)); + return scm_from_bool (SCM_WVECTP (obj) && SCM_IS_WHVEC (obj)); } #undef FUNC_NAME @@ -240,7 +240,7 @@ SCM_DEFINE (scm_weak_value_alist_vector_p, "weak-value-alist-vector?", 1, 0, 0, "Return @code{#t} if @var{obj} is a weak value hash table.") #define FUNC_NAME s_scm_weak_value_alist_vector_p { - return SCM_BOOL (SCM_WVECTP (obj) && SCM_IS_WHVEC_V (obj)); + return scm_from_bool (SCM_WVECTP (obj) && SCM_IS_WHVEC_V (obj)); } #undef FUNC_NAME @@ -250,7 +250,7 @@ SCM_DEFINE (scm_doubly_weak_alist_vector_p, "doubly-weak-alist-vector?", 1, 0, 0 "Return @code{#t} if @var{obj} is a doubly weak hash table.") #define FUNC_NAME s_scm_doubly_weak_alist_vector_p { - return SCM_BOOL (SCM_WVECTP (obj) && SCM_IS_WHVEC_B (obj)); + return scm_from_bool (SCM_WVECTP (obj) && SCM_IS_WHVEC_B (obj)); } #undef FUNC_NAME From 054ebf6ca539dee2bfc9965781313c0d32faa51f Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Tue, 6 Jul 2004 11:02:18 +0000 Subject: [PATCH 22/58] *** empty log message *** --- srfi/ChangeLog | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/srfi/ChangeLog b/srfi/ChangeLog index b8ea311a1..8291a5b63 100644 --- a/srfi/ChangeLog +++ b/srfi/ChangeLog @@ -1,3 +1,10 @@ +2004-07-06 Marius Vollmer + + * srfi-1.c, srfi-13.c, srfi-14.c, srfi-4.c: Replaced all uses of + deprecated SCM_FALSEP, SCM_NFALSEP, SCM_BOOL, SCM_NEGATE_BOOL, and + SCM_BOOLP with scm_is_false, scm_is_true, scm_from_bool, and + scm_is_bool, respectively. + 2004-07-05 Kevin Ryde * srfi-4.c (uvec_sizes): Add "const". From 00874d5fb023fd68c03f0df33eccb6554da32ea2 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Tue, 6 Jul 2004 11:02:47 +0000 Subject: [PATCH 23/58] Replaced all uses of deprecated SCM_FALSEP, SCM_NFALSEP, SCM_BOOL, SCM_NEGATE_BOOL, and SCM_BOOLP with scm_is_false, scm_is_true, scm_from_bool, and scm_is_bool, respectively. --- guile-readline/readline.c | 4 ++-- srfi/srfi-1.c | 22 +++++++++--------- srfi/srfi-13.c | 48 +++++++++++++++++++-------------------- srfi/srfi-14.c | 24 ++++++++++---------- srfi/srfi-4.c | 40 ++++++++++++++++---------------- 5 files changed, 69 insertions(+), 69 deletions(-) diff --git a/guile-readline/readline.c b/guile-readline/readline.c index c47f82438..1c4b3eee3 100644 --- a/guile-readline/readline.c +++ b/guile-readline/readline.c @@ -342,7 +342,7 @@ SCM_DEFINE (scm_read_history, "read-history", 1, 0, 0, #define FUNC_NAME s_scm_read_history { SCM_VALIDATE_STRING (1,file); - return SCM_NEGATE_BOOL (read_history (SCM_STRING_CHARS (file))); + return scm_from_bool (!read_history (SCM_STRING_CHARS (file))); } #undef FUNC_NAME @@ -353,7 +353,7 @@ SCM_DEFINE (scm_write_history, "write-history", 1, 0, 0, #define FUNC_NAME s_scm_write_history { SCM_VALIDATE_STRING (1,file); - return SCM_NEGATE_BOOL (write_history (SCM_STRING_CHARS (file))); + return scm_from_bool (!write_history (SCM_STRING_CHARS (file))); } #undef FUNC_NAME diff --git a/srfi/srfi-1.c b/srfi/srfi-1.c index c50b47850..b7d0b5ecf 100644 --- a/srfi/srfi-1.c +++ b/srfi/srfi-1.c @@ -99,7 +99,7 @@ SCM_DEFINE (scm_srfi1_count, "count", 2, 0, 1, SCM_ASSERT (pred_tramp, pred, SCM_ARG1, FUNC_NAME); for ( ; SCM_CONSP (lst1); lst1 = SCM_CDR (lst1)) - count += ! SCM_FALSEP (pred_tramp (pred, SCM_CAR (lst1))); + count += scm_is_true (pred_tramp (pred, SCM_CAR (lst1))); end_lst1: SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (lst1), lst1, SCM_ARG2, FUNC_NAME, @@ -125,8 +125,8 @@ SCM_DEFINE (scm_srfi1_count, "count", 2, 0, 1, FUNC_NAME, "list"); break; } - count += ! SCM_FALSEP (pred_tramp - (pred, SCM_CAR (lst1), SCM_CAR (lst2))); + count += scm_is_true (pred_tramp + (pred, SCM_CAR (lst1), SCM_CAR (lst2))); lst1 = SCM_CDR (lst1); lst2 = SCM_CDR (lst2); } @@ -165,7 +165,7 @@ SCM_DEFINE (scm_srfi1_count, "count", 2, 0, 1, SCM_SETCAR (l, SCM_CDR (lst)); /* keep rest of lst */ } - count += ! SCM_FALSEP (scm_apply (pred, args, SCM_EOL)); + count += scm_is_true (scm_apply (pred, args, SCM_EOL)); } } done: @@ -218,7 +218,7 @@ SCM_DEFINE (scm_srfi1_delete, "delete", 2, 1, 0, for ( ; SCM_CONSP (lst); lst = SCM_CDR (lst)) { - if (! SCM_FALSEP (equal_p (pred, x, SCM_CAR (lst)))) + if (scm_is_true (equal_p (pred, x, SCM_CAR (lst)))) { /* delete this element, so copy from keeplst (inclusive) to lst (exclusive) onto ret */ @@ -277,7 +277,7 @@ SCM_DEFINE (scm_srfi1_delete_x, "delete!", 2, 1, 0, SCM_CONSP (walk); walk = SCM_CDR (walk)) { - if (! SCM_FALSEP (equal_p (pred, x, SCM_CAR (walk)))) + if (scm_is_true (equal_p (pred, x, SCM_CAR (walk)))) *prev = SCM_CDR (walk); else prev = SCM_CDRLOC (walk); @@ -362,7 +362,7 @@ SCM_DEFINE (scm_srfi1_delete_duplicates, "delete-duplicates", 1, 1, 0, /* loop searching ret upto lst */ for (l = ret; ! SCM_EQ_P (l, lst); l = SCM_CDR (l)) { - if (! SCM_FALSEP (equal_p (pred, SCM_CAR (l), item))) + if (scm_is_true (equal_p (pred, SCM_CAR (l), item))) { /* duplicate, don't want this element, so copy keeplst (inclusive) to lst (exclusive) onto ret */ @@ -447,7 +447,7 @@ SCM_DEFINE (scm_srfi1_delete_duplicates_x, "delete-duplicates!", 1, 1, 0, l = ret; for (;;) { - if (! SCM_FALSEP (equal_p (pred, SCM_CAR (l), item))) + if (scm_is_true (equal_p (pred, SCM_CAR (l), item))) break; /* equal, forget this element */ if (SCM_EQ_P (l, endret)) @@ -739,7 +739,7 @@ SCM_DEFINE (scm_srfi1_member, "member", 2, 1, 0, } for (; !SCM_NULL_OR_NIL_P (lst); lst = SCM_CDR (lst)) { - if (!SCM_FALSEP (equal_p (pred, SCM_CAR (lst), x))) + if (scm_is_true (equal_p (pred, SCM_CAR (lst), x))) return lst; } return SCM_BOOL_F; @@ -767,7 +767,7 @@ SCM_DEFINE (scm_srfi1_assoc, "assoc", 2, 1, 0, SCM tmp = SCM_CAR (ls); SCM_ASSERT_TYPE (SCM_CONSP (tmp), alist, SCM_ARG2, FUNC_NAME, "association list"); - if (SCM_NFALSEP (equal_p (pred, SCM_CAR (tmp), key))) + if (scm_is_true (equal_p (pred, SCM_CAR (tmp), key))) return tmp; } SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (ls), alist, SCM_ARG2, FUNC_NAME, @@ -798,7 +798,7 @@ SCM_DEFINE (scm_srfi1_partition, "partition", 2, 0, 0, for (; !SCM_NULL_OR_NIL_P (list); list = SCM_CDR(list)) { SCM elt = SCM_CAR(list); SCM new_tail = scm_cons(SCM_CAR(list), SCM_EOL); - if (SCM_NFALSEP(call(pred, elt))) { + if (scm_is_true (call (pred, elt))) { SCM_SETCDR(kept_tail, new_tail); kept_tail = new_tail; } diff --git a/srfi/srfi-13.c b/srfi/srfi-13.c index 8cf53c28f..eb26c3711 100644 --- a/srfi/srfi-13.c +++ b/srfi/srfi-13.c @@ -47,7 +47,7 @@ SCM_DEFINE (scm_string_any, "string-any", 2, 2, 0, while (cstart < cend) { res = scm_call_1 (pred, SCM_MAKE_CHAR (*cstr)); - if (!SCM_FALSEP (res)) + if (scm_is_true (res)) return res; cstr++; cstart++; @@ -79,7 +79,7 @@ SCM_DEFINE (scm_string_every, "string-every", 2, 2, 0, while (cstart < cend) { res = scm_call_1 (pred, SCM_MAKE_CHAR (*cstr)); - if (SCM_FALSEP (res)) + if (scm_is_false (res)) return res; cstr++; cstart++; @@ -625,7 +625,7 @@ SCM_DEFINE (scm_string_trim, "string-trim", 1, 3, 0, SCM res; res = scm_call_1 (char_pred, SCM_MAKE_CHAR (cstr[cstart])); - if (SCM_FALSEP (res)) + if (scm_is_false (res)) break; cstart++; } @@ -700,7 +700,7 @@ SCM_DEFINE (scm_string_trim_right, "string-trim-right", 1, 3, 0, SCM res; res = scm_call_1 (char_pred, SCM_MAKE_CHAR (cstr[cend - 1])); - if (SCM_FALSEP (res)) + if (scm_is_false (res)) break; cend--; } @@ -793,7 +793,7 @@ SCM_DEFINE (scm_string_trim_both, "string-trim-both", 1, 3, 0, SCM res; res = scm_call_1 (char_pred, SCM_MAKE_CHAR (cstr[cstart])); - if (SCM_FALSEP (res)) + if (scm_is_false (res)) break; cstart++; } @@ -802,7 +802,7 @@ SCM_DEFINE (scm_string_trim_both, "string-trim-both", 1, 3, 0, SCM res; res = scm_call_1 (char_pred, SCM_MAKE_CHAR (cstr[cend - 1])); - if (SCM_FALSEP (res)) + if (scm_is_false (res)) break; cend--; } @@ -1480,12 +1480,12 @@ SCM_DEFINE (scm_string_prefix_p, "string-prefix?", 2, 4, 0, while (cstart1 < cend1 && cstart2 < cend2) { if (cstr1[cstart1] != cstr2[cstart2]) - return SCM_BOOL (len == len1); + return scm_from_bool (len == len1); len++; cstart1++; cstart2++; } - return SCM_BOOL (len == len1); + return scm_from_bool (len == len1); } #undef FUNC_NAME @@ -1509,12 +1509,12 @@ SCM_DEFINE (scm_string_prefix_ci_p, "string-prefix-ci?", 2, 4, 0, while (cstart1 < cend1 && cstart2 < cend2) { if (scm_c_downcase (cstr1[cstart1]) != scm_c_downcase (cstr2[cstart2])) - return SCM_BOOL (len == len1); + return scm_from_bool (len == len1); len++; cstart1++; cstart2++; } - return SCM_BOOL (len == len1); + return scm_from_bool (len == len1); } #undef FUNC_NAME @@ -1540,10 +1540,10 @@ SCM_DEFINE (scm_string_suffix_p, "string-suffix?", 2, 4, 0, cend1--; cend2--; if (cstr1[cend1] != cstr2[cend2]) - return SCM_BOOL (len == len1); + return scm_from_bool (len == len1); len++; } - return SCM_BOOL (len == len1); + return scm_from_bool (len == len1); } #undef FUNC_NAME @@ -1569,10 +1569,10 @@ SCM_DEFINE (scm_string_suffix_ci_p, "string-suffix-ci?", 2, 4, 0, cend1--; cend2--; if (scm_c_downcase (cstr1[cend1]) != scm_c_downcase (cstr2[cend2])) - return SCM_BOOL (len == len1); + return scm_from_bool (len == len1); len++; } - return SCM_BOOL (len == len1); + return scm_from_bool (len == len1); } #undef FUNC_NAME @@ -1628,7 +1628,7 @@ SCM_DEFINE (scm_string_indexS, "string-index", 2, 2, 0, { SCM res; res = scm_call_1 (char_pred, SCM_MAKE_CHAR (cstr[cstart])); - if (!SCM_FALSEP (res)) + if (scm_is_true (res)) return SCM_MAKINUM (cstart); cstart++; } @@ -1688,7 +1688,7 @@ SCM_DEFINE (scm_string_index_right, "string-index-right", 2, 2, 0, SCM res; cend--; res = scm_call_1 (char_pred, SCM_MAKE_CHAR (cstr[cend])); - if (!SCM_FALSEP (res)) + if (scm_is_true (res)) return SCM_MAKINUM (cend); } } @@ -1747,7 +1747,7 @@ SCM_DEFINE (scm_string_skip, "string-skip", 2, 2, 0, { SCM res; res = scm_call_1 (char_pred, SCM_MAKE_CHAR (cstr[cstart])); - if (SCM_FALSEP (res)) + if (scm_is_false (res)) return SCM_MAKINUM (cstart); cstart++; } @@ -1808,7 +1808,7 @@ SCM_DEFINE (scm_string_skip_right, "string-skip-right", 2, 2, 0, SCM res; cend--; res = scm_call_1 (char_pred, SCM_MAKE_CHAR (cstr[cend])); - if (SCM_FALSEP (res)) + if (scm_is_false (res)) return SCM_MAKINUM (cend); } } @@ -1867,7 +1867,7 @@ SCM_DEFINE (scm_string_count, "string-count", 2, 2, 0, { SCM res; res = scm_call_1 (char_pred, SCM_MAKE_CHAR (cstr[cstart])); - if (!SCM_FALSEP (res)) + if (scm_is_true (res)) count++; cstart++; } @@ -2086,7 +2086,7 @@ string_titlecase_x (SCM str, int start, int end) sz = SCM_STRING_UCHARS (str); for(i = start; i < end; 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) { @@ -2528,7 +2528,7 @@ SCM_DEFINE (scm_string_unfold, "string-unfold", 4, 2, 0, SCM_VALIDATE_PROC (6, make_final); res = scm_call_1 (p, seed); - while (SCM_FALSEP (res)) + while (scm_is_false (res)) { SCM str; SCM ch = scm_call_1 (f, seed); @@ -2590,7 +2590,7 @@ SCM_DEFINE (scm_string_unfold_right, "string-unfold-right", 4, 2, 0, SCM_VALIDATE_PROC (6, make_final); res = scm_call_1 (p, seed); - while (SCM_FALSEP (res)) + while (scm_is_false (res)) { SCM str; SCM ch = scm_call_1 (f, seed); @@ -2895,7 +2895,7 @@ SCM_DEFINE (scm_string_filter, "string-filter", 2, 2, 0, { SCM res; res = scm_call_1 (char_pred, SCM_MAKE_CHAR (cstr[idx])); - if (!SCM_FALSEP (res)) + if (scm_is_true (res)) ls = scm_cons (SCM_MAKE_CHAR (cstr[idx]), ls); idx++; } @@ -2961,7 +2961,7 @@ SCM_DEFINE (scm_string_delete, "string-delete", 2, 2, 0, { SCM res; res = scm_call_1 (char_pred, SCM_MAKE_CHAR (cstr[idx])); - if (SCM_FALSEP (res)) + if (scm_is_false (res)) ls = scm_cons (SCM_MAKE_CHAR (cstr[idx]), ls); idx++; } diff --git a/srfi/srfi-14.c b/srfi/srfi-14.c index aeae52aa2..0ab29672a 100644 --- a/srfi/srfi-14.c +++ b/srfi/srfi-14.c @@ -85,7 +85,7 @@ SCM_DEFINE (scm_char_set_p, "char-set?", 1, 0, 0, "otherwise.") #define FUNC_NAME s_scm_char_set_p { - return SCM_BOOL (SCM_SMOB_PREDICATE (scm_tc16_charset, obj)); + return scm_from_bool (SCM_SMOB_PREDICATE (scm_tc16_charset, obj)); } #undef FUNC_NAME @@ -261,7 +261,7 @@ SCM_DEFINE (scm_end_of_char_set_p, "end-of-char-set?", 1, 0, 0, int ccursor; SCM_VALIDATE_INUM_MIN_COPY (1, cursor, 0, ccursor); - return SCM_BOOL (ccursor >= SCM_CHARSET_SIZE); + return scm_from_bool (ccursor >= SCM_CHARSET_SIZE); } #undef FUNC_NAME @@ -316,7 +316,7 @@ SCM_DEFINE (scm_char_set_unfold, "char-set-unfold", 4, 1, 0, result = make_char_set (FUNC_NAME); tmp = scm_call_1 (p, seed); - while (SCM_FALSEP (tmp)) + while (scm_is_false (tmp)) { SCM ch = scm_call_1 (f, seed); if (!SCM_CHARP (ch)) @@ -354,7 +354,7 @@ SCM_DEFINE (scm_char_set_unfold_x, "char-set-unfold!", 5, 0, 0, SCM_VALIDATE_SMOB (5, base_cs, charset); tmp = scm_call_1 (p, seed); - while (SCM_FALSEP (tmp)) + while (scm_is_false (tmp)) { SCM ch = scm_call_1 (f, seed); if (!SCM_CHARP (ch)) @@ -606,7 +606,7 @@ SCM_DEFINE (scm_char_set_filter, "char-set-filter", 2, 1, 0, { SCM res = scm_call_1 (pred, SCM_MAKE_CHAR (k)); - if (!SCM_FALSEP (res)) + if (scm_is_true (res)) p[k / SCM_BITS_PER_LONG] |= 1L << (k % SCM_BITS_PER_LONG); } } @@ -635,7 +635,7 @@ SCM_DEFINE (scm_char_set_filter_x, "char-set-filter!", 3, 0, 0, { SCM res = scm_call_1 (pred, SCM_MAKE_CHAR (k)); - if (!SCM_FALSEP (res)) + if (scm_is_true (res)) p[k / SCM_BITS_PER_LONG] |= 1L << (k % SCM_BITS_PER_LONG); } } @@ -670,7 +670,7 @@ SCM_DEFINE (scm_ucs_range_to_char_set, "ucs-range->char-set", 2, 2, 0, SCM_ASSERT_RANGE (2, upper, cupper >= 0 && cupper >= clower); if (!SCM_UNBNDP (error)) { - if (!SCM_FALSEP (error)) + if (scm_is_true (error)) { SCM_ASSERT_RANGE (1, lower, clower <= SCM_CHARSET_SIZE); SCM_ASSERT_RANGE (2, upper, cupper <= SCM_CHARSET_SIZE); @@ -721,7 +721,7 @@ SCM_DEFINE (scm_ucs_range_to_char_set_x, "ucs-range->char-set!", 4, 0, 0, SCM_VALIDATE_INUM_COPY (2, upper, cupper); SCM_ASSERT_RANGE (1, lower, clower >= 0); SCM_ASSERT_RANGE (2, upper, cupper >= 0 && cupper >= clower); - if (!SCM_FALSEP (error)) + if (scm_is_true (error)) { SCM_ASSERT_RANGE (1, lower, clower <= SCM_CHARSET_SIZE); SCM_ASSERT_RANGE (2, upper, cupper <= SCM_CHARSET_SIZE); @@ -772,7 +772,7 @@ SCM_DEFINE (scm_char_set_count, "char-set-count", 2, 0, 0, if (SCM_CHARSET_GET (cs, k)) { SCM res = scm_call_1 (pred, SCM_MAKE_CHAR (k)); - if (!SCM_FALSEP (res)) + if (scm_is_true (res)) count++; } return SCM_MAKINUM (count); @@ -833,7 +833,7 @@ SCM_DEFINE (scm_char_set_contains_p, "char-set-contains?", 2, 0, 0, { SCM_VALIDATE_SMOB (1, cs, charset); SCM_VALIDATE_CHAR (2, ch); - return SCM_BOOL (SCM_CHARSET_GET (cs, SCM_CHAR (ch))); + return scm_from_bool (SCM_CHARSET_GET (cs, SCM_CHAR (ch))); } #undef FUNC_NAME @@ -854,7 +854,7 @@ SCM_DEFINE (scm_char_set_every, "char-set-every", 2, 0, 0, if (SCM_CHARSET_GET (cs, k)) { res = scm_call_1 (pred, SCM_MAKE_CHAR (k)); - if (SCM_FALSEP (res)) + if (scm_is_false (res)) return res; } return res; @@ -877,7 +877,7 @@ SCM_DEFINE (scm_char_set_any, "char-set-any", 2, 0, 0, if (SCM_CHARSET_GET (cs, k)) { SCM res = scm_call_1 (pred, SCM_MAKE_CHAR (k)); - if (!SCM_FALSEP (res)) + if (scm_is_true (res)) return res; } return SCM_BOOL_F; diff --git a/srfi/srfi-4.c b/srfi/srfi-4.c index 4a37112ed..d6507551d 100644 --- a/srfi/srfi-4.c +++ b/srfi/srfi-4.c @@ -279,8 +279,8 @@ SCM_DEFINE (scm_u8vector_p, "u8vector?", 1, 0, 0, "@code{#f} otherwise.") #define FUNC_NAME s_scm_u8vector_p { - return SCM_BOOL (SCM_SMOB_PREDICATE (scm_tc16_uvec, obj) && - SCM_UVEC_TYPE (obj) == SCM_UVEC_U8); + return scm_from_bool (SCM_SMOB_PREDICATE (scm_tc16_uvec, obj) && + SCM_UVEC_TYPE (obj) == SCM_UVEC_U8); } #undef FUNC_NAME @@ -465,8 +465,8 @@ SCM_DEFINE (scm_s8vector_p, "s8vector?", 1, 0, 0, "@code{#f} otherwise.") #define FUNC_NAME s_scm_s8vector_p { - return SCM_BOOL (SCM_SMOB_PREDICATE (scm_tc16_uvec, obj) && - SCM_UVEC_TYPE (obj) == SCM_UVEC_S8); + return scm_from_bool (SCM_SMOB_PREDICATE (scm_tc16_uvec, obj) && + SCM_UVEC_TYPE (obj) == SCM_UVEC_S8); } #undef FUNC_NAME @@ -653,8 +653,8 @@ SCM_DEFINE (scm_u16vector_p, "u16vector?", 1, 0, 0, "@code{#f} otherwise.") #define FUNC_NAME s_scm_u16vector_p { - return SCM_BOOL (SCM_SMOB_PREDICATE (scm_tc16_uvec, obj) && - SCM_UVEC_TYPE (obj) == SCM_UVEC_U16); + return scm_from_bool (SCM_SMOB_PREDICATE (scm_tc16_uvec, obj) && + SCM_UVEC_TYPE (obj) == SCM_UVEC_U16); } #undef FUNC_NAME @@ -823,8 +823,8 @@ SCM_DEFINE (scm_s16vector_p, "s16vector?", 1, 0, 0, "@code{#f} otherwise.") #define FUNC_NAME s_scm_s16vector_p { - return SCM_BOOL (SCM_SMOB_PREDICATE (scm_tc16_uvec, obj) && - SCM_UVEC_TYPE (obj) == SCM_UVEC_S16); + return scm_from_bool (SCM_SMOB_PREDICATE (scm_tc16_uvec, obj) && + SCM_UVEC_TYPE (obj) == SCM_UVEC_S16); } #undef FUNC_NAME @@ -996,8 +996,8 @@ SCM_DEFINE (scm_u32vector_p, "u32vector?", 1, 0, 0, "@code{#f} otherwise.") #define FUNC_NAME s_scm_u32vector_p { - return SCM_BOOL (SCM_SMOB_PREDICATE (scm_tc16_uvec, obj) && - SCM_UVEC_TYPE (obj) == SCM_UVEC_U32); + return scm_from_bool (SCM_SMOB_PREDICATE (scm_tc16_uvec, obj) && + SCM_UVEC_TYPE (obj) == SCM_UVEC_U32); } #undef FUNC_NAME @@ -1167,8 +1167,8 @@ SCM_DEFINE (scm_s32vector_p, "s32vector?", 1, 0, 0, "@code{#f} otherwise.") #define FUNC_NAME s_scm_s32vector_p { - return SCM_BOOL (SCM_SMOB_PREDICATE (scm_tc16_uvec, obj) && - SCM_UVEC_TYPE (obj) == SCM_UVEC_S32); + return scm_from_bool (SCM_SMOB_PREDICATE (scm_tc16_uvec, obj) && + SCM_UVEC_TYPE (obj) == SCM_UVEC_S32); } #undef FUNC_NAME @@ -1340,8 +1340,8 @@ SCM_DEFINE (scm_u64vector_p, "u64vector?", 1, 0, 0, "@code{#f} otherwise.") #define FUNC_NAME s_scm_u64vector_p { - return SCM_BOOL (SCM_SMOB_PREDICATE (scm_tc16_uvec, obj) && - SCM_UVEC_TYPE (obj) == SCM_UVEC_U64); + return scm_from_bool (SCM_SMOB_PREDICATE (scm_tc16_uvec, obj) && + SCM_UVEC_TYPE (obj) == SCM_UVEC_U64); } #undef FUNC_NAME @@ -1511,8 +1511,8 @@ SCM_DEFINE (scm_s64vector_p, "s64vector?", 1, 0, 0, "@code{#f} otherwise.") #define FUNC_NAME s_scm_s64vector_p { - return SCM_BOOL (SCM_SMOB_PREDICATE (scm_tc16_uvec, obj) && - SCM_UVEC_TYPE (obj) == SCM_UVEC_S64); + return scm_from_bool (SCM_SMOB_PREDICATE (scm_tc16_uvec, obj) && + SCM_UVEC_TYPE (obj) == SCM_UVEC_S64); } #undef FUNC_NAME @@ -1684,8 +1684,8 @@ SCM_DEFINE (scm_f32vector_p, "f32vector?", 1, 0, 0, "@code{#f} otherwise.") #define FUNC_NAME s_scm_f32vector_p { - return SCM_BOOL (SCM_SMOB_PREDICATE (scm_tc16_uvec, obj) && - SCM_UVEC_TYPE (obj) == SCM_UVEC_F32); + return scm_from_bool (SCM_SMOB_PREDICATE (scm_tc16_uvec, obj) && + SCM_UVEC_TYPE (obj) == SCM_UVEC_F32); } #undef FUNC_NAME @@ -1880,8 +1880,8 @@ SCM_DEFINE (scm_f64vector_p, "f64vector?", 1, 0, 0, "@code{#f} otherwise.") #define FUNC_NAME s_scm_f64vector_p { - return SCM_BOOL (SCM_SMOB_PREDICATE (scm_tc16_uvec, obj) && - SCM_UVEC_TYPE (obj) == SCM_UVEC_F64); + return scm_from_bool (SCM_SMOB_PREDICATE (scm_tc16_uvec, obj) && + SCM_UVEC_TYPE (obj) == SCM_UVEC_F64); } #undef FUNC_NAME From 590f893b3b188cc72a28ae9591523aaf24962a49 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Tue, 6 Jul 2004 11:52:50 +0000 Subject: [PATCH 24/58] *** empty log message *** --- guile-readline/ChangeLog | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/guile-readline/ChangeLog b/guile-readline/ChangeLog index db4c503d6..8e5793efd 100644 --- a/guile-readline/ChangeLog +++ b/guile-readline/ChangeLog @@ -1,3 +1,10 @@ +2004-07-06 Marius Vollmer + + * readline.c: Replaced all uses of deprecated SCM_FALSEP, + SCM_NFALSEP, SCM_BOOL, SCM_NEGATE_BOOL, and SCM_BOOLP with + scm_is_false, scm_is_true, scm_from_bool, and scm_is_bool, + respectively. + 2004-06-16 Rob Browning * configure.in: move package and version args to AC_INIT as is now From 9cb7d02b426e01aad0ca308d3f2dfbdde84ecac7 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Tue, 6 Jul 2004 12:02:59 +0000 Subject: [PATCH 25/58] *** empty log message *** --- test-suite/standalone/.cvsignore | 1 + 1 file changed, 1 insertion(+) diff --git a/test-suite/standalone/.cvsignore b/test-suite/standalone/.cvsignore index 2f847802e..cf1f697db 100644 --- a/test-suite/standalone/.cvsignore +++ b/test-suite/standalone/.cvsignore @@ -5,6 +5,7 @@ .libs Makefile Makefile.in +test-conversion test-gh test-num2integral test-round From 2aac7a4825f65499278b023191c6144f1d57ae76 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Tue, 6 Jul 2004 13:13:14 +0000 Subject: [PATCH 26/58] Added test-conversion to the TESTS. --- test-suite/standalone/Makefile.am | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/test-suite/standalone/Makefile.am b/test-suite/standalone/Makefile.am index 3c62f9fc3..9c332c669 100644 --- a/test-suite/standalone/Makefile.am +++ b/test-suite/standalone/Makefile.am @@ -62,6 +62,13 @@ test_unwind_LDADD = ${top_builddir}/libguile/libguile.la check_PROGRAMS += test-unwind TESTS += test-unwind +# test-conversion +test_conversion_SOURCES = test-conversion.c +test_conversion_CFLAGS = ${test_cflags} +test_conversion_LDADD = ${top_builddir}/libguile/libguile.la +check_PROGRAMS += test-conversion +TESTS += test-conversion + all-local: cd ${srcdir} && chmod u+x ${check_SCRIPTS} From 170bb182fab30d84d36b729ea234a397e1882d9b Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Tue, 6 Jul 2004 13:13:37 +0000 Subject: [PATCH 27/58] New file. --- test-suite/standalone/test-conversion.c | 511 ++++++++++++++++++++++++ 1 file changed, 511 insertions(+) create mode 100644 test-suite/standalone/test-conversion.c diff --git a/test-suite/standalone/test-conversion.c b/test-suite/standalone/test-conversion.c new file mode 100644 index 000000000..d36f37350 --- /dev/null +++ b/test-suite/standalone/test-conversion.c @@ -0,0 +1,511 @@ +/* Copyright (C) 1999,2000,2001,2003,2004 Free Software Foundation, Inc. + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public + * License as published by the Free Software Foundation; either + * version 2.1 of the License, or (at your option) any later version. + * + * This library is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + */ + +#include "libguile.h" + +#include +#include + +#define SCM_T_UINTMAX_MAX (~(scm_t_uintmax)0) +#define SCM_T_UINTMAX_MIN ((scm_t_uintmax)0) +#define SCM_T_INTMAX_MAX ((scm_t_intmax)(SCM_T_UINTMAX_MAX/2)) +#define SCM_T_INTMAX_MIN (~SCM_T_INTMAX_MAX) + +static void +test_1 (const char *str, scm_t_intmax min, scm_t_intmax max, + int result) +{ + int r = scm_is_signed_integer (scm_c_eval_string (str), min, max); + if (r != result) + { + fprintf (stderr, "fail: scm_is_signed_integer (%s, %Ld, %Ld) == %d\n", + str, min, max, result); + exit (1); + } +} + +static void +test_is_signed_integer () +{ + test_1 ("'foo", + SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX, + 0); + test_1 ("3.0", + SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX, + 1); + test_1 ("3.5", + SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX, + 0); + test_1 ("most-positive-fixnum", + SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX, + 1); + test_1 ("(+ most-positive-fixnum 1)", + SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX, + 1); + test_1 ("most-negative-fixnum", + SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX, + 1); + test_1 ("(- most-negative-fixnum 1)", + SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX, + 1); + if (sizeof (scm_t_intmax) == 8) + { + test_1 ("(- (expt 2 63) 1)", + SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX, + 1); + test_1 ("(expt 2 63)", + SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX, + 0); + test_1 ("(- (expt 2 63))", + SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX, + 1); + test_1 ("(- (- (expt 2 63)) 1)", + SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX, + 0); + } + else if (sizeof (scm_t_intmax) == 4) + { + test_1 ("(- (expt 2 31) 1)", + SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX, + 1); + test_1 ("(expt 2 31)", + SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX, + 0); + test_1 ("(- (expt 2 31))", + SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX, + 1); + test_1 ("(- (- (expt 2 31)) 1)", + SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX, + 0); + } + else + fprintf (stderr, "NOTE: skipped some tests.\n"); + + /* bignum with range that fits into fixnum. */ + test_1 ("(+ most-positive-fixnum 1)", + -32768, 32767, + 0); + + /* bignum with range that doesn't fit into fixnum, but probably + fits into long. */ + test_1 ("(+ most-positive-fixnum 1)", + SCM_MOST_NEGATIVE_FIXNUM-1, SCM_MOST_POSITIVE_FIXNUM+1, + 1); +} + +static void +test_2 (const char *str, scm_t_uintmax min, scm_t_uintmax max, + int result) +{ + int r = scm_is_unsigned_integer (scm_c_eval_string (str), min, max); + if (r != result) + { + fprintf (stderr, "fail: scm_is_unsigned_integer (%s, %Lu, %Lu) == %d\n", + str, min, max, result); + exit (1); + } +} + +static void +test_is_unsigned_integer () +{ + test_2 ("'foo", + SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX, + 0); + test_2 ("3.0", + SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX, + 1); + test_2 ("3.5", + SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX, + 0); + test_2 ("most-positive-fixnum", + SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX, + 1); + test_2 ("(+ most-positive-fixnum 1)", + SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX, + 1); + test_2 ("most-negative-fixnum", + SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX, + 0); + test_2 ("(- most-negative-fixnum 1)", + SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX, + 0); + if (sizeof (scm_t_intmax) == 8) + { + test_2 ("(- (expt 2 64) 1)", + SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX, + 1); + test_2 ("(expt 2 64)", + SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX, + 0); + } + else if (sizeof (scm_t_intmax) == 4) + { + test_2 ("(- (expt 2 32) 1)", + SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX, + 1); + test_2 ("(expt 2 32)", + SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX, + 0); + } + else + fprintf (stderr, "NOTE: skipped some tests.\n"); + + /* bignum with range that fits into fixnum. */ + test_2 ("(+ most-positive-fixnum 1)", + 0, 32767, + 0); + + /* bignum with range that doesn't fit into fixnum, but probably + fits into long. */ + test_2 ("(+ most-positive-fixnum 1)", + 0, SCM_MOST_POSITIVE_FIXNUM+1, + 1); +} + +typedef struct { + SCM val; + scm_t_intmax min, max; + scm_t_intmax result; +} to_signed_data; + +static SCM +out_of_range_handler (void *data, SCM key, SCM args) +{ + return scm_equal_p (key, scm_str2symbol ("out-of-range")); +} + +static SCM +wrong_type_handler (void *data, SCM key, SCM args) +{ + return scm_equal_p (key, scm_str2symbol ("wrong-type-arg")); +} + +static SCM +any_handler (void *data, SCM key, SCM args) +{ + return SCM_BOOL_T; +} + +static SCM +to_signed_integer_body (void *data) +{ + to_signed_data *d = (to_signed_data *)data; + d->result = scm_to_signed_integer (d->val, d->min, d->max); + return SCM_BOOL_F; +} + +static void +test_3 (const char *str, scm_t_intmax min, scm_t_intmax max, + scm_t_intmax result, int range_error, int type_error) +{ + to_signed_data data; + data.val = scm_c_eval_string (str); + data.min = min; + data.max = max; + + if (range_error) + { + if (scm_is_false (scm_internal_catch (SCM_BOOL_T, + to_signed_integer_body, &data, + out_of_range_handler, NULL))) + { + fprintf (stderr, + "fail: scm_to_signed_int (%s, %Ld, %Ld) -> out of range\n", + str, min, max); + exit (1); + } + } + else if (type_error) + { + if (scm_is_false (scm_internal_catch (SCM_BOOL_T, + to_signed_integer_body, &data, + wrong_type_handler, NULL))) + { + fprintf (stderr, + "fail: scm_to_signed_int (%s, %Ld, %Ld) -> wrong type\n", + str, min, max); + exit (1); + } + } + else + { + if (scm_is_true (scm_internal_catch (SCM_BOOL_T, + to_signed_integer_body, &data, + any_handler, NULL)) + || data.result != result) + { + fprintf (stderr, + "fail: scm_to_signed_int (%s, %Ld, %Ld) = %Ld\n", + str, min, max, result); + exit (1); + } + } +} + +static void +test_to_signed_integer () +{ + test_3 ("'foo", + SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX, + 0, 0, 1); + test_3 ("3.5", + SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX, + 0, 0, 1); + test_3 ("12", + SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX, + 12, 0, 0); + test_3 ("1000", + -999, 999, + 0, 1, 0); + test_3 ("-1000", + -999, 999, + 0, 1, 0); + test_3 ("most-positive-fixnum", + SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX, + SCM_MOST_POSITIVE_FIXNUM, 0, 0); + test_3 ("most-negative-fixnum", + SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX, + SCM_MOST_NEGATIVE_FIXNUM, 0, 0); + test_3 ("(+ most-positive-fixnum 1)", + SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX, + SCM_MOST_POSITIVE_FIXNUM+1, 0, 0); + test_3 ("(- most-negative-fixnum 1)", + SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX, + SCM_MOST_NEGATIVE_FIXNUM-1, 0, 0); + if (sizeof (scm_t_intmax) == 8) + { + test_3 ("(- (expt 2 63) 1)", + SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX, + SCM_T_INTMAX_MAX, 0, 0); + test_3 ("(+ (- (expt 2 63)) 1)", + SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX, + SCM_T_INTMAX_MIN+1, 0, 0); + test_3 ("(- (expt 2 63))", + SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX, + SCM_T_INTMAX_MIN, 0, 0); + test_3 ("(expt 2 63)", + SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX, + 0, 1, 0); + test_3 ("(- (- (expt 2 63)) 1)", + SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX, + 0, 1, 0); + } + else if (sizeof (scm_t_intmax) == 4) + { + test_3 ("(- (expt 2 31) 1)", + SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX, + SCM_T_INTMAX_MAX, 0, 0); + test_3 ("(+ (- (expt 2 31)) 1)", + SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX, + SCM_T_INTMAX_MIN+1, 0, 0); + test_3 ("(- (expt 2 31))", + SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX, + SCM_T_INTMAX_MIN, 0, 0); + test_3 ("(expt 2 31)", + SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX, + 0, 1, 0); + test_3 ("(- (- (expt 2 31)) 1)", + SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX, + 0, 1, 0); + } + else + fprintf (stderr, "NOTE: skipped some tests.\n"); +} + +typedef struct { + SCM val; + scm_t_uintmax min, max; + scm_t_uintmax result; +} to_unsigned_data; + +static SCM +to_unsigned_integer_body (void *data) +{ + to_unsigned_data *d = (to_unsigned_data *)data; + d->result = scm_to_unsigned_integer (d->val, d->min, d->max); + return SCM_BOOL_F; +} + +static void +test_4 (const char *str, scm_t_uintmax min, scm_t_uintmax max, + scm_t_uintmax result, int range_error, int type_error) +{ + to_unsigned_data data; + data.val = scm_c_eval_string (str); + data.min = min; + data.max = max; + + if (range_error) + { + if (scm_is_false (scm_internal_catch (SCM_BOOL_T, + to_unsigned_integer_body, &data, + out_of_range_handler, NULL))) + { + fprintf (stderr, + "fail: scm_to_unsigned_int (%s, %Lu, %Lu) -> out of range\n", + str, min, max); + exit (1); + } + } + else if (type_error) + { + if (scm_is_false (scm_internal_catch (SCM_BOOL_T, + to_unsigned_integer_body, &data, + wrong_type_handler, NULL))) + { + fprintf (stderr, + "fail: scm_to_unsigned_int (%s, %Lu, %Lu) -> wrong type\n", + str, min, max); + exit (1); + } + } + else + { + if (scm_is_true (scm_internal_catch (SCM_BOOL_T, + to_unsigned_integer_body, &data, + any_handler, NULL)) + || data.result != result) + { + fprintf (stderr, + "fail: scm_to_unsigned_int (%s, %Lu, %Lu) == %Lu\n", + str, min, max, result); + exit (1); + } + } +} + +static void +test_to_unsigned_integer () +{ + test_4 ("'foo", + SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX, + 0, 0, 1); + test_4 ("3.5", + SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX, + 0, 0, 1); + test_4 ("12", + SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX, + 12, 0, 0); + test_4 ("1000", + 0, 999, + 0, 1, 0); + test_4 ("most-positive-fixnum", + SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX, + SCM_MOST_POSITIVE_FIXNUM, 0, 0); + test_4 ("(+ most-positive-fixnum 1)", + SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX, + SCM_MOST_POSITIVE_FIXNUM+1, 0, 0); + if (sizeof (scm_t_intmax) == 8) + { + test_4 ("(- (expt 2 64) 1)", + SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX, + SCM_T_UINTMAX_MAX, 0, 0); + test_4 ("(expt 2 64)", + SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX, + 0, 1, 0); + } + else if (sizeof (scm_t_intmax) == 4) + { + test_4 ("(- (expt 2 32) 1)", + SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX, + SCM_T_UINTMAX_MAX, 0, 0); + test_4 ("(expt 2 32)", + SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX, + 0, 1, 0); + } + else + fprintf (stderr, "NOTE: skipped some tests.\n"); +} + +static void +test_5 (scm_t_intmax val, const char *result) +{ + SCM res = scm_c_eval_string (result); + if (scm_is_false (scm_equal_p (scm_from_signed_integer (val), res))) + { + fprintf (stderr, "fail: scm_from_signed_integer (%Ld) == %s\n", + val, result); + exit (1); + } +} + +static void +test_from_signed_integer () +{ + test_5 (12, "12"); + if (sizeof (scm_t_intmax) == 8) + { + test_5 (SCM_T_INTMAX_MAX, "(- (expt 2 63) 1)"); + test_5 (SCM_T_INTMAX_MIN, "(- (expt 2 63))"); + } + else if (sizeof (scm_t_intmax) == 4) + { + test_5 (SCM_T_INTMAX_MAX, "(- (expt 2 31) 1)"); + test_5 (SCM_T_INTMAX_MIN, "(- (expt 2 31))"); + } + test_5 (SCM_MOST_POSITIVE_FIXNUM, "most-positive-fixnum"); + test_5 (SCM_MOST_NEGATIVE_FIXNUM, "most-negative-fixnum"); + test_5 (SCM_MOST_POSITIVE_FIXNUM+1, "(+ most-positive-fixnum 1)"); + test_5 (SCM_MOST_NEGATIVE_FIXNUM-1, "(- most-negative-fixnum 1)"); +} + +static void +test_6 (scm_t_uintmax val, const char *result) +{ + SCM res = scm_c_eval_string (result); + if (scm_is_false (scm_equal_p (scm_from_unsigned_integer (val), res))) + { + scm_write (scm_from_unsigned_integer (val), SCM_UNDEFINED); + scm_newline (SCM_UNDEFINED); + scm_write (res, SCM_UNDEFINED); + scm_newline (SCM_UNDEFINED); + + fprintf (stderr, "fail: scm_from_unsigned_integer (%Lu) == %s\n", + val, result); + exit (1); + } +} + +static void +test_from_unsigned_integer () +{ + test_6 (12, "12"); + if (sizeof (scm_t_intmax) == 8) + { + test_6 (SCM_T_UINTMAX_MAX, "(- (expt 2 64) 1)"); + } + else if (sizeof (scm_t_intmax) == 4) + { + test_6 (SCM_T_UINTMAX_MAX, "(- (expt 2 32) 1)"); + } + test_6 (SCM_MOST_POSITIVE_FIXNUM, "most-positive-fixnum"); + test_6 (SCM_MOST_POSITIVE_FIXNUM+1, "(+ most-positive-fixnum 1)"); +} + +int +main (int argc, char *argv[]) +{ + scm_init_guile(); + test_is_signed_integer (); + test_is_unsigned_integer (); + test_to_signed_integer (); + test_to_unsigned_integer (); + test_from_signed_integer (); + test_from_unsigned_integer (); + return 0; +} From 66dd7f149c344a8c2b1d0e3eb28eb6e2f3eddcd8 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Tue, 6 Jul 2004 13:19:42 +0000 Subject: [PATCH 28/58] Replaced all uses of deprecated SCM_FALSEP, SCM_NFALSEP, SCM_BOOL, SCM_NEGATE_BOOL, and SCM_BOOLP with scm_is_false, scm_is_true, scm_from_bool, and scm_is_bool, respectively. --- test-suite/standalone/test-num2integral.c | 16 ++++++++-------- test-suite/standalone/test-unwind.c | 6 +++--- 2 files changed, 11 insertions(+), 11 deletions(-) diff --git a/test-suite/standalone/test-num2integral.c b/test-suite/standalone/test-num2integral.c index 13513ed15..70cd033f7 100644 --- a/test-suite/standalone/test-num2integral.c +++ b/test-suite/standalone/test-num2integral.c @@ -71,7 +71,7 @@ test_long_long () SCM n = scm_difference (scm_long_long2num (LLONG_MIN), SCM_MAKINUM(1)); SCM caught = scm_internal_catch (SCM_BOOL_T, call_num2long_long_body, &n, out_of_range_handler, NULL); - assert (! SCM_FALSEP (caught)); + assert (scm_is_true (caught)); } /* LLONG_MIN + LLONG_MIN/2 */ @@ -80,7 +80,7 @@ test_long_long () scm_long_long2num (LLONG_MIN / 2)); SCM caught = scm_internal_catch (SCM_BOOL_T, call_num2long_long_body, &n, out_of_range_handler, NULL); - assert (! SCM_FALSEP (caught)); + assert (scm_is_true (caught)); } /* LLONG_MAX + 1 */ @@ -88,7 +88,7 @@ test_long_long () SCM n = scm_sum (scm_long_long2num (LLONG_MAX), SCM_MAKINUM(1)); SCM caught = scm_internal_catch (SCM_BOOL_T, call_num2long_long_body, &n, out_of_range_handler, NULL); - assert (! SCM_FALSEP (caught)); + assert (scm_is_true (caught)); } /* 2^1024 */ @@ -96,7 +96,7 @@ test_long_long () SCM n = scm_ash (SCM_MAKINUM (1), SCM_MAKINUM (1024)); SCM caught = scm_internal_catch (SCM_BOOL_T, call_num2long_long_body, &n, out_of_range_handler, NULL); - assert (! SCM_FALSEP (caught)); + assert (scm_is_true (caught)); } /* -2^1024 */ @@ -105,7 +105,7 @@ test_long_long () scm_ash (SCM_MAKINUM (1), SCM_MAKINUM (1024))); SCM caught = scm_internal_catch (SCM_BOOL_T, call_num2long_long_body, &n, out_of_range_handler, NULL); - assert (! SCM_FALSEP (caught)); + assert (scm_is_true (caught)); } #endif /* SCM_SIZEOF_LONG_LONG != 0 */ @@ -127,7 +127,7 @@ test_ulong_long () SCM n = SCM_MAKINUM (-1); SCM caught = scm_internal_catch (SCM_BOOL_T, call_num2ulong_long_body, &n, out_of_range_handler, NULL); - assert (! SCM_FALSEP (caught)); + assert (scm_is_true (caught)); } /* ULLONG_MAX + 1 */ @@ -135,7 +135,7 @@ test_ulong_long () SCM n = scm_sum (scm_ulong_long2num (ULLONG_MAX), SCM_MAKINUM(1)); SCM caught = scm_internal_catch (SCM_BOOL_T, call_num2ulong_long_body, &n, out_of_range_handler, NULL); - assert (! SCM_FALSEP (caught)); + assert (scm_is_true (caught)); } /* 2^1024 */ @@ -143,7 +143,7 @@ test_ulong_long () SCM n = scm_ash (SCM_MAKINUM (1), SCM_MAKINUM (1024)); SCM caught = scm_internal_catch (SCM_BOOL_T, call_num2long_long_body, &n, out_of_range_handler, NULL); - assert (! SCM_FALSEP (caught)); + assert (scm_is_true (caught)); } #endif /* SCM_SIZEOF_LONG_LONG != 0 */ diff --git a/test-suite/standalone/test-unwind.c b/test-suite/standalone/test-unwind.c index 44fbe4715..0704859d7 100644 --- a/test-suite/standalone/test-unwind.c +++ b/test-suite/standalone/test-unwind.c @@ -131,12 +131,12 @@ check_cont (int rewindable) the continuation, or a catch-tag, such as 'misc-error. */ - if (SCM_NFALSEP (scm_procedure_p (res))) + if (scm_is_true (scm_procedure_p (res))) { /* a continuation, invoke it */ scm_call_1 (res, SCM_BOOL_F); } - else if (SCM_FALSEP (res)) + else if (scm_is_false (res)) { /* the result of invoking the continuation, frame must be rewindable */ @@ -198,7 +198,7 @@ check_ports () scm_frame_current_input_port (port); res = scm_read (SCM_UNDEFINED); - if (SCM_FALSEP (scm_equal_p (res, scm_version ()))) + if (scm_is_false (scm_equal_p (res, scm_version ()))) { printf ("ports didn't work\n"); exit (1); From 9b5eee309e0690563cffa4035392b1768daf47ad Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Tue, 6 Jul 2004 13:20:07 +0000 Subject: [PATCH 29/58] *** empty log message *** --- test-suite/ChangeLog | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog index 87877faab..2b67516ab 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -1,3 +1,14 @@ +2004-07-06 Marius Vollmer + + * standalone/test-num2integral.c, standalone/test-unwind.c: + Replaced all uses of deprecated SCM_FALSEP, SCM_NFALSEP, SCM_BOOL, + SCM_NEGATE_BOOL, and SCM_BOOLP with scm_is_false, scm_is_true, + scm_from_bool, and scm_is_bool, respectively. + + * standalone/Makefile.am: Added test-conversion to the TESTS. + + * standalone/test-conversion.c: New file. + 2004-06-20 Rob Browning * tests/srfi-31.test: new test for SRFI-31. From ef53cad458f620ce76beb52246bab93fd9168da8 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Tue, 6 Jul 2004 14:21:46 +0000 Subject: [PATCH 30/58] Remove non-R5RS stuff from the 'rn' index. --- doc/ref/scheme-data.texi | 7 ------- 1 file changed, 7 deletions(-) diff --git a/doc/ref/scheme-data.texi b/doc/ref/scheme-data.texi index 3c87268c3..afcd092ba 100755 --- a/doc/ref/scheme-data.texi +++ b/doc/ref/scheme-data.texi @@ -123,38 +123,31 @@ Return @code{#t} if @var{obj} is either @code{#t} or @code{#f}, else return @code{#f}. @end deffn -@rnindex SCM_BOOL_T @deftypevr {C Macro} SCM SCM_BOOL_T The @code{SCM} representation of the Scheme object @code{#t}. @end deftypevr -@rnindex SCM_BOOL_T @deftypevr {C Macro} SCM SCM_BOOL_F The @code{SCM} representation of the Scheme object @code{#f}. @end deftypevr -@rnindex scm_is_true @deftypefn {C Macro} int scm_is_true (SCM obj) Return @code{0} if @var{obj} is @code{#f}, else return @code{1}. @end deftypefn -@rnindex scm_is_false @deftypefn {C Macro} int scm_is_false (SCM obj) Return @code{1} if @var{obj} is @code{#f}, else return @code{0}. @end deftypefn -@rnindex scm_is_bool @deftypefn {C Macro} scm_is_bool (SCM obj) Return @code{1} if @var{obj} is either @code{#t} or @code{#f}, else return @code{0}. @end deftypefn -@rnindex scm_from_bool @deftypefn {C Macro} SCM scm_from_bool (int val) Return @code{#f} if @var{val} is @code{0}, else return @code{#t}. @end deftypefn -@rnindex scm_to_bool @deftypefn {C Macro} int scm_to_bool (SCM val) Return @code{1} if @var{val} is @code{SCM_BOOL_T}, return @code{0} when @var{val} is @code{SCM_BOOL_F}, else signal a `wrong type' error. From 48c8d9c74ede9c065e571b154e2409b1d0d35f88 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Tue, 6 Jul 2004 14:22:11 +0000 Subject: [PATCH 31/58] Added scm_is_eq, scm_eq_p, scm_eqv_p, and scm_equal_p. --- doc/ref/scheme-utility.texi | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/doc/ref/scheme-utility.texi b/doc/ref/scheme-utility.texi index 4528d8266..4fa95c9a7 100644 --- a/doc/ref/scheme-utility.texi +++ b/doc/ref/scheme-utility.texi @@ -54,14 +54,21 @@ the three kinds of @dfn{sameness} defined above. @rnindex eq? @deffn {Scheme Procedure} eq? x y +@deffnx {C Function} scm_eq_p (x, y) Return @code{#t} iff @var{x} references the same object as @var{y}. @code{eq?} is similar to @code{eqv?} except that in some cases it is capable of discerning distinctions finer than those detectable by @code{eqv?}. @end deffn +@deftypefn {C Function} int scm_is_eq (SCM x, SCM y) +Return @code{1} when @var{x} and @var{y} are equal in the sense of +@code{eq?}, else return @code{0}. +@end deftypefn + @rnindex eqv? @deffn {Scheme Procedure} eqv? x y +@deffnx {C Function} scm_eqv_p (x, y) The @code{eqv?} procedure defines a useful equivalence relation on objects. Briefly, it returns @code{#t} if @var{x} and @var{y} should normally be regarded as the same object. This relation is left slightly open to @@ -71,8 +78,9 @@ and inexact numbers. @rnindex equal? @deffn {Scheme Procedure} equal? x y -Return @code{#t} iff @var{x} and @var{y} are recursively @code{eqv?} equivalent. -@code{equal?} recursively compares the contents of pairs, +@deffnx {C Function} scm_equal_p (x, y) +Return @code{#t} iff @var{x} and @var{y} are recursively @code{eqv?} +equivalent. @code{equal?} recursively compares the contents of pairs, vectors, and strings, applying @code{eqv?} on other objects such as numbers and symbols. A rule of thumb is that objects are generally @code{equal?} if they print the same. @code{equal?} may fail to From c309617ce766c410c639fa497a7dd673866de8f2 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Tue, 6 Jul 2004 14:23:15 +0000 Subject: [PATCH 32/58] *** empty log message *** --- doc/ref/ChangeLog | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index 8cee40148..f6e090e97 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,10 @@ +2004-07-06 Marius Vollmer + + * scheme-data.texi: Remove non-R5RS stuff from the 'rn' index. + + * scheme-utility.texi: Added scm_is_eq, scm_eq_p, scm_eqv_p, and + scm_equal_p. + 2004-07-05 Marius Vollmer * scheme-data.texi (Booleans): Added reference entries for From c67fd6ec36e91e370fdcb6c2d09b59ecd842130b Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 7 Jul 2004 07:39:10 +0000 Subject: [PATCH 33/58] (Booleans): Flag all function-like definitions as "C Functions". --- doc/ref/scheme-data.texi | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/doc/ref/scheme-data.texi b/doc/ref/scheme-data.texi index afcd092ba..ef5789877 100755 --- a/doc/ref/scheme-data.texi +++ b/doc/ref/scheme-data.texi @@ -131,24 +131,24 @@ The @code{SCM} representation of the Scheme object @code{#t}. The @code{SCM} representation of the Scheme object @code{#f}. @end deftypevr -@deftypefn {C Macro} int scm_is_true (SCM obj) +@deftypefn {C Function} int scm_is_true (SCM obj) Return @code{0} if @var{obj} is @code{#f}, else return @code{1}. @end deftypefn -@deftypefn {C Macro} int scm_is_false (SCM obj) +@deftypefn {C Function} int scm_is_false (SCM obj) Return @code{1} if @var{obj} is @code{#f}, else return @code{0}. @end deftypefn -@deftypefn {C Macro} scm_is_bool (SCM obj) +@deftypefn {C Function} int scm_is_bool (SCM obj) Return @code{1} if @var{obj} is either @code{#t} or @code{#f}, else return @code{0}. @end deftypefn -@deftypefn {C Macro} SCM scm_from_bool (int val) +@deftypefn {C Function} SCM scm_from_bool (int val) Return @code{#f} if @var{val} is @code{0}, else return @code{#t}. @end deftypefn -@deftypefn {C Macro} int scm_to_bool (SCM val) +@deftypefn {C Function} int scm_to_bool (SCM val) Return @code{1} if @var{val} is @code{SCM_BOOL_T}, return @code{0} when @var{val} is @code{SCM_BOOL_F}, else signal a `wrong type' error. From 33e57bbd8b8010fbce08778195bf9789d111e840 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 7 Jul 2004 07:43:07 +0000 Subject: [PATCH 34/58] *** empty log message *** --- doc/ref/ChangeLog | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index f6e090e97..63948643f 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,8 @@ +2004-07-07 Marius Vollmer + + * scheme-data.texi (Booleans): Flag all function-like definitions + as "C Functions". + 2004-07-06 Marius Vollmer * scheme-data.texi: Remove non-R5RS stuff from the 'rn' index. From f50e11ca3effbcb9c0a2a311fe019fb6901dde85 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 7 Jul 2004 12:09:57 +0000 Subject: [PATCH 35/58] Replace references to SCM_NFALSEP, etc with scm_is_true, etc. --- doc/ref/gh.texi | 41 +++++++++++++++++------------------------ 1 file changed, 17 insertions(+), 24 deletions(-) diff --git a/doc/ref/gh.texi b/doc/ref/gh.texi index 03cf997f4..59c8ca6f4 100644 --- a/doc/ref/gh.texi +++ b/doc/ref/gh.texi @@ -944,7 +944,7 @@ Use @code{scm_c_longs2ivect} and @code{scm_c_ulongs2uvect} instead. Use @code{scm_c_floats2fvect} and @code{scm_c_doubles2dvect} instead. @item @code{gh_scm2bool} -Use @code{SCM_NFALSEP} instead. +Use @code{scm_is_true} or @code{scm_to_bool} instead. @item @code{gh_scm2int} Replace @code{gh_scm2int (@var{obj})} by @@ -1005,109 +1005,102 @@ Use @code{scm_c_shorts2scm} and @code{scm_c_longs2scm} instead. Use @code{scm_c_floats2scm} and @code{scm_c_doubles2scm} instead. @item @code{gh_boolean_p} -Use the @code{SCM_BOOLP} macro instead, or replace @code{gh_boolean_p -(@var{obj})} by -@example -SCM_NFALSEP (scm_boolean_p (@var{obj})) -@end example +Use @code{scm_is_bool} instead. @item @code{gh_symbol_p} Use the @code{SCM_SYMBOLP} macro instead, or replace @code{gh_symbol_p (@var{obj})} by @example -SCM_NFALSEP (scm_symbol_p (@var{obj})) +scm_is_true (scm_symbol_p (@var{obj})) @end example @item @code{gh_char_p} Use the @code{SCM_CHARP} macro instead, or replace @code{gh_char_p (@var{obj})} by @example -SCM_NFALSEP (scm_char_p (@var{obj})) +scm_is_true (scm_char_p (@var{obj})) @end example @item @code{gh_vector_p} Use the @code{SCM_VECTORP} macro instead, or replace @code{gh_vector_p (@var{obj})} by @example -SCM_NFALSEP (scm_vector_p (@var{obj})) +scm_is_true (scm_vector_p (@var{obj})) @end example @item @code{gh_pair_p} Use the @code{SCM_CONSP} macro instead, or replace @code{gh_pair_p (@var{obj})} by @example -SCM_NFALSEP (scm_pair_p (@var{obj})) +scm_is_true (scm_pair_p (@var{obj})) @end example @item @code{gh_number_p} Use the @code{SCM_NUMBERP} macro instead, or replace @code{gh_number_p (@var{obj})} by @example -SCM_NFALSEP (scm_number_p (@var{obj})) +scm_is_true (scm_number_p (@var{obj})) @end example @item @code{gh_string_p} Use the @code{SCM_STRINGP} macro instead, or replace @code{gh_string_p (@var{obj})} by @example -SCM_NFALSEP (scm_string_p (@var{obj})) +scm_is_true (scm_string_p (@var{obj})) @end example @item @code{gh_procedure_p} Replace @code{gh_procedure_p (@var{obj})} by @example -SCM_NFALSEP (scm_procedure_p (@var{obj})) +scm_is_true (scm_procedure_p (@var{obj})) @end example @item @code{gh_list_p} Replace @code{gh_list_p (@var{obj})} by @example -SCM_NFALSEP (scm_list_p (@var{obj})) +scm_is_true (scm_list_p (@var{obj})) @end example @item @code{gh_inexact_p} Use the @code{SCM_INEXACTP} macro instead, or replace @code{gh_inexact_p (@var{obj})} by @example -SCM_NFALSEP (scm_inexact_p (@var{obj})) +scm_is_true (scm_inexact_p (@var{obj})) @end example @item @code{gh_exact_p} Replace @code{gh_exact_p (@var{obj})} by @example -SCM_NFALSEP (scm_exact_p (@var{obj})) +scm_is_true (scm_exact_p (@var{obj})) @end example @item @code{gh_eq_p} -Use the @code{SCM_EQ_P} macro instead, or replace @code{gh_eq_p -(@var{x}, @var{y})} by -@example -SCM_NFALSEP (scm_eq_p (@var{x}, @var{y})) +Use @code{scm_is_eq} instead. @end example @item @code{gh_eqv_p} Replace @code{gh_eqv_p (@var{x}, @var{y})} by @example -SCM_NFALSEP (scm_eqv_p (@var{x}, @var{y})) +scm_is_true (scm_eqv_p (@var{x}, @var{y})) @end example @item @code{gh_equal_p} Replace @code{gh_equal_p (@var{x}, @var{y})} by @example -SCM_NFALSEP (scm_equal_p (@var{x}, @var{y})) +scm_is_true (scm_equal_p (@var{x}, @var{y})) @end example @item @code{gh_string_equal_p} Replace @code{gh_string_equal_p (@var{x}, @var{y})} by @example -SCM_NFALSEP (scm_string_equal_p (@var{x}, @var{y})) +scm_is_true (scm_string_equal_p (@var{x}, @var{y})) @end example @item @code{gh_null_p} Use the @code{SCM_NULLP} macro instead, or replace @code{gh_null_p (@var{obj})} by @example -SCM_NFALSEP (scm_null_p (@var{obj})) +scm_is_true (scm_null_p (@var{obj})) @end example @item @code{gh_cons} From 3f7e8708b4e76b6ad9c1b74b8a938c1d4ee8345c Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 7 Jul 2004 12:17:41 +0000 Subject: [PATCH 36/58] (How Guile does it): Mark as being in limbo. All the real documentation will be in the nodes "Programming in C" and "API Reference". (Boolean Data): Just refer to node "Booleans". --- doc/ref/data-rep.texi | 31 +++++++++++-------------------- 1 file changed, 11 insertions(+), 20 deletions(-) diff --git a/doc/ref/data-rep.texi b/doc/ref/data-rep.texi index 3dc3fd70c..b505f4559 100644 --- a/doc/ref/data-rep.texi +++ b/doc/ref/data-rep.texi @@ -52,7 +52,7 @@ @c essay @sp 10 @c essay @comment The title is printed in a large font. @c essay @title Data Representation in Guile -@c essay @subtitle $Id: data-rep.texi,v 1.17 2004-04-21 14:32:08 mvo Exp $ +@c essay @subtitle $Id: data-rep.texi,v 1.18 2004-07-07 12:17:41 mvo Exp $ @c essay @subtitle For use with Guile @value{VERSION} @c essay @author Jim Blandy @c essay @author Free Software Foundation @@ -432,6 +432,13 @@ system would be boring, and we do not wish to encourage people to write code which depends on its details anyway. We do, however, present everything one need know to use Guile's data. +This section is in limbo. It used to document the 'low-level' C API +of Guile that was used both by clients of libguile and by libguile +itself. + +In the future, clients should only need to look into the sections +@ref{Programming in C} and @ref{API Reference}. This section will in +the end only contain stuff about the internals of Guile. @menu * General Rules:: @@ -663,25 +670,9 @@ character value. @node Boolean Data @subsubsection Booleans -Here are functions and macros for operating on booleans. - -@deftypefn Macro SCM SCM_BOOL_T -@deftypefnx Macro SCM SCM_BOOL_F -The Scheme true and false values. -@end deftypefn - -@deftypefn Macro int SCM_NFALSEP (@var{x}) -Convert the Scheme boolean value to a C boolean. Since every object in -Scheme except @code{#f} is true, this amounts to comparing @var{x} to -@code{#f}; hence the name. -@c Noel feels a chill here. -@end deftypefn - -@deftypefn Macro SCM SCM_BOOL_NOT (@var{x}) -Return the boolean inverse of @var{x}. If @var{x} is not a -Scheme boolean, the result is undefined. -@end deftypefn - +Booleans are represented as two specific immediate SCM values, +@code{SCM_BOOL_T} and @code{SCM_BOOL_F}. @xref{Booleans}, for more +information. @node Unique Values @subsubsection Unique Values From 39852ceae5fc5f0d18994a5a84329e3bdbc0d6a3 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 7 Jul 2004 12:18:18 +0000 Subject: [PATCH 37/58] *** empty log message *** --- doc/ref/ChangeLog | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index 63948643f..50e042bde 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,5 +1,13 @@ 2004-07-07 Marius Vollmer + * data-rep.texi (How Guile does it): Mark as being in limbo. All + the real documentation will be in the nodes "Programming in C" and + "API Reference". + (Boolean Data): Just refer to node "Booleans". + + * gh.texi: Replace references to SCM_NFALSEP, etc with + scm_is_true, etc. + * scheme-data.texi (Booleans): Flag all function-like definitions as "C Functions". From 6aa84fddd0323a385bcb13becebca7df8183d70a Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 7 Jul 2004 15:08:21 +0000 Subject: [PATCH 38/58] When checking for suitable types for scm_t_int8, etc, try int8_t first, so that we pick them up when they are defined. Also, substitute limit macros like INT8_MIN into the configure header for all these types. --- configure.in | 164 ++++++++++++++++++++++++++++++++++----------------- 1 file changed, 111 insertions(+), 53 deletions(-) diff --git a/configure.in b/configure.in index 265d2e990..29252ce58 100644 --- a/configure.in +++ b/configure.in @@ -321,150 +321,196 @@ fi # Try hard to find definitions for some required scm_t_*int* types. ### Required type scm_t_int8 -if test "$ac_cv_sizeof_char" -eq 1; then - SCM_I_GSC_T_INT8='"char"' -elif test "$scm_stdint_has_int8"; then +if test "$scm_stdint_has_int8"; then SCM_I_GSC_T_INT8='"int8_t"' + SCM_I_GSC_T_INT8_LIMITS='"INT8"' SCM_I_GSC_NEEDS_STDINT_H=1 elif test "$scm_inttypes_has_int8"; then SCM_I_GSC_T_INT8='"int8_t"' + SCM_I_GSC_T_INT8_LIMITS='"INT8"' SCM_I_GSC_NEEDS_INTTYPES_H=1 +elif test "$ac_cv_sizeof_char" -eq 1; then + SCM_I_GSC_T_INT8='"signed char"' + SCM_I_GSC_T_INT8_LIMITS='"SCHAR"' else AC_MSG_ERROR([Can't find appropriate type for scm_t_int8.]) fi AC_SUBST([SCM_I_GSC_T_INT8]) +AC_SUBST([SCM_I_GSC_T_INT8_LIMITS]) ### Required type scm_t_uint8 -if test "$ac_cv_sizeof_unsigned_char" -eq 1; then - SCM_I_GSC_T_UINT8='"unsigned char"' -elif test "$scm_stdint_has_uint8"; then +if test "$scm_stdint_has_uint8"; then SCM_I_GSC_T_UINT8='"uint8_t"' + SCM_I_GSC_T_UINT8_LIMITS='"UINT8"' SCM_I_GSC_NEEDS_STDINT_H=1 elif test "$scm_inttypes_has_uint8"; then SCM_I_GSC_T_UINT8='"uint8_t"' + SCM_I_GSC_T_UINT8_LIMITS='"UINT8"' SCM_I_GSC_NEEDS_INTTYPES_H=1 +elif test "$ac_cv_sizeof_unsigned_char" -eq 1; then + SCM_I_GSC_T_UINT8='"unsigned char"' + SCM_I_GSC_T_UINT8_LIMITS='"UCHAR"' else AC_MSG_ERROR([Can't find appropriate type for scm_t_uint8.]) fi AC_SUBST([SCM_I_GSC_T_UINT8]) - +AC_SUBST([SCM_I_GSC_T_UINT8_LIMITS]) ### Required type scm_t_int16 (ANSI C says int or short might work) -if test "$ac_cv_sizeof_int" -eq 2; then - SCM_I_GSC_T_INT16='"int"' -elif test "$ac_cv_sizeof_short" -eq 2; then - SCM_I_GSC_T_INT16='"short"' -elif test "$scm_stdint_has_int16"; then +if test "$scm_stdint_has_int16"; then SCM_I_GSC_T_INT16='"int16_t"' + SCM_I_GSC_T_INT16_LIMITS='"INT16"' SCM_I_GSC_NEEDS_STDINT_H=1 elif test "$scm_inttypes_has_int16"; then SCM_I_GSC_T_INT16='"int16_t"' + SCM_I_GSC_T_INT16_LIMITS='"INT16"' SCM_I_GSC_NEEDS_INTTYPES_H=1 +elif test "$ac_cv_sizeof_int" -eq 2; then + SCM_I_GSC_T_INT16='"int"' + SCM_I_GSC_T_INT16_LIMITS='"INT"' +elif test "$ac_cv_sizeof_short" -eq 2; then + SCM_I_GSC_T_INT16='"short"' + SCM_I_GSC_T_INT16_LIMITS='"SHRT"' else AC_MSG_ERROR([Can't find appropriate type for scm_t_int16.]) fi AC_SUBST([SCM_I_GSC_T_INT16]) +AC_SUBST([SCM_I_GSC_T_INT16_LIMITS]) ### Required type scm_t_uint16 (ANSI C says int or short might work) -if test "$ac_cv_sizeof_unsigned_int" -eq 2; then - SCM_I_GSC_T_UINT16='"unsigned int"' -elif test "$ac_cv_sizeof_unsigned_short" -eq 2; then - SCM_I_GSC_T_UINT16='"unsigned short"' -elif test "$scm_stdint_has_uint16"; then +if test "$scm_stdint_has_uint16"; then SCM_I_GSC_T_UINT16='"uint16_t"' + SCM_I_GSC_T_UINT16_LIMITS='"UINT16"' SCM_I_GSC_NEEDS_STDINT_H=1 elif test "$scm_inttypes_has_uint16"; then SCM_I_GSC_T_UINT16='"uint16_t"' + SCM_I_GSC_T_UINT16_LIMITS='"UINT16"' SCM_I_GSC_NEEDS_INTTYPES_H=1 +elif test "$ac_cv_sizeof_unsigned_int" -eq 2; then + SCM_I_GSC_T_UINT16='"unsigned int"' + SCM_I_GSC_T_UINT16_LIMITS='"UINT"' +elif test "$ac_cv_sizeof_unsigned_short" -eq 2; then + SCM_I_GSC_T_UINT16='"unsigned short"' + SCM_I_GSC_T_UINT16_LIMITS='"USHRT"' else AC_MSG_ERROR([Can't find appropriate type for scm_t_uint16.]) fi AC_SUBST([SCM_I_GSC_T_UINT16]) +AC_SUBST([SCM_I_GSC_T_UINT16_LIMITS]) ### Required type scm_t_int32 (ANSI C says int, short, or long might work) -if test "$ac_cv_sizeof_int" -eq 4; then - SCM_I_GSC_T_INT32='"int"' -elif test "$ac_cv_sizeof_long" -eq 4; then - SCM_I_GSC_T_INT32='"long"' -elif test "$ac_cv_sizeof_short" -eq 4; then - SCM_I_GSC_T_INT32='"short"' -elif test "$scm_stdint_has_int32"; then +if test "$scm_stdint_has_int32"; then SCM_I_GSC_T_INT32='"int32_t"' + SCM_I_GSC_T_INT32_LIMITS='"INT32"' SCM_I_GSC_NEEDS_STDINT_H=1 elif test "$scm_inttypes_has_int32"; then SCM_I_GSC_T_INT32='"int32_t"' + SCM_I_GSC_T_INT32_LIMITS='"INT32"' SCM_I_GSC_NEEDS_INTTYPES_H=1 +elif test "$ac_cv_sizeof_int" -eq 4; then + SCM_I_GSC_T_INT32='"int"' + SCM_I_GSC_T_INT32_LIMITS='"INT"' +elif test "$ac_cv_sizeof_long" -eq 4; then + SCM_I_GSC_T_INT32='"long"' + SCM_I_GSC_T_INT32_LIMITS='"LONG"' +elif test "$ac_cv_sizeof_short" -eq 4; then + SCM_I_GSC_T_INT32='"short"' + SCM_I_GSC_T_INT32_LIMITS='"SHRT"' else AC_MSG_ERROR([Can't find appropriate type for scm_t_int32.]) fi AC_SUBST([SCM_I_GSC_T_INT32]) +AC_SUBST([SCM_I_GSC_T_INT32_LIMITS]) ### Required type scm_t_uint32 (ANSI C says int, short, or long might work) -if test "$ac_cv_sizeof_unsigned_int" -eq 4; then - SCM_I_GSC_T_UINT32='"unsigned int"' -elif test "$ac_cv_sizeof_unsigned_long" -eq 4; then - SCM_I_GSC_T_UINT32='"unsigned long"' -elif test "$ac_cv_sizeof_unsigned_short" -eq 4; then - SCM_I_GSC_T_UINT32='"unsigned short"' -elif test "$scm_stdint_has_uint32"; then +if test "$scm_stdint_has_uint32"; then SCM_I_GSC_T_UINT32='"uint32_t"' + SCM_I_GSC_T_UINT32_LIMITS='"UINT32"' SCM_I_GSC_NEEDS_STDINT_H=1 elif test "$scm_inttypes_has_uint32"; then SCM_I_GSC_T_UINT32='"uint32_t"' + SCM_I_GSC_T_UINT32_LIMITS='"UINT32"' SCM_I_GSC_NEEDS_INTTYPES_H=1 +elif test "$ac_cv_sizeof_unsigned_int" -eq 4; then + SCM_I_GSC_T_UINT32='"unsigned int"' + SCM_I_GSC_T_UINT32_LIMITS='"UINT"' +elif test "$ac_cv_sizeof_unsigned_long" -eq 4; then + SCM_I_GSC_T_UINT32='"unsigned long"' + SCM_I_GSC_T_UINT32_LIMITS='"ULONG"' +elif test "$ac_cv_sizeof_unsigned_short" -eq 4; then + SCM_I_GSC_T_UINT32='"unsigned short"' + SCM_I_GSC_T_UINT32_LIMITS='"USHRT"' else AC_MSG_ERROR([Can't find appropriate type for scm_t_uint32.]) fi AC_SUBST([SCM_I_GSC_T_UINT32]) +AC_SUBST([SCM_I_GSC_T_UINT32_LIMITS]) ### Optional type scm_t_int64 (ANSI C says int, short, or long might work) ### Also try 'long long' and '__int64' if we have it. SCM_I_GSC_T_INT64=0 -if test "$ac_cv_sizeof_int" -eq 8; then - SCM_I_GSC_T_INT64='"int"' -elif test "$ac_cv_sizeof_long" -eq 8; then - SCM_I_GSC_T_INT64='"long"' -elif test "$ac_cv_sizeof_short" -eq 8; then - SCM_I_GSC_T_INT64='"short"' -elif test "$ac_cv_sizeof_long_long" -eq 8; then - SCM_I_GSC_T_INT64='"long long"' -elif test "$ac_cv_sizeof___int64" -eq 8; then - SCM_I_GSC_T_INT64='"__int64"' -elif test "$scm_stdint_has_int64"; then +if test "$scm_stdint_has_int64"; then SCM_I_GSC_T_INT64='"int64_t"' + SCM_I_GSC_T_INT64_LIMITS='"INT64"' SCM_I_GSC_NEEDS_STDINT_H=1 elif test "$scm_inttypes_has_int64"; then SCM_I_GSC_T_INT64='"int64_t"' + SCM_I_GSC_T_INT64_LIMITS='"INT64"' SCM_I_GSC_NEEDS_INTTYPES_H=1 +elif test "$ac_cv_sizeof_int" -eq 8; then + SCM_I_GSC_T_INT64='"int"' + SCM_I_GSC_T_INT64_LIMITS='"INT"' +elif test "$ac_cv_sizeof_long" -eq 8; then + SCM_I_GSC_T_INT64='"long"' + SCM_I_GSC_T_INT64_LIMITS='"LONG"' +elif test "$ac_cv_sizeof_short" -eq 8; then + SCM_I_GSC_T_INT64='"short"' + SCM_I_GSC_T_INT64_LIMITS='"SHRT"' +elif test "$ac_cv_sizeof_long_long" -eq 8; then + SCM_I_GSC_T_INT64='"long long"' + SCM_I_GSC_T_INT64_LIMITS='"SCM_I_LLONG"' +elif test "$ac_cv_sizeof___int64" -eq 8; then + SCM_I_GSC_T_INT64='"__int64"' + SCM_I_GSC_T_INT64_LIMITS='"unknown"' else AC_MSG_ERROR([Can't find appropriate type for scm_t_int64.]) fi AC_SUBST([SCM_I_GSC_T_INT64]) +AC_SUBST([SCM_I_GSC_T_INT64_LIMITS]) + ### Optional type scm_t_uint64 (ANSI C says int, short, or long might work) ### Also try 'long long' and '__int64' if we have it. SCM_I_GSC_T_UINT64=0 -if test "$ac_cv_sizeof_unsigned_int" -eq 8; then - SCM_I_GSC_T_UINT64='"unsigned int"' -elif test "$ac_cv_sizeof_unsigned_long" -eq 8; then - SCM_I_GSC_T_UINT64='"unsigned long"' -elif test "$ac_cv_sizeof_unsigned_short" -eq 8; then - SCM_I_GSC_T_UINT64='"unsigned short"' -elif test "$ac_cv_sizeof_unsigned_long_long" -eq 8; then - SCM_I_GSC_T_UINT64='"unsigned long long"' -elif test "$ac_cv_sizeof_unsigned___int64" -eq 8; then - SCM_I_GSC_T_UINT64='"unsigned __int64"' -elif test "$scm_stdint_has_uint64"; then +if test "$scm_stdint_has_uint64"; then SCM_I_GSC_T_UINT64='"uint64_t"' + SCM_I_GSC_T_UINT64_LIMITS='"UINT64"' SCM_I_GSC_NEEDS_STDINT_H=1 elif test "$scm_inttypes_has_uint64"; then SCM_I_GSC_T_UINT64='"uint64_t"' + SCM_I_GSC_T_UINT64_LIMITS='"UINT64"' SCM_I_GSC_NEEDS_INTTYPES_H=1 +elif test "$ac_cv_sizeof_unsigned_int" -eq 8; then + SCM_I_GSC_T_UINT64='"unsigned int"' + SCM_I_GSC_T_UINT64_LIMITS='"UINT"' +elif test "$ac_cv_sizeof_unsigned_long" -eq 8; then + SCM_I_GSC_T_UINT64='"unsigned long"' + SCM_I_GSC_T_UINT64_LIMITS='"ULONG"' +elif test "$ac_cv_sizeof_unsigned_short" -eq 8; then + SCM_I_GSC_T_UINT64='"unsigned short"' + SCM_I_GSC_T_UINT64_LIMITS='"USHRT"' +elif test "$ac_cv_sizeof_unsigned_long_long" -eq 8; then + SCM_I_GSC_T_UINT64='"unsigned long long"' + SCM_I_GSC_T_UINT64_LIMITS='"SCM_I_ULLONG"' +elif test "$ac_cv_sizeof_unsigned___int64" -eq 8; then + SCM_I_GSC_T_UINT64='"unsigned __int64"' + SCM_I_GSC_T_UINT64_LIMITS='"unknown"' else AC_MSG_ERROR([Can't find appropriate type for scm_t_uint64.]) fi AC_SUBST([SCM_I_GSC_T_UINT64]) +AC_SUBST([SCM_I_GSC_T_UINT64_LIMITS]) ### Required type scm_t_intmax ### @@ -474,18 +520,24 @@ AC_SUBST([SCM_I_GSC_T_UINT64]) SCM_I_GSC_T_INTMAX=0 if test "$scm_stdint_has_intmax"; then SCM_I_GSC_T_INTMAX='"intmax_t"' + SCM_I_GSC_T_INTMAX_LIMITS='"INTMAX"' SCM_I_GSC_NEEDS_STDINT_H=1 elif test "$scm_inttypes_has_intmax"; then SCM_I_GSC_T_INTMAX='"intmax_t"' + SCM_I_GSC_T_INTMAX_LIMITS='"INTMAX"' SCM_I_GSC_NEEDS_INTTYPES_H=1 elif test "$ac_cv_sizeof___int64" -ne 0; then SCM_I_GSC_T_INTMAX='"__int64"' + SCM_I_GSC_T_INTMAX_LIMITS='"unknown"' elif test "$ac_cv_sizeof_long_long" -ne 0; then SCM_I_GSC_T_INTMAX='"long long"' + SCM_I_GSC_T_INTMAX_LIMITS='"SCM_I_LLONG"' else SCM_I_GSC_T_INTMAX='"long"' + SCM_I_GSC_T_INTMAX_LIMITS='"LONG"' fi AC_SUBST([SCM_I_GSC_T_INTMAX]) +AC_SUBST([SCM_I_GSC_T_INTMAX_LIMITS]) ### Required type scm_t_uintmax ### @@ -495,18 +547,24 @@ AC_SUBST([SCM_I_GSC_T_INTMAX]) SCM_I_GSC_T_UINTMAX=0 if test "$scm_stdint_has_uintmax"; then SCM_I_GSC_T_UINTMAX='"uintmax_t"' + SCM_I_GSC_T_UINTMAX_LIMITS='"UINTMAX"' SCM_I_GSC_NEEDS_STDINT_H=1 elif test "$scm_inttypes_has_uintmax"; then SCM_I_GSC_T_UINTMAX='"uintmax_t"' + SCM_I_GSC_T_UINTMAX_LIMITS='"UINTMAX"' SCM_I_GSC_NEEDS_INTTYPES_H=1 elif test "$ac_cv_sizeof_unsigned___int64" -ne 0; then SCM_I_GSC_T_UINTMAX='"unsigned __int64"' + SCM_I_GSC_T_UINTMAX_LIMITS='"unknown"' elif test "$ac_cv_sizeof_unsigned_long_long" -ne 0; then SCM_I_GSC_T_UINTMAX='"unsigned long long"' + SCM_I_GSC_T_INTMAX_LIMITS='"SCM_I_ULLONG"' else SCM_I_GSC_T_UINTMAX='"unsigned long"' + SCM_I_GSC_T_INTMAX_LIMITS='"ULONG"' fi AC_SUBST([SCM_I_GSC_T_UINTMAX]) +AC_SUBST([SCM_I_GSC_T_UINTMAX_LIMITS]) AC_SUBST([SCM_I_GSC_NEEDS_STDINT_H]) From e5b8d4ddba878803603f9d69e14e644a144ea177 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 7 Jul 2004 15:16:20 +0000 Subject: [PATCH 39/58] Added all the new SCM_I_GSC_*_LIMITS that configure now produces. --- libguile/gen-scmconfig.h.in | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/libguile/gen-scmconfig.h.in b/libguile/gen-scmconfig.h.in index f48288672..9f6fbdb92 100644 --- a/libguile/gen-scmconfig.h.in +++ b/libguile/gen-scmconfig.h.in @@ -16,15 +16,25 @@ #define SCM_I_GSC_NEEDS_STDINT_H @SCM_I_GSC_NEEDS_STDINT_H@ #define SCM_I_GSC_NEEDS_INTTYPES_H @SCM_I_GSC_NEEDS_INTTYPES_H@ #define SCM_I_GSC_T_INT8 @SCM_I_GSC_T_INT8@ +#define SCM_I_GSC_T_INT8_LIMITS @SCM_I_GSC_T_INT8_LIMITS@ #define SCM_I_GSC_T_UINT8 @SCM_I_GSC_T_UINT8@ +#define SCM_I_GSC_T_UINT8_LIMITS @SCM_I_GSC_T_UINT8_LIMITS@ #define SCM_I_GSC_T_INT16 @SCM_I_GSC_T_INT16@ +#define SCM_I_GSC_T_INT16_LIMITS @SCM_I_GSC_T_INT16_LIMITS@ #define SCM_I_GSC_T_UINT16 @SCM_I_GSC_T_UINT16@ +#define SCM_I_GSC_T_UINT16_LIMITS @SCM_I_GSC_T_UINT16_LIMITS@ #define SCM_I_GSC_T_INT32 @SCM_I_GSC_T_INT32@ +#define SCM_I_GSC_T_INT32_LIMITS @SCM_I_GSC_T_INT32_LIMITS@ #define SCM_I_GSC_T_UINT32 @SCM_I_GSC_T_UINT32@ +#define SCM_I_GSC_T_UINT32_LIMITS @SCM_I_GSC_T_UINT32_LIMITS@ #define SCM_I_GSC_T_INT64 @SCM_I_GSC_T_INT64@ +#define SCM_I_GSC_T_INT64_LIMITS @SCM_I_GSC_T_INT64_LIMITS@ #define SCM_I_GSC_T_UINT64 @SCM_I_GSC_T_UINT64@ +#define SCM_I_GSC_T_UINT64_LIMITS @SCM_I_GSC_T_UINT64_LIMITS@ #define SCM_I_GSC_T_INTMAX @SCM_I_GSC_T_INTMAX@ +#define SCM_I_GSC_T_INTMAX_LIMITS @SCM_I_GSC_T_INTMAX_LIMITS@ #define SCM_I_GSC_T_UINTMAX @SCM_I_GSC_T_UINTMAX@ +#define SCM_I_GSC_T_UINTMAX_LIMITS @SCM_I_GSC_T_UINTMAX_LIMITS@ #define SCM_I_GSC_T_PTRDIFF @SCM_I_GSC_T_PTRDIFF@ #define SCM_I_GSC_USE_PTHREAD_THREADS @SCM_I_GSC_USE_PTHREAD_THREADS@ #define SCM_I_GSC_USE_NULL_THREADS @SCM_I_GSC_USE_NULL_THREADS@ From 76bd98fa1676c7d3e6da43cba0537b161392f643 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 7 Jul 2004 15:18:31 +0000 Subject: [PATCH 40/58] * gen-scmconfig.h.in: Added all the new SCM_I_GSC_*_LIMITS that configure now produces. * gen-scmconfig.c: Use them to output SCM_T_INT8_MIN, etc definitions, giving the limits of the integer types defined by Guile. Also, output a hard coded SCM_I_LLONG_MIN, etc since LLONG_MIN or LONG_LONG_MIN is hard to get at. --- libguile/gen-scmconfig.c | 35 +++++++++++++++++++++++++++++++++++ 1 file changed, 35 insertions(+) diff --git a/libguile/gen-scmconfig.c b/libguile/gen-scmconfig.c index 3fd2df569..f44517f69 100644 --- a/libguile/gen-scmconfig.c +++ b/libguile/gen-scmconfig.c @@ -277,6 +277,24 @@ main (int argc, char *argv[]) pf ("#define SCM_SIZEOF_LONG_LONG %d\n", SIZEOF_LONG_LONG); pf ("#define SCM_SIZEOF_UNSIGNED_LONG_LONG %d\n", SIZEOF_UNSIGNED_LONG_LONG); + if (SIZEOF_LONG_LONG == 8) + { + pf ("\n"); + pf ("/* The limits of long long are not readily available without\n"); + pf (" defining _GNU_SOURCE (which we can't do in a header) or\n"); + pf (" being on a C99 system (which we can't rely on yet). Thus,\n"); + pf (" we hardcode the limits here.\n"); + pf ("*/\n"); + pf ("#define SCM_I_LLONG_MAX 9223372036854775807LL\n"); + pf ("#define SCM_I_LLONG_MIN (-SCM_I_LLONG_MAX-1LL)\n"); + pf ("#define SCM_I_ULLONG_MAX 18446744073709551615ULL\n"); + } + else if (SIZEOF_LONG_LONG != 0) + { + fprintf (stderr, "gen-scmconfig: long long is not 64 bits, FIX ME.\n"); + return 1; + } + pf("\n"); pf("/* handling for the deprecated long_long and ulong_long types */\n"); pf("/* If anything suitable is available, it'll be defined here. */\n"); @@ -303,6 +321,16 @@ main (int argc, char *argv[]) pf ("typedef %s scm_t_intmax;\n", SCM_I_GSC_T_INTMAX); pf ("typedef %s scm_t_uintmax;\n", SCM_I_GSC_T_UINTMAX); + pf ("#define SCM_T_INT8_MIN %s_MIN\n", SCM_I_GSC_T_INT8_LIMITS); + pf ("#define SCM_T_INT8_MAX %s_MAX\n", SCM_I_GSC_T_INT8_LIMITS); + pf ("#define SCM_T_UINT8_MAX %s_MAX\n", SCM_I_GSC_T_UINT8_LIMITS); + pf ("#define SCM_T_INT16_MIN %s_MIN\n", SCM_I_GSC_T_INT16_LIMITS); + pf ("#define SCM_T_INT16_MAX %s_MAX\n", SCM_I_GSC_T_INT16_LIMITS); + pf ("#define SCM_T_UINT16_MAX %s_MAX\n", SCM_I_GSC_T_UINT16_LIMITS); + pf ("#define SCM_T_INT32_MIN %s_MIN\n", SCM_I_GSC_T_INT32_LIMITS); + pf ("#define SCM_T_INT32_MAX %s_MAX\n", SCM_I_GSC_T_INT32_LIMITS); + pf ("#define SCM_T_UINT32_MAX %s_MAX\n", SCM_I_GSC_T_UINT32_LIMITS); + pf ("\n"); pf ("/* 64-bit integer -- if available SCM_HAVE_T_INT64 will be 1 and\n" " scm_t_int64 will be a suitable type, otherwise SCM_HAVE_T_INT64\n" @@ -311,6 +339,8 @@ main (int argc, char *argv[]) { pf ("#define SCM_HAVE_T_INT64 1 /* 0 or 1 */\n"); pf ("typedef %s scm_t_int64;\n", SCM_I_GSC_T_INT64); + pf ("#define SCM_T_INT64_MIN %s_MIN\n", SCM_I_GSC_T_INT64_LIMITS); + pf ("#define SCM_T_INT64_MAX %s_MAX\n", SCM_I_GSC_T_INT64_LIMITS); } else pf ("#define SCM_HAVE_T_INT64 0 /* 0 or 1 */\n"); @@ -323,10 +353,15 @@ main (int argc, char *argv[]) { pf ("#define SCM_HAVE_T_UINT64 1 /* 0 or 1 */\n"); pf ("typedef %s scm_t_uint64;\n", SCM_I_GSC_T_UINT64); + pf ("#define SCM_T_UINT64_MAX %s_MAX\n", SCM_I_GSC_T_UINT64_LIMITS); } else pf ("#define SCM_HAVE_T_UINT64 0 /* 0 or 1 */\n"); + pf ("#define SCM_T_INTMAX_MIN %s_MIN\n", SCM_I_GSC_T_INTMAX_LIMITS); + pf ("#define SCM_T_INTMAX_MAX %s_MAX\n", SCM_I_GSC_T_INTMAX_LIMITS); + pf ("#define SCM_T_UINTMAX_MAX %s_MAX\n", SCM_I_GSC_T_UINTMAX_LIMITS); + pf ("\n"); pf ("/* scm_t_ptrdiff_t and size, always defined -- defined to long if\n" " platform doesn't have ptrdiff_t. */\n"); From 22008a78041b4b4cd2bd77f425afc5136b46438b Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 7 Jul 2004 15:22:56 +0000 Subject: [PATCH 41/58] (scm_to_short, scm_to_ushort): It's SHRT_MIN, etc, not SHORT_MIN. (scm_to_size_t): Use SIZE_MAX instead of cooking our own. (scm_to_long_long, scm_to_ulong_long, scm_to_int8, scm_to_uint8, scm_to_int16, scm_to_uint16, scm_to_int32, scm_to_uint32, scm_to_int64, scm_to_uint64, scm_to_intmax, scm_to_uintmax, scm_from_long_long, scm_from_ulong_long, scm_from_int8, scm_from_uint8, scm_from_int16, scm_from_uint16, scm_from_int32, scm_from_uint32, scm_from_int64, scm_from_uint64, scm_from_intmax, scm_from_uintmax): New. --- libguile/numbers.h | 62 +++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 59 insertions(+), 3 deletions(-) diff --git a/libguile/numbers.h b/libguile/numbers.h index 59b755e9a..af1f9252a 100644 --- a/libguile/numbers.h +++ b/libguile/numbers.h @@ -367,9 +367,9 @@ SCM_API scm_t_uintmax scm_to_unsigned_integer (SCM val, #endif #define scm_to_short(x) \ - ((short)scm_to_signed_integer ((x), SHORT_MIN, SHORT_MAX)) + ((short)scm_to_signed_integer ((x), SHRT_MIN, SHRT_MAX)) #define scm_to_ushort(x) \ - ((unsigned short)scm_to_unsigned_integer ((x), 0, SHORT_MAX)) + ((unsigned short)scm_to_unsigned_integer ((x), 0, SHRT_MAX)) #define scm_to_int(x) \ ((int)scm_to_signed_integer ((x), INT_MIN, INT_MAX)) @@ -384,7 +384,41 @@ SCM_API scm_t_uintmax scm_to_unsigned_integer (SCM val, #define scm_to_ssize_t(x) \ ((ssize_t)scm_to_signed_integer ((x), -SSIZE_MAX-1, SSIZE_MAX)) #define scm_to_size_t(x) \ - ((unsigned long)scm_to_unsigned_integer ((x), 0, (~(size_t)0))) + ((unsigned long)scm_to_unsigned_integer ((x), 0, SIZE_MAX)) + +#if SCM_SIZEOF_LONG_LONG != 0 +#define scm_to_long_long(x) \ + ((long long)scm_to_signed_integer ((x), SCM_I_LLONG_MIN, SCM_I_LLONG_MAX)) +#define scm_to_ulong_long(x) \ + ((unsigned long long)scm_to_unsigned_integer ((x), 0, SCM_I_ULLONG_MAX)) +#endif + +#define scm_to_int8(x) \ + ((scm_t_int8)scm_to_signed_integer ((x), SCM_T_INT8_MIN, SCM_T_INT8_MAX)) +#define scm_to_uint8(x) \ + ((scm_t_uint8)scm_to_unsigned_integer ((x), 0, SCM_T_UINT8_MAX)) + +#define scm_to_int16(x) \ + ((scm_t_int16)scm_to_signed_integer ((x), SCM_T_INT16_MIN, SCM_T_INT16_MAX)) +#define scm_to_uint16(x) \ + ((scm_t_uint16)scm_to_unsigned_integer ((x), 0, SCM_T_UINT16_MAX)) + +#define scm_to_int32(x) \ + ((scm_t_int32)scm_to_signed_integer ((x), SCM_T_INT32_MIN, SCM_T_INT32_MAX)) +#define scm_to_uint32(x) \ + ((scm_t_uint32)scm_to_unsigned_integer ((x), 0, SCM_T_UINT32_MAX)) + +#if SCM_HAVE_T_INT64 +#define scm_to_int64(x) \ + ((scm_t_int64)scm_to_signed_integer ((x), SCM_T_INT64_MIN, SCM_T_INT64_MAX)) +#define scm_to_uint64(x) \ + ((scm_t_uint64)scm_to_unsigned_integer ((x), 0, SCM_T_UINT64_MAX)) +#endif + +#define scm_to_intmax(x) \ + ((scm_t_intmax)scm_to_signed_integer ((x),SCM_T_INTMAX_MIN,SCM_T_INTMAX_MAX)) +#define scm_to_uintmax(x) \ + ((scm_t_uintmax)scm_to_unsigned_integer ((x), 0, SCM_T_UINTMAX_MAX)) #define scm_from_schar(x) scm_from_signed_integer ((signed char)(x)) #define scm_from_uchar(x) scm_from_unsigned_integer ((unsigned char)(x)) @@ -406,6 +440,28 @@ SCM_API scm_t_uintmax scm_to_unsigned_integer (SCM val, #define scm_from_ssize_t(x) scm_from_signed_integer ((ssize_t)(x)) #define scm_from_size_t(x) scm_from_unsigned_integer ((size_t)(x)) +#if SCM_SIZEOF_LONG_LONG != 0 +#define scm_from_long_long(x) scm_from_signed_integer ((long long)(x)) +#define scm_from_ulong_long(x) scm_from_unsigned_integer ((unsigned long long)(x)) +#endif + +#define scm_from_int8(x) scm_from_signed_integer ((scm_t_int8)(x)) +#define scm_from_uint8(x) scm_from_unsigned_integer ((scm_t_uint8)(x)) + +#define scm_from_int16(x) scm_from_signed_integer ((scm_t_int16)(x)) +#define scm_from_uint16(x) scm_from_unsigned_integer ((scm_t_uint16)(x)) + +#define scm_from_int32(x) scm_from_signed_integer ((scm_t_int32)(x)) +#define scm_from_uint32(x) scm_from_unsigned_integer ((scm_t_uint32)(x)) + +#if SCM_HAVE_T_INT64 +#define scm_from_int64(x) scm_from_signed_integer ((scm_t_int64)(x)) +#define scm_from_uint64(x) scm_from_unsigned_integer ((scm_t_uint64)(x)) +#endif + +#define scm_from_intmax(x) scm_from_signed_integer ((scm_t_intmax)(x)) +#define scm_from_uintmax(x) scm_from_unsigned_integer ((scm_t_uintmax)(x)) + SCM_API int scm_is_real (SCM val); SCM_API double scm_to_double (SCM val); SCM_API SCM scm_from_double (double val); From afdb04ef18116d1bfdc0e71925de26b3f73d90d1 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 7 Jul 2004 15:25:23 +0000 Subject: [PATCH 42/58] Don't define SCM_T_INTMAX_MIN, etc, they are now provided by libuile.h. (test_int_sizes): New. --- test-suite/standalone/test-conversion.c | 107 +++++++++++++++++------- 1 file changed, 77 insertions(+), 30 deletions(-) diff --git a/test-suite/standalone/test-conversion.c b/test-suite/standalone/test-conversion.c index d36f37350..6c718bf81 100644 --- a/test-suite/standalone/test-conversion.c +++ b/test-suite/standalone/test-conversion.c @@ -20,11 +20,6 @@ #include #include -#define SCM_T_UINTMAX_MAX (~(scm_t_uintmax)0) -#define SCM_T_UINTMAX_MIN ((scm_t_uintmax)0) -#define SCM_T_INTMAX_MAX ((scm_t_intmax)(SCM_T_UINTMAX_MAX/2)) -#define SCM_T_INTMAX_MIN (~SCM_T_INTMAX_MAX) - static void test_1 (const char *str, scm_t_intmax min, scm_t_intmax max, int result) @@ -124,42 +119,42 @@ static void test_is_unsigned_integer () { test_2 ("'foo", - SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX, + 0, SCM_T_UINTMAX_MAX, 0); test_2 ("3.0", - SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX, + 0, SCM_T_UINTMAX_MAX, 1); test_2 ("3.5", - SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX, + 0, SCM_T_UINTMAX_MAX, 0); test_2 ("most-positive-fixnum", - SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX, + 0, SCM_T_UINTMAX_MAX, 1); test_2 ("(+ most-positive-fixnum 1)", - SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX, + 0, SCM_T_UINTMAX_MAX, 1); test_2 ("most-negative-fixnum", - SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX, + 0, SCM_T_UINTMAX_MAX, 0); test_2 ("(- most-negative-fixnum 1)", - SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX, + 0, SCM_T_UINTMAX_MAX, 0); if (sizeof (scm_t_intmax) == 8) { test_2 ("(- (expt 2 64) 1)", - SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX, + 0, SCM_T_UINTMAX_MAX, 1); test_2 ("(expt 2 64)", - SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX, + 0, SCM_T_UINTMAX_MAX, 0); } else if (sizeof (scm_t_intmax) == 4) { test_2 ("(- (expt 2 32) 1)", - SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX, + 0, SCM_T_UINTMAX_MAX, 1); test_2 ("(expt 2 32)", - SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX, + 0, SCM_T_UINTMAX_MAX, 0); } else @@ -393,39 +388,39 @@ static void test_to_unsigned_integer () { test_4 ("'foo", - SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX, + 0, SCM_T_UINTMAX_MAX, 0, 0, 1); test_4 ("3.5", - SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX, + 0, SCM_T_UINTMAX_MAX, 0, 0, 1); test_4 ("12", - SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX, + 0, SCM_T_UINTMAX_MAX, 12, 0, 0); test_4 ("1000", 0, 999, 0, 1, 0); test_4 ("most-positive-fixnum", - SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX, + 0, SCM_T_UINTMAX_MAX, SCM_MOST_POSITIVE_FIXNUM, 0, 0); test_4 ("(+ most-positive-fixnum 1)", - SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX, + 0, SCM_T_UINTMAX_MAX, SCM_MOST_POSITIVE_FIXNUM+1, 0, 0); if (sizeof (scm_t_intmax) == 8) { test_4 ("(- (expt 2 64) 1)", - SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX, + 0, SCM_T_UINTMAX_MAX, SCM_T_UINTMAX_MAX, 0, 0); test_4 ("(expt 2 64)", - SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX, + 0, SCM_T_UINTMAX_MAX, 0, 1, 0); } else if (sizeof (scm_t_intmax) == 4) { test_4 ("(- (expt 2 32) 1)", - SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX, + 0, SCM_T_UINTMAX_MAX, SCM_T_UINTMAX_MAX, 0, 0); test_4 ("(expt 2 32)", - SCM_T_UINTMAX_MIN, SCM_T_UINTMAX_MAX, + 0, SCM_T_UINTMAX_MAX, 0, 1, 0); } else @@ -470,11 +465,6 @@ test_6 (scm_t_uintmax val, const char *result) SCM res = scm_c_eval_string (result); if (scm_is_false (scm_equal_p (scm_from_unsigned_integer (val), res))) { - scm_write (scm_from_unsigned_integer (val), SCM_UNDEFINED); - scm_newline (SCM_UNDEFINED); - scm_write (res, SCM_UNDEFINED); - scm_newline (SCM_UNDEFINED); - fprintf (stderr, "fail: scm_from_unsigned_integer (%Lu) == %s\n", val, result); exit (1); @@ -497,6 +487,62 @@ test_from_unsigned_integer () test_6 (SCM_MOST_POSITIVE_FIXNUM+1, "(+ most-positive-fixnum 1)"); } +static void +test_int_sizes () +{ + SCM n = scm_from_int (91); + + /* Just list them here to check whether the macros expand to correct + code. */ + + scm_from_schar (91); + scm_from_uchar (91); + scm_from_char (91); + scm_from_short (91); + scm_from_int (91); + scm_from_long (91); +#if SCM_SIZEOF_LONG_LONG != 0 + scm_from_long_long (91); + scm_from_ulong_long (91); +#endif + scm_from_size_t (91); + scm_from_ssize_t (91); + scm_from_int8 (91); + scm_from_uint8 (91); + scm_from_int16 (91); + scm_from_uint16 (91); + scm_from_int32 (91); + scm_from_uint32 (91); +#if SCM_HAVE_T_INT64 + scm_from_int64 (91); + scm_from_uint64 (91); +#endif + + scm_to_schar (n); + scm_to_uchar (n); + scm_to_char (n); + scm_to_short (n); + scm_to_int (n); + scm_to_long (n); +#if SCM_SIZEOF_LONG_LONG != 0 + scm_to_long_long (n); + scm_to_ulong_long (n); +#endif + scm_to_size_t (n); + scm_to_ssize_t (n); + scm_to_int8 (n); + scm_to_uint8 (n); + scm_to_int16 (n); + scm_to_uint16 (n); + scm_to_int32 (n); + scm_to_uint32 (n); +#if SCM_HAVE_T_INT64 + scm_to_int64 (n); + scm_to_uint64 (n); +#endif + +} + int main (int argc, char *argv[]) { @@ -507,5 +553,6 @@ main (int argc, char *argv[]) test_to_unsigned_integer (); test_from_signed_integer (); test_from_unsigned_integer (); + test_int_sizes (); return 0; } From c9eb03bb73fcbcf8dc5c4caef8926e523c2be58f Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 7 Jul 2004 15:27:21 +0000 Subject: [PATCH 43/58] *** empty log message *** --- ChangeLog | 7 +++++++ libguile/ChangeLog | 20 ++++++++++++++++++++ test-suite/ChangeLog | 6 ++++++ 3 files changed, 33 insertions(+) diff --git a/ChangeLog b/ChangeLog index e5118a539..182f13558 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,10 @@ +2004-07-07 Marius Vollmer + + * configure.in: When checking for suitable types for scm_t_int8, + etc, try int8_t first, so that we pick them up when they are + defined. Also, substitute limit macros like INT8_MIN into the + configure header for all these types. + 2004-07-05 Kevin Ryde * configure.in (isinf, isnan): Detect macro versions as well as diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 471f4f7e9..b0ef8e47a 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,23 @@ +2004-07-07 Marius Vollmer + + * gen-scmconfig.h.in: Added all the new SCM_I_GSC_*_LIMITS that + configure now produces. + * gen-scmconfig.c: Use them to output SCM_T_INT8_MIN, etc + definitions, giving the limits of the integer types defined by + Guile. Also, output a hard coded SCM_I_LLONG_MIN, etc since + LLONG_MIN or LONG_LONG_MIN is hard to get at. + + * numbers.h (scm_to_short, scm_to_ushort): It's SHRT_MIN, etc, not + SHORT_MIN. + (scm_to_size_t): Use SIZE_MAX instead of cooking our own. + (scm_to_long_long, scm_to_ulong_long, scm_to_int8, scm_to_uint8, + scm_to_int16, scm_to_uint16, scm_to_int32, scm_to_uint32, + scm_to_int64, scm_to_uint64, scm_to_intmax, scm_to_uintmax, + scm_from_long_long, scm_from_ulong_long, scm_from_int8, + scm_from_uint8, scm_from_int16, scm_from_uint16, scm_from_int32, + scm_from_uint32, scm_from_int64, scm_from_uint64, scm_from_intmax, + scm_from_uintmax): New. + 2004-07-06 Marius Vollmer * tags.h (scm_is_eq): New. diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog index 2b67516ab..690b5d3e2 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -1,3 +1,9 @@ +2004-07-07 Marius Vollmer + + * standalone/test-conversion.c: Don't define SCM_T_INTMAX_MIN, + etc, they are now provided by libuile.h. + (test_int_sizes): New. + 2004-07-06 Marius Vollmer * standalone/test-num2integral.c, standalone/test-unwind.c: From e63a059cce45752fcce38cbccd8d55dbd657c051 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 7 Jul 2004 15:32:02 +0000 Subject: [PATCH 44/58] Remove superflous @end example. --- doc/ref/gh.texi | 1 - 1 file changed, 1 deletion(-) diff --git a/doc/ref/gh.texi b/doc/ref/gh.texi index 59c8ca6f4..457e257d0 100644 --- a/doc/ref/gh.texi +++ b/doc/ref/gh.texi @@ -1076,7 +1076,6 @@ scm_is_true (scm_exact_p (@var{obj})) @item @code{gh_eq_p} Use @code{scm_is_eq} instead. -@end example @item @code{gh_eqv_p} Replace @code{gh_eqv_p (@var{x}, @var{y})} by From 4e2b1f342dadacbefb752c28b60ed089bbe8d8cc Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 7 Jul 2004 15:39:21 +0000 Subject: [PATCH 45/58] * scheme-data.texi (Integers): Added docs for the new scm_is_, scm_to_ and scm_from_ functions for integers. --- doc/ref/scheme-data.texi | 123 ++++++++++++++++++++++++++++++++++++++- 1 file changed, 121 insertions(+), 2 deletions(-) diff --git a/doc/ref/scheme-data.texi b/doc/ref/scheme-data.texi index ef5789877..3cf12e953 100755 --- a/doc/ref/scheme-data.texi +++ b/doc/ref/scheme-data.texi @@ -304,8 +304,17 @@ The infinities @samp{+inf.0} and @samp{-inf.0} are considered to be inexact integers. They are explained in detail in the next section, together with reals and rationals. -@c REFFIXME Maybe point here to discussion of handling immediates/bignums -@c on the C level, where the conversion is not so automatic - NJ +C has a host of different integer types, and Guile offers a host of +functions to convert between them and the @code{SCM} representation. +For example, a C @code{int} can be handled with @code{scm_to_int} and +@code{scm_from_int}. Guile also defines a few C integer types of its +own, to help with differences between systems. + + C integer types that are not covered can be +handled with the generic @code{scm_to_signed_integer} and +@code{scm_from_signed_integer} for signed types, or with +@code{scm_to_unsigned_integer} and @code{scm_from_unsigned_integer} +for unsigned types. @deffn {Scheme Procedure} integer? x @deffnx {C Function} scm_integer_p (x) @@ -323,6 +332,116 @@ Return @code{#t} if @var{x} is an integer number, else @code{#f}. @end lisp @end deffn +@deftypefn {C Function} int scm_is_integer (SCM x) +This is equivalent to @code{scm_is_true (scm_integer_p (x))}. +@end deftypefn + +@defvr {C Type} scm_t_int8 +@defvrx {C Type} scm_t_uint8 +@defvrx {C Type} scm_t_int16 +@defvrx {C Type} scm_t_uint16 +@defvrx {C Type} scm_t_int32 +@defvrx {C Type} scm_t_uint32 +@defvrx {C Type} scm_t_int64 +@defvrx {C Type} scm_t_uint64 +@defvrx {C Type} scm_t_intmax +@defvrx {C Type} scm_t_uintmax +The C types are equivalent to the corresponding ISO C types but are +defined on all platforms, with the exception of @code{scm_t_int64} and +@code{scm_t_uint64}, which are only defined when a 64-bit type is +available. For example, @code{scm_t_int8} is equivalent to +@code{int8_t}. + +You can regard these definitions as a stop-gap measure until all +platforms provide these types. If you know that all the platforms +that you are interested in already provide these types, it is better +to use them directly instead of the types provided by Guile. +@end defvr + +@deftypefn {C Function} int scm_is_signed_integer (SCM x, scm_t_intmax min, scm_t_intmax max) +@deftypefnx {C Function} int scm_is_unsigned_integer (SCM x, scm_t_uintmax min, scm_t_uintmax max) +Return @code{1} when @var{x} represents an integer that is between +@var{min} and @var{max}, inclusive. + +These functions can be used to check whether a @code{SCM} value will +fit into a given range, such as the range of a given C integer type. +If you just want to convert a @code{SCM} value to a given C integer +type, use one of the conversion functions directly. +@end deftypefn + +@deftypefn {C Function} scm_t_intmax scm_to_signed_integer (SCM x, scm_t_intmax min, scm_t_intmax max) +@deftypefnx {C Function} scm_t_uintmax scm_to_unsigned_integer (SCM x, scm_t_uintmax min, scm_t_uintmax max) +When @var{x} represents an integer that is between @var{min} and +@var{max} inclusive, return that integer. Else signal an error, +either a `wrong-type' error when @var{x} is not an integer, or an +`out-of-range' error when it doesn't fit the given range. +@end deftypefn + +@deftypefn {C Function} SCM scm_from_signed_integer (scm_t_intmax x) +@deftypefnx {C Function} SCM scm_from_unsigned_integer (scm_t_uintmax x) +Return the @code{SCM} value that represents the integer @var{x}. +This function will always succeed. +@end deftypefn + +@deftypefn {C Function} char scm_to_char (SCM x) +@deftypefnx {C Function} {signed char} scm_to_schar (SCM x) +@deftypefnx {C Function} {unsigned char} scm_to_uchar (SCM x) +@deftypefnx {C Function} short scm_to_short (SCM x) +@deftypefnx {C Function} {unsigned short} scm_to_ushort (SCM x) +@deftypefnx {C Function} int scm_to_int (SCM x) +@deftypefnx {C Function} {unsigned int} scm_to_uint (SCM x) +@deftypefnx {C Function} long scm_to_long (SCM x) +@deftypefnx {C Function} {unsigned long} scm_to_ulong (SCM x) +@deftypefnx {C Function} long long scm_to_long_long (SCM x) +@deftypefnx {C Function} {unsigned long long} scm_to_ulong_long (SCM x) +@deftypefnx {C Function} size_t scm_to_size_t (SCM x) +@deftypefnx {C Function} ssize_t scm_to_ssize_t (SCM x) +@deftypefnx {C Function} scm_t_int8 scm_to_int8 (SCM x) +@deftypefnx {C Function} scm_t_uint8 scm_to_uint8 (SCM x) +@deftypefnx {C Function} scm_t_int16 scm_to_int16 (SCM x) +@deftypefnx {C Function} scm_t_uint16 scm_to_uint16 (SCM x) +@deftypefnx {C Function} scm_t_int32 scm_to_int32 (SCM x) +@deftypefnx {C Function} scm_t_uint32 scm_to_uint32 (SCM x) +@deftypefnx {C Function} scm_t_int64 scm_to_int64 (SCM x) +@deftypefnx {C Function} scm_t_uint64 scm_to_uint64 (SCM x) +@deftypefnx {C Function} scm_t_intmax scm_to_intmax (SCM x) +@deftypefnx {C Function} scm_t_uintmax scm_to_uintmax (SCM x) +When @var{x} represents an integer that fits into the indicated C +type, return that integer. Else signal an error, either a +`wrong-type' error when @var{x} is not an integer, or an +`out-of-range' error when it doesn't fit the given range. + +The functions @code{scm_to_long_long}, @code{scm_to_ulong_long}, +@code{scm_to_int64}, and @code{scm_to_uint64} are only available when +the corresponding types are. +@end deftypefn + +@deftypefn {C Function} SCM scm_from_char (char x) +@deftypefnx {C Function} SCM scm_from_schar (signed char x) +@deftypefnx {C Function} SCM scm_from_uchar (unsigned char x) +@deftypefnx {C Function} SCM scm_from_short (short x) +@deftypefnx {C Function} SCM scm_from_ushort (unsigned short x) +@deftypefnx {C Function} SCM scm_from_int (int x) +@deftypefnx {C Function} SCM scm_from_uint (unsigned int x) +@deftypefnx {C Function} SCM scm_from_long (long x) +@deftypefnx {C Function} SCM scm_from_ulong (unsigned long x) +@deftypefnx {C Function} SCM scm_from_long_long (long long x) +@deftypefnx {C Function} SCM scm_from_ulong_long (unsigned long long x) +@deftypefnx {C Function} SCM scm_from_size_t (size_t x) +@deftypefnx {C Function} SCM scm_from_ssize_t (ssize_t x) +@deftypefnx {C Function} SCM scm_from_int8 (scm_t_int8 x) +@deftypefnx {C Function} SCM scm_from_uint8 (scm_t_uint8 x) +@deftypefnx {C Function} SCM scm_from_int16 (scm_t_int16 x) +@deftypefnx {C Function} SCM scm_from_uint16 (scm_t_uint16 x) +@deftypefnx {C Function} SCM scm_from_int32 (scm_t_int32 x) +@deftypefnx {C Function} SCM scm_from_uint32 (scm_t_uint32 x) +@deftypefnx {C Function} SCM scm_from_int64 (scm_t_int64 x) +@deftypefnx {C Function} SCM scm_from_uint64 (scm_t_uint64 x) +@deftypefnx {C Function} SCM scm_from_intmax (scm_t_intmax x) +@deftypefnx {C Function} SCM scm_from_uintmax (scm_t_uintmax x) +Return the @code{SCM} value that represents the integer @var{x}. +These functions will always succeed. +@end deftypefn @node Reals and Rationals @subsubsection Real and Rational Numbers From 11c8f7296b119eee1887449c5a5b40c0e95bac01 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 7 Jul 2004 15:40:25 +0000 Subject: [PATCH 46/58] *** empty log message *** --- doc/ref/ChangeLog | 3 +++ 1 file changed, 3 insertions(+) diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index 50e042bde..47aa4aea7 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,5 +1,8 @@ 2004-07-07 Marius Vollmer + * scheme-data.texi (Integers): Added docs for the new scm_is_, + scm_to_ and scm_from_ functions for integers. + * data-rep.texi (How Guile does it): Mark as being in limbo. All the real documentation will be in the nodes "Programming in C" and "API Reference". From d19905925431ab12bbdcf5c26cd6478fad7755fb Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Thu, 8 Jul 2004 15:31:39 +0000 Subject: [PATCH 47/58] Instead of hard-coding the numbers, compute them by assuming twos-complement. --- libguile/gen-scmconfig.c | 15 +++++---------- 1 file changed, 5 insertions(+), 10 deletions(-) diff --git a/libguile/gen-scmconfig.c b/libguile/gen-scmconfig.c index f44517f69..1dd87b844 100644 --- a/libguile/gen-scmconfig.c +++ b/libguile/gen-scmconfig.c @@ -277,22 +277,17 @@ main (int argc, char *argv[]) pf ("#define SCM_SIZEOF_LONG_LONG %d\n", SIZEOF_LONG_LONG); pf ("#define SCM_SIZEOF_UNSIGNED_LONG_LONG %d\n", SIZEOF_UNSIGNED_LONG_LONG); - if (SIZEOF_LONG_LONG == 8) + if (SIZEOF_LONG_LONG != 0) { pf ("\n"); pf ("/* The limits of long long are not readily available without\n"); pf (" defining _GNU_SOURCE (which we can't do in a header) or\n"); pf (" being on a C99 system (which we can't rely on yet). Thus,\n"); - pf (" we hardcode the limits here.\n"); + pf (" we define the limits on our own, assuming twos-complement.\n"); pf ("*/\n"); - pf ("#define SCM_I_LLONG_MAX 9223372036854775807LL\n"); - pf ("#define SCM_I_LLONG_MIN (-SCM_I_LLONG_MAX-1LL)\n"); - pf ("#define SCM_I_ULLONG_MAX 18446744073709551615ULL\n"); - } - else if (SIZEOF_LONG_LONG != 0) - { - fprintf (stderr, "gen-scmconfig: long long is not 64 bits, FIX ME.\n"); - return 1; + pf ("#define SCM_I_LLONG_MAX ((long long) (SCM_I_ULLONG_MAX >> 1))\n"); + pf ("#define SCM_I_LLONG_MIN (~SCM_I_LLONG_MAX)\n"); + pf ("#define SCM_I_ULLONG_MAX ((unsigned long long) (-1))\n"); } pf("\n"); From 5a572ca13c2258defb9355122febf4f04276b97e Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Thu, 8 Jul 2004 15:41:48 +0000 Subject: [PATCH 48/58] * numbers.h (SCM_MAKINUM, SCM_I_MAKINUM): Renamed SCM_MAKINUM to SCM_I_MAKINUM and changed all uses. * deprecated.h, deprecated.c (SCM_MAKINUM): Newly deprecated. --- libguile/deprecated.c | 2 -- libguile/deprecated.h | 2 -- libguile/numbers.h | 4 ++-- 3 files changed, 2 insertions(+), 6 deletions(-) diff --git a/libguile/deprecated.c b/libguile/deprecated.c index c3dc8bbee..a0275ccb9 100644 --- a/libguile/deprecated.c +++ b/libguile/deprecated.c @@ -1105,7 +1105,6 @@ SCM_DEFINE (scm_gentemp, "gentemp", 0, 2, 0, } #undef FUNC_NAME -#if 0 SCM SCM_MAKINUM (scm_t_signed_bits val) { @@ -1113,7 +1112,6 @@ SCM_MAKINUM (scm_t_signed_bits val) ("SCM_MAKINUM is deprecated. Use scm_from_int or similar instead."); return scm_from_int (val); } -#endif void scm_i_init_deprecated () diff --git a/libguile/deprecated.h b/libguile/deprecated.h index 0091d7c46..039ec540f 100644 --- a/libguile/deprecated.h +++ b/libguile/deprecated.h @@ -323,9 +323,7 @@ SCM_API SCM scm_gentemp (SCM prefix, SCM obarray); ^ (SCM_UNPACK (SCM_BOOL_T) \ ^ SCM_UNPACK (SCM_BOOL_F)))) -#if 0 SCM_API SCM SCM_MAKINUM (scm_t_signed_bits val); -#endif void scm_i_init_deprecated (void); diff --git a/libguile/numbers.h b/libguile/numbers.h index af1f9252a..47e8cfe42 100644 --- a/libguile/numbers.h +++ b/libguile/numbers.h @@ -68,7 +68,7 @@ #define SCM_INUMP(x) (2 & SCM_UNPACK (x)) #define SCM_NINUMP(x) (!SCM_INUMP (x)) -#define SCM_MAKINUM(x) \ +#define SCM_I_MAKINUM(x) \ (SCM_PACK ((((scm_t_signed_bits) (x)) << 2) + scm_tc2_int)) #define SCM_INUM(x) (SCM_SRS ((scm_t_signed_bits) SCM_UNPACK (x), 2)) @@ -79,7 +79,7 @@ /* A name for 0. */ -#define SCM_INUM0 (SCM_MAKINUM (0)) +#define SCM_INUM0 (SCM_I_MAKINUM (0)) /* SCM_MAXEXP is the maximum double precision exponent * SCM_FLTMAX is less than or scm_equal the largest single precision float From d956fa6f91e2873fbf5db4e5ed1345f0958d05dd Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Thu, 8 Jul 2004 15:54:05 +0000 Subject: [PATCH 49/58] (scm_is_signed_integer, scm_is_unsigned_integer): Rewritten using the same logic as scm_to_signed_integer and scm_to_unsigned_integer, respectively, which is better(tm). Also, use CHAR_BIT instead of hardcoding 8. (LLONG_MIN, LLONG_MAX, ULLONG_MAX): Removed and used SCM_I_LLONG_MIN etc. instead. * numbers.h (SCM_MAKINUM, SCM_I_MAKINUM): Renamed SCM_MAKINUM to SCM_I_MAKINUM and changed all uses. --- libguile/numbers.c | 284 ++++++++++++++++++++++----------------------- 1 file changed, 136 insertions(+), 148 deletions(-) diff --git a/libguile/numbers.c b/libguile/numbers.c index ab791edd4..42c839348 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -215,7 +215,7 @@ scm_i_dbl2num (double u) if (u < (double) (SCM_MOST_POSITIVE_FIXNUM+1) && u >= (double) SCM_MOST_NEGATIVE_FIXNUM) - return SCM_MAKINUM ((long) u); + return SCM_I_MAKINUM ((long) u); else return scm_i_dbl2big (u); } @@ -297,7 +297,7 @@ scm_i_normbig (SCM b) { long val = mpz_get_si (SCM_I_BIG_MPZ (b)); if (SCM_FIXABLE (val)) - b = SCM_MAKINUM (val); + b = SCM_I_MAKINUM (val); } return b; } @@ -310,7 +310,7 @@ scm_i_mpz2num (mpz_t b) { long val = mpz_get_si (b); if (SCM_FIXABLE (val)) - return SCM_MAKINUM (val); + return SCM_I_MAKINUM (val); } { @@ -333,7 +333,7 @@ scm_make_ratio (SCM numerator, SCM denominator) { if (SCM_EQ_P (denominator, SCM_INUM0)) scm_num_overflow ("make-ratio"); - if (SCM_EQ_P (denominator, SCM_MAKINUM(1))) + if (SCM_EQ_P (denominator, SCM_I_MAKINUM(1))) return numerator; } else @@ -365,9 +365,9 @@ scm_make_ratio (SCM numerator, SCM denominator) long y; y = SCM_INUM (denominator); if (x == y) - return SCM_MAKINUM(1); + return SCM_I_MAKINUM(1); if ((x % y) == 0) - return SCM_MAKINUM (x / y); + return SCM_I_MAKINUM (x / y); } else { @@ -378,7 +378,7 @@ scm_make_ratio (SCM numerator, SCM denominator) if (x == SCM_MOST_NEGATIVE_FIXNUM && mpz_cmp_ui (SCM_I_BIG_MPZ (denominator), - SCM_MOST_NEGATIVE_FIXNUM) == 0) - return SCM_MAKINUM(-1); + return SCM_I_MAKINUM(-1); } } else if (SCM_BIGP (numerator)) @@ -392,7 +392,7 @@ scm_make_ratio (SCM numerator, SCM denominator) else { if (SCM_EQ_P (numerator, denominator)) - return SCM_MAKINUM(1); + return SCM_I_MAKINUM(1); if (mpz_divisible_p (SCM_I_BIG_MPZ (numerator), SCM_I_BIG_MPZ (denominator))) return scm_divide(numerator, denominator); @@ -413,7 +413,7 @@ static void scm_i_fraction_reduce (SCM z) { SCM divisor; divisor = scm_gcd (SCM_FRACTION_NUMERATOR (z), SCM_FRACTION_DENOMINATOR (z)); - if (!(SCM_EQ_P (divisor, SCM_MAKINUM(1)))) + if (!(SCM_EQ_P (divisor, SCM_I_MAKINUM(1)))) { /* is this safe? */ SCM_FRACTION_SET_NUMERATOR (z, scm_divide (SCM_FRACTION_NUMERATOR (z), divisor)); @@ -648,7 +648,7 @@ SCM_PRIMITIVE_GENERIC (scm_abs, "abs", 1, 0, 0, if (xx >= 0) return x; else if (SCM_POSFIXABLE (-xx)) - return SCM_MAKINUM (-xx); + return SCM_I_MAKINUM (-xx); else return scm_i_long2big (-xx); } @@ -700,7 +700,7 @@ scm_quotient (SCM x, SCM y) { long z = xx / yy; if (SCM_FIXABLE (z)) - return SCM_MAKINUM (z); + return SCM_I_MAKINUM (z); else return scm_i_long2big (z); } @@ -713,10 +713,10 @@ scm_quotient (SCM x, SCM y) { /* Special case: x == fixnum-min && y == abs (fixnum-min) */ scm_remember_upto_here_1 (y); - return SCM_MAKINUM (-1); + return SCM_I_MAKINUM (-1); } else - return SCM_MAKINUM (0); + return SCM_I_MAKINUM (0); } else SCM_WTA_DISPATCH_2 (g_quotient, x, y, SCM_ARG2, s_quotient); @@ -782,7 +782,7 @@ scm_remainder (SCM x, SCM y) else { long z = SCM_INUM (x) % yy; - return SCM_MAKINUM (z); + return SCM_I_MAKINUM (z); } } else if (SCM_BIGP (y)) @@ -793,7 +793,7 @@ scm_remainder (SCM x, SCM y) { /* Special case: x == fixnum-min && y == abs (fixnum-min) */ scm_remember_upto_here_1 (y); - return SCM_MAKINUM (0); + return SCM_I_MAKINUM (0); } else return x; @@ -874,7 +874,7 @@ scm_modulo (SCM x, SCM y) else result = z; } - return SCM_MAKINUM (result); + return SCM_I_MAKINUM (result); } } else if (SCM_BIGP (y)) @@ -1021,7 +1021,7 @@ scm_gcd (SCM x, SCM y) result = u * k; } return (SCM_POSFIXABLE (result) - ? SCM_MAKINUM (result) + ? SCM_I_MAKINUM (result) : scm_i_long2big (result)); } else if (SCM_BIGP (y)) @@ -1047,7 +1047,7 @@ scm_gcd (SCM x, SCM y) result = mpz_gcd_ui (NULL, SCM_I_BIG_MPZ (x), yy); scm_remember_upto_here_1 (x); return (SCM_POSFIXABLE (result) - ? SCM_MAKINUM (result) + ? SCM_I_MAKINUM (result) : scm_ulong2num (result)); } else if (SCM_BIGP (y)) @@ -1076,8 +1076,8 @@ scm_lcm (SCM n1, SCM n2) if (SCM_UNBNDP (n2)) { if (SCM_UNBNDP (n1)) - return SCM_MAKINUM (1L); - n2 = SCM_MAKINUM (1L); + return SCM_I_MAKINUM (1L); + n2 = SCM_I_MAKINUM (1L); } SCM_GASSERT2 (SCM_INUMP (n1) || SCM_BIGP (n1), @@ -1134,7 +1134,7 @@ scm_lcm (SCM n1, SCM n2) #ifndef scm_long2num #define SCM_LOGOP_RETURN(x) scm_ulong2num(x) #else -#define SCM_LOGOP_RETURN(x) SCM_MAKINUM(x) +#define SCM_LOGOP_RETURN(x) SCM_I_MAKINUM(x) #endif /* Emulating 2's complement bignums with sign magnitude arithmetic: @@ -1188,7 +1188,7 @@ SCM_DEFINE1 (scm_logand, "logand", scm_tc7_asubr, if (SCM_UNBNDP (n2)) { if (SCM_UNBNDP (n1)) - return SCM_MAKINUM (-1); + return SCM_I_MAKINUM (-1); else if (!SCM_NUMBERP (n1)) SCM_WRONG_TYPE_ARG (SCM_ARG1, n1); else if (SCM_NUMBERP (n1)) @@ -1203,7 +1203,7 @@ SCM_DEFINE1 (scm_logand, "logand", scm_tc7_asubr, if (SCM_INUMP (n2)) { long nn2 = SCM_INUM (n2); - return SCM_MAKINUM (nn1 & nn2); + return SCM_I_MAKINUM (nn1 & nn2); } else if SCM_BIGP (n2) { @@ -1277,7 +1277,7 @@ SCM_DEFINE1 (scm_logior, "logior", scm_tc7_asubr, if (SCM_INUMP (n2)) { long nn2 = SCM_INUM (n2); - return SCM_MAKINUM (nn1 | nn2); + return SCM_I_MAKINUM (nn1 | nn2); } else if (SCM_BIGP (n2)) { @@ -1353,7 +1353,7 @@ SCM_DEFINE1 (scm_logxor, "logxor", scm_tc7_asubr, if (SCM_INUMP (n2)) { long nn2 = SCM_INUM (n2); - return SCM_MAKINUM (nn1 ^ nn2); + return SCM_I_MAKINUM (nn1 ^ nn2); } else if (SCM_BIGP (n2)) { @@ -1518,7 +1518,7 @@ SCM_DEFINE (scm_lognot, "lognot", 1, 0, 0, Enhancement: No need to strip the tag and add it back, could just xor a block of 1 bits, if that worked with the various debug versions of the SCM typedef. */ - return SCM_MAKINUM (~ SCM_INUM (n)); + return SCM_I_MAKINUM (~ SCM_INUM (n)); } else if (SCM_BIGP (n)) { SCM result = scm_i_mkbig (); @@ -1666,12 +1666,12 @@ SCM_DEFINE (scm_integer_expt, "integer-expt", 2, 0, 0, long i2 = 0; SCM z_i2 = SCM_BOOL_F; int i2_is_big = 0; - SCM acc = SCM_MAKINUM (1L); + SCM acc = SCM_I_MAKINUM (1L); /* 0^0 == 1 according to R5RS */ if (SCM_EQ_P (n, SCM_INUM0) || SCM_EQ_P (n, acc)) return scm_is_false (scm_zero_p(k)) ? n : acc; - else if (SCM_EQ_P (n, SCM_MAKINUM (-1L))) + else if (SCM_EQ_P (n, SCM_I_MAKINUM (-1L))) return scm_is_false (scm_even_p (k)) ? n : acc; if (SCM_INUMP (k)) @@ -1781,19 +1781,19 @@ SCM_DEFINE (scm_ash, "ash", 2, 0, 0, by div:=2^abs(cnt). However, to guarantee the floor rounding, negative values require some special treatment. */ - SCM div = scm_integer_expt (SCM_MAKINUM (2), - SCM_MAKINUM (-bits_to_shift)); + SCM div = scm_integer_expt (SCM_I_MAKINUM (2), + SCM_I_MAKINUM (-bits_to_shift)); /* scm_quotient assumes its arguments are integers, but it's legal to (ash 1/2 -1) */ if (scm_is_false (scm_negative_p (n))) return scm_quotient (n, div); else - return scm_sum (SCM_MAKINUM (-1L), - scm_quotient (scm_sum (SCM_MAKINUM (1L), n), div)); + return scm_sum (SCM_I_MAKINUM (-1L), + scm_quotient (scm_sum (SCM_I_MAKINUM (1L), n), div)); } else /* Shift left is done by multiplication with 2^CNT */ - return scm_product (n, scm_integer_expt (SCM_MAKINUM (2), cnt)); + return scm_product (n, scm_integer_expt (SCM_I_MAKINUM (2), cnt)); } #undef FUNC_NAME @@ -1842,14 +1842,14 @@ SCM_DEFINE (scm_bit_extract, "bit-extract", 3, 0, 0, /* mask down to requisite bits */ bits = min (bits, SCM_I_FIXNUM_BIT); - return SCM_MAKINUM (in & ((1L << bits) - 1)); + return SCM_I_MAKINUM (in & ((1L << bits) - 1)); } else if (SCM_BIGP (n)) { SCM result; if (bits == 1) { - result = SCM_MAKINUM (mpz_tstbit (SCM_I_BIG_MPZ (n), istart)); + result = SCM_I_MAKINUM (mpz_tstbit (SCM_I_BIG_MPZ (n), istart)); } else { @@ -1902,7 +1902,7 @@ SCM_DEFINE (scm_logcount, "logcount", 1, 0, 0, c += scm_logtab[15 & nn]; nn >>= 4; } - return SCM_MAKINUM (c); + return SCM_I_MAKINUM (c); } else if (SCM_BIGP (n)) { @@ -1912,7 +1912,7 @@ SCM_DEFINE (scm_logcount, "logcount", 1, 0, 0, else count = mpz_hamdist (SCM_I_BIG_MPZ (n), z_negative_one); scm_remember_upto_here_1 (n); - return SCM_MAKINUM (count); + return SCM_I_MAKINUM (count); } else SCM_WRONG_TYPE_ARG (SCM_ARG1, n); @@ -1952,7 +1952,7 @@ SCM_DEFINE (scm_integer_length, "integer-length", 1, 0, 0, l = scm_ilentab [15 & nn]; nn >>= 4; } - return SCM_MAKINUM (c - 4 + l); + return SCM_I_MAKINUM (c - 4 + l); } else if (SCM_BIGP (n)) { @@ -1965,7 +1965,7 @@ SCM_DEFINE (scm_integer_length, "integer-length", 1, 0, 0, mpz_scan1 (SCM_I_BIG_MPZ (n), 0)) == ULONG_MAX) size--; scm_remember_upto_here_1 (n); - return SCM_MAKINUM (size); + return SCM_I_MAKINUM (size); } else SCM_WRONG_TYPE_ARG (SCM_ARG1, n); @@ -2405,7 +2405,7 @@ mem2uinteger (const char* mem, size_t len, unsigned int *p_idx, return SCM_BOOL_F; idx++; - result = SCM_MAKINUM (digit_value); + result = SCM_I_MAKINUM (digit_value); while (idx != len) { char c = mem[idx]; @@ -2428,9 +2428,9 @@ mem2uinteger (const char* mem, size_t len, unsigned int *p_idx, idx++; if (SCM_MOST_POSITIVE_FIXNUM / radix < shift) { - result = scm_product (result, SCM_MAKINUM (shift)); + result = scm_product (result, SCM_I_MAKINUM (shift)); if (add > 0) - result = scm_sum (result, SCM_MAKINUM (add)); + result = scm_sum (result, SCM_I_MAKINUM (add)); shift = radix; add = digit_value; @@ -2443,9 +2443,9 @@ mem2uinteger (const char* mem, size_t len, unsigned int *p_idx, }; if (shift > 1) - result = scm_product (result, SCM_MAKINUM (shift)); + result = scm_product (result, SCM_I_MAKINUM (shift)); if (add > 0) - result = scm_sum (result, SCM_MAKINUM (add)); + result = scm_sum (result, SCM_I_MAKINUM (add)); *p_idx = idx; if (hash_seen) @@ -2480,7 +2480,7 @@ mem2decimal_from_point (SCM result, const char* mem, size_t len, scm_t_bits shift = 1; scm_t_bits add = 0; unsigned int digit_value; - SCM big_shift = SCM_MAKINUM (1); + SCM big_shift = SCM_I_MAKINUM (1); idx++; while (idx != len) @@ -2504,10 +2504,10 @@ mem2decimal_from_point (SCM result, const char* mem, size_t len, idx++; if (SCM_MOST_POSITIVE_FIXNUM / 10 < shift) { - big_shift = scm_product (big_shift, SCM_MAKINUM (shift)); - result = scm_product (result, SCM_MAKINUM (shift)); + big_shift = scm_product (big_shift, SCM_I_MAKINUM (shift)); + result = scm_product (result, SCM_I_MAKINUM (shift)); if (add > 0) - result = scm_sum (result, SCM_MAKINUM (add)); + result = scm_sum (result, SCM_I_MAKINUM (add)); shift = 10; add = digit_value; @@ -2521,9 +2521,9 @@ mem2decimal_from_point (SCM result, const char* mem, size_t len, if (add > 0) { - big_shift = scm_product (big_shift, SCM_MAKINUM (shift)); - result = scm_product (result, SCM_MAKINUM (shift)); - result = scm_sum (result, SCM_MAKINUM (add)); + big_shift = scm_product (big_shift, SCM_I_MAKINUM (shift)); + result = scm_product (result, SCM_I_MAKINUM (shift)); + result = scm_sum (result, SCM_I_MAKINUM (add)); } result = scm_divide (result, big_shift); @@ -2593,7 +2593,7 @@ mem2decimal_from_point (SCM result, const char* mem, size_t len, scm_out_of_range ("string->number", exp_num); } - e = scm_integer_expt (SCM_MAKINUM (10), SCM_MAKINUM (exponent)); + e = scm_integer_expt (SCM_I_MAKINUM (10), SCM_I_MAKINUM (exponent)); if (sign == 1) result = scm_product (result, e); else @@ -2656,7 +2656,7 @@ mem2ureal (const char* mem, size_t len, unsigned int *p_idx, else if (!isdigit ((int) (unsigned char) mem[idx + 1])) return SCM_BOOL_F; else - result = mem2decimal_from_point (SCM_MAKINUM (0), mem, len, + result = mem2decimal_from_point (SCM_I_MAKINUM (0), mem, len, p_idx, p_exactness); } else @@ -2700,7 +2700,7 @@ mem2ureal (const char* mem, size_t len, unsigned int *p_idx, /* When returning an inexact zero, make sure it is represented as a floating point value so that we can change its sign. */ - if (SCM_EQ_P (result, SCM_MAKINUM(0)) && *p_exactness == INEXACT) + if (SCM_EQ_P (result, SCM_I_MAKINUM(0)) && *p_exactness == INEXACT) result = scm_make_real (0.0); return result; @@ -2749,7 +2749,7 @@ mem2complex (const char* mem, size_t len, unsigned int idx, if (idx != len) return SCM_BOOL_F; - return scm_make_rectangular (SCM_MAKINUM (0), SCM_MAKINUM (sign)); + return scm_make_rectangular (SCM_I_MAKINUM (0), SCM_I_MAKINUM (sign)); } else return SCM_BOOL_F; @@ -2773,7 +2773,7 @@ mem2complex (const char* mem, size_t len, unsigned int idx, return SCM_BOOL_F; if (idx != len) return SCM_BOOL_F; - return scm_make_rectangular (SCM_MAKINUM (0), ureal); + return scm_make_rectangular (SCM_I_MAKINUM (0), ureal); case '@': /* polar input: @. */ @@ -2826,7 +2826,7 @@ mem2complex (const char* mem, size_t len, unsigned int idx, SCM imag = mem2ureal (mem, len, &idx, radix, p_exactness); if (scm_is_false (imag)) - imag = SCM_MAKINUM (sign); + imag = SCM_I_MAKINUM (sign); else if (sign == -1 && scm_is_false (scm_nan_p (ureal))) imag = scm_difference (imag, SCM_UNDEFINED); @@ -3851,7 +3851,7 @@ scm_sum (SCM x, SCM y) long xx = SCM_INUM (x); long yy = SCM_INUM (y); long int z = xx + yy; - return SCM_FIXABLE (z) ? SCM_MAKINUM (z) : scm_i_long2big (z); + return SCM_FIXABLE (z) ? SCM_I_MAKINUM (z) : scm_i_long2big (z); } else if (SCM_BIGP (y)) { @@ -4030,7 +4030,7 @@ scm_difference (SCM x, SCM y) { long xx = -SCM_INUM (x); if (SCM_FIXABLE (xx)) - return SCM_MAKINUM (xx); + return SCM_I_MAKINUM (xx); else return scm_i_long2big (xx); } @@ -4057,7 +4057,7 @@ scm_difference (SCM x, SCM y) long int yy = SCM_INUM (y); long int z = xx - yy; if (SCM_FIXABLE (z)) - return SCM_MAKINUM (z); + return SCM_I_MAKINUM (z); else return scm_i_long2big (z); } @@ -4119,7 +4119,7 @@ scm_difference (SCM x, SCM y) scm_remember_upto_here_1 (x); if (sgn_x == 0) - return SCM_FIXABLE (-yy) ? SCM_MAKINUM (-yy) : scm_long2num (-yy); + return SCM_FIXABLE (-yy) ? SCM_I_MAKINUM (-yy) : scm_long2num (-yy); else { SCM result = scm_i_mkbig (); @@ -4256,7 +4256,7 @@ scm_product (SCM x, SCM y) if (SCM_UNBNDP (y)) { if (SCM_UNBNDP (x)) - return SCM_MAKINUM (1L); + return SCM_I_MAKINUM (1L); else if (SCM_NUMBERP (x)) return x; else @@ -4280,7 +4280,7 @@ scm_product (SCM x, SCM y) { long yy = SCM_INUM (y); long kk = xx * yy; - SCM k = SCM_MAKINUM (kk); + SCM k = SCM_I_MAKINUM (kk); if ((kk == SCM_INUM (k)) && (kk / xx == yy)) return k; else @@ -4504,14 +4504,14 @@ scm_i_divide (SCM x, SCM y, int inexact) { if (inexact) return scm_make_real (1.0 / (double) xx); - else return scm_make_ratio (SCM_MAKINUM(1), x); + else return scm_make_ratio (SCM_I_MAKINUM(1), x); } } else if (SCM_BIGP (x)) { if (inexact) return scm_make_real (1.0 / scm_i_big2dbl (x)); - else return scm_make_ratio (SCM_MAKINUM(1), x); + else return scm_make_ratio (SCM_I_MAKINUM(1), x); } else if (SCM_REALP (x)) { @@ -4571,7 +4571,7 @@ scm_i_divide (SCM x, SCM y, int inexact) { long z = xx / yy; if (SCM_FIXABLE (z)) - return SCM_MAKINUM (z); + return SCM_I_MAKINUM (z); else return scm_i_long2big (z); } @@ -5020,7 +5020,7 @@ SCM_DEFINE (scm_round_number, "round", 1, 0, 0, /* Adjust so that the scm_round is towards even. */ if (scm_is_true (scm_num_eq_p (plus_half, result)) && scm_is_true (scm_odd_p (result))) - return scm_difference (result, SCM_MAKINUM (1)); + return scm_difference (result, SCM_I_MAKINUM (1)); else return result; } @@ -5050,7 +5050,7 @@ SCM_PRIMITIVE_GENERIC (scm_floor, "floor", 1, 0, 0, /* For negative x, we need to return q-1 unless x is an integer. But fractions are never integer, per our assumptions. */ - return scm_difference (q, SCM_MAKINUM (1)); + return scm_difference (q, SCM_I_MAKINUM (1)); } } else @@ -5081,7 +5081,7 @@ SCM_PRIMITIVE_GENERIC (scm_ceiling, "ceiling", 1, 0, 0, /* For positive x, we need to return q+1 unless x is an integer. But fractions are never integer, per our assumptions. */ - return scm_sum (q, SCM_MAKINUM (1)); + return scm_sum (q, SCM_I_MAKINUM (1)); } } else @@ -5298,9 +5298,9 @@ SCM scm_denominator (SCM z) { if (SCM_INUMP (z)) - return SCM_MAKINUM (1); + return SCM_I_MAKINUM (1); else if (SCM_BIGP (z)) - return SCM_MAKINUM (1); + return SCM_I_MAKINUM (1); else if (SCM_FRACTIONP (z)) { scm_i_fraction_reduce (z); @@ -5325,7 +5325,7 @@ scm_magnitude (SCM z) if (zz >= 0) return z; else if (SCM_POSFIXABLE (-zz)) - return SCM_MAKINUM (-zz); + return SCM_I_MAKINUM (-zz); else return scm_i_long2big (-zz); } @@ -5473,9 +5473,9 @@ SCM_DEFINE (scm_rationalize, "rationalize", 2, 0, 0, SCM ex = scm_inexact_to_exact (x); SCM int_part = scm_floor (ex); - SCM tt = SCM_MAKINUM (1); - SCM a1 = SCM_MAKINUM (0), a2 = SCM_MAKINUM (1), a = SCM_MAKINUM (0); - SCM b1 = SCM_MAKINUM (1), b2 = SCM_MAKINUM (0), b = SCM_MAKINUM (0); + SCM tt = SCM_I_MAKINUM (1); + SCM a1 = SCM_I_MAKINUM (0), a2 = SCM_I_MAKINUM (1), a = SCM_I_MAKINUM (0); + SCM b1 = SCM_I_MAKINUM (1), b2 = SCM_I_MAKINUM (0), b = SCM_I_MAKINUM (0); SCM rx; int i = 0; @@ -5522,15 +5522,6 @@ SCM_DEFINE (scm_rationalize, "rationalize", 2, 0, 0, } #undef FUNC_NAME -/* if you need to change this, change test-num2integral.c as well */ -#if SCM_SIZEOF_LONG_LONG != 0 -# ifndef LLONG_MAX -# define ULLONG_MAX ((unsigned long long) (-1)) -# define LLONG_MAX ((long long) (ULLONG_MAX >> 1)) -# define LLONG_MIN (~LLONG_MAX) -# endif -#endif - /* Parameters for creating integer conversion routines. Define the following preprocessor macros before including @@ -5631,10 +5622,6 @@ SCM_DEFINE (scm_rationalize, "rationalize", 2, 0, 0, #if SCM_SIZEOF_LONG_LONG != 0 -#ifndef ULONG_LONG_MAX -#define ULONG_LONG_MAX (~0ULL) -#endif - #define NUM2INTEGRAL scm_num2long_long #define INTEGRAL2NUM scm_long_long2num #define INTEGRAL2BIG scm_i_long_long2big @@ -5684,43 +5671,40 @@ scm_is_signed_integer (SCM val, scm_t_intmax min, scm_t_intmax max) if (min >= SCM_MOST_NEGATIVE_FIXNUM && max <= SCM_MOST_POSITIVE_FIXNUM) return 0; else if (min >= LONG_MIN && max <= LONG_MAX) - return (mpz_cmp_si (SCM_I_BIG_MPZ (val), min) >= 0 - && mpz_cmp_si (SCM_I_BIG_MPZ (val), max) <= 0); + { + if (mpz_fits_slong_p (SCM_I_BIG_MPZ (val))) + { + long n = mpz_get_si (SCM_I_BIG_MPZ (val)); + return n >= min && n <= max; + } + else + return 0; + } else { - /* Get the big hammer. */ + scm_t_intmax n; + size_t count; - mpz_t bigmin, bigmax; - int res; - - mpz_init (bigmin); - if (min >= 0) - mpz_import (bigmin, 1, 1, sizeof (scm_t_intmax), 0, 0, &min); - else - { - /* Magically works for min == INTMAX_MIN as well. */ - min = -min; - mpz_import (bigmin, 1, 1, sizeof (scm_t_intmax), 0, 0, &min); - mpz_neg (bigmin, bigmin); - } - res = mpz_cmp (SCM_I_BIG_MPZ (val), bigmin); - mpz_clear (bigmin); - if (res < 0) + if (mpz_sizeinbase (SCM_I_BIG_MPZ (val), 2) + > CHAR_BIT*sizeof (scm_t_uintmax)) return 0; + + mpz_export (&n, &count, 1, sizeof (scm_t_uintmax), 0, 0, + SCM_I_BIG_MPZ (val)); - mpz_init (bigmax); - if (max >= 0) - mpz_import (bigmax, 1, 1, sizeof (scm_t_intmax), 0, 0, &max); + if (mpz_sgn (SCM_I_BIG_MPZ (val)) >= 0) + { + if (n < 0) + return 0; + } else { - /* Magically works for max == INTMAX_MIN as well. */ - max = -max; - mpz_import (bigmax, 1, 1, sizeof (scm_t_intmax), 0, 0, &max); - mpz_neg (bigmax, bigmax); + n = -n; + if (n >= 0) + return 0; } - res = mpz_cmp (SCM_I_BIG_MPZ (val), bigmax); - mpz_clear (bigmax); - return res <= 0; + + return n >= min && n <= max; } } else if (SCM_REALP (val)) @@ -5745,33 +5729,37 @@ scm_is_unsigned_integer (SCM val, scm_t_uintmax min, scm_t_uintmax max) if (max <= SCM_MOST_POSITIVE_FIXNUM) return 0; else if (max <= ULONG_MAX) - return (mpz_cmp_ui (SCM_I_BIG_MPZ (val), min) >= 0 - && mpz_cmp_ui (SCM_I_BIG_MPZ (val), max) <= 0); + { + if (mpz_fits_ulong_p (SCM_I_BIG_MPZ (val))) + { + unsigned long n = mpz_get_ui (SCM_I_BIG_MPZ (val)); + return n >= min && n <= max; + } + else + return 0; + } else { - /* Get the big hammer. */ + scm_t_uintmax n; + size_t count; - mpz_t bigmin, bigmax; - int res; - - mpz_init (bigmin); - mpz_import (bigmin, 1, 1, sizeof (scm_t_uintmax), 0, 0, &min); - res = mpz_cmp (SCM_I_BIG_MPZ (val), bigmin); - mpz_clear (bigmin); - if (res < 0) + if (mpz_sgn (SCM_I_BIG_MPZ (val)) < 0) return 0; - mpz_init (bigmax); - mpz_import (bigmax, 1, 1, sizeof (scm_t_intmax), 0, 0, &max); - res = mpz_cmp (SCM_I_BIG_MPZ (val), bigmax); - mpz_clear (bigmax); - return res <= 0; + if (mpz_sizeinbase (SCM_I_BIG_MPZ (val), 2) + > CHAR_BIT*sizeof (scm_t_uintmax)) + return 0; + + mpz_export (&n, &count, 1, sizeof (scm_t_uintmax), 0, 0, + SCM_I_BIG_MPZ (val)); + + return n >= min && n <= max; } } else if (SCM_REALP (val)) { double n = SCM_REAL_VALUE (val); - return n == floor(n) && n >= min && n <= max; + return n == floor (n) && n >= min && n <= max; } else return 0; @@ -5815,7 +5803,7 @@ scm_to_signed_integer (SCM val, scm_t_intmax min, scm_t_intmax max) size_t count; if (mpz_sizeinbase (SCM_I_BIG_MPZ (val), 2) - > 8*sizeof (scm_t_uintmax)) + > CHAR_BIT*sizeof (scm_t_uintmax)) goto out_of_range; mpz_export (&n, &count, 1, sizeof (scm_t_uintmax), 0, 0, @@ -5885,7 +5873,7 @@ scm_to_unsigned_integer (SCM val, scm_t_uintmax min, scm_t_uintmax max) return n; else goto out_of_range; - } + } else goto out_of_range; } @@ -5898,7 +5886,7 @@ scm_to_unsigned_integer (SCM val, scm_t_uintmax min, scm_t_uintmax max) goto out_of_range; if (mpz_sizeinbase (SCM_I_BIG_MPZ (val), 2) - > 8*sizeof (scm_t_uintmax)) + > CHAR_BIT*sizeof (scm_t_uintmax)) goto out_of_range; mpz_export (&n, &count, 1, sizeof (scm_t_uintmax), 0, 0, @@ -5932,7 +5920,7 @@ SCM scm_from_signed_integer (scm_t_intmax val) { if (SCM_FIXABLE (val)) - return SCM_MAKINUM (val); + return SCM_I_MAKINUM (val); else if (val >= LONG_MIN && val <= LONG_MAX) { SCM z = scm_double_cell (scm_tc16_big, 0, 0, 0); @@ -5961,7 +5949,7 @@ SCM scm_from_unsigned_integer (scm_t_uintmax val) { if (SCM_POSFIXABLE (val)) - return SCM_MAKINUM (val); + return SCM_I_MAKINUM (val); else if (val <= ULONG_MAX) { SCM z = scm_double_cell (scm_tc16_big, 0, 0, 0); @@ -6052,9 +6040,9 @@ check_sanity () CHECK (long_long, 0LL); CHECK (ulong_long, 0ULL); CHECK (long_long, -1LL); - CHECK (long_long, LLONG_MAX); - CHECK (long_long, LLONG_MIN); - CHECK (ulong_long, ULLONG_MAX); + CHECK (long_long, SCM_I_LLONG_MAX); + CHECK (long_long, SCM_I_LLONG_MIN); + CHECK (ulong_long, SCM_I_ULLONG_MAX); #endif } @@ -6087,7 +6075,7 @@ SCM_DEFINE (scm_sys_check_number_conversions, "%check-number-conversions", 0, 0, "Number conversion sanity checking.") #define FUNC_NAME s_scm_sys_check_number_conversions { - SCM data = SCM_MAKINUM (-1); + SCM data = SCM_I_MAKINUM (-1); CHECK; data = scm_int2num (INT_MIN); CHECK; @@ -6095,7 +6083,7 @@ SCM_DEFINE (scm_sys_check_number_conversions, "%check-number-conversions", 0, 0, data = scm_difference (SCM_INUM0, data); CHECK; data = scm_ulong2num (ULONG_MAX); - data = scm_sum (SCM_MAKINUM (1), data); data = scm_difference (SCM_INUM0, data); + data = scm_sum (SCM_I_MAKINUM (1), data); data = scm_difference (SCM_INUM0, data); CHECK; data = scm_int2num (-10000); data = scm_product (data, data); data = scm_product (data, data); CHECK; @@ -6118,9 +6106,9 @@ scm_init_numbers () * using these values, remember the two rules of program optimization: * 1st Rule: Don't do it. 2nd Rule (experts only): Don't do it yet. */ scm_c_define ("most-positive-fixnum", - SCM_MAKINUM (SCM_MOST_POSITIVE_FIXNUM)); + SCM_I_MAKINUM (SCM_MOST_POSITIVE_FIXNUM)); scm_c_define ("most-negative-fixnum", - SCM_MAKINUM (SCM_MOST_NEGATIVE_FIXNUM)); + SCM_I_MAKINUM (SCM_MOST_NEGATIVE_FIXNUM)); scm_add_feature ("complex"); scm_add_feature ("inexact"); @@ -6141,8 +6129,8 @@ scm_init_numbers () check_sanity (); #endif - exactly_one_half = scm_permanent_object (scm_divide (SCM_MAKINUM (1), - SCM_MAKINUM (2))); + exactly_one_half = scm_permanent_object (scm_divide (SCM_I_MAKINUM (1), + SCM_I_MAKINUM (2))); #include "libguile/numbers.x" } From 43240c9caf66f802ba50df685e3e8b44e38906a5 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Thu, 8 Jul 2004 15:54:40 +0000 Subject: [PATCH 50/58] *** empty log message *** --- libguile/ChangeLog | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index b0ef8e47a..5aec17776 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,19 @@ +2004-07-08 Marius Vollmer + + * numbers.c (scm_is_signed_integer, scm_is_unsigned_integer): + Rewritten using the same logic as scm_to_signed_integer and + scm_to_unsigned_integer, respectively, which is better(tm). Also, + use CHAR_BIT instead of hardcoding 8. + (LLONG_MIN, LLONG_MAX, ULLONG_MAX): Removed and used + SCM_I_LLONG_MIN etc. instead. + + * numbers.h (SCM_MAKINUM, SCM_I_MAKINUM): Renamed SCM_MAKINUM to + SCM_I_MAKINUM and changed all uses. + * deprecated.h, deprecated.c (SCM_MAKINUM): Newly deprecated. + + * gen-scmconfig.c: Instead of hard-coding the numbers, compute + them by assuming twos-complement. + 2004-07-07 Marius Vollmer * gen-scmconfig.h.in: Added all the new SCM_I_GSC_*_LIMITS that From 93ccaef0c60868bb1a6e0747387ce34c0172b53e Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Thu, 8 Jul 2004 15:58:11 +0000 Subject: [PATCH 51/58] * numbers.h (SCM_MAKINUM, SCM_I_MAKINUM): Renamed SCM_MAKINUM to SCM_I_MAKINUM and changed all uses. --- libguile/__scm.h | 2 +- libguile/backtrace.c | 12 ++-- libguile/convert.i.c | 2 +- libguile/debug-malloc.c | 2 +- libguile/dynl.c | 2 +- libguile/environments.c | 18 +++--- libguile/environments.h | 4 +- libguile/error.c | 4 +- libguile/eval.c | 2 +- libguile/feature.c | 2 +- libguile/filesys.c | 18 +++--- libguile/fports.c | 8 +-- libguile/futures.c | 4 +- libguile/gc.c | 16 ++--- libguile/gdbint.c | 10 +-- libguile/gh_data.c | 2 +- libguile/goops.c | 14 ++-- libguile/gsubr.c | 4 +- libguile/guardians.c | 2 +- libguile/hash.c | 12 ++-- libguile/hashtab.c | 4 +- libguile/hooks.c | 2 +- libguile/ioext.c | 6 +- libguile/list.c | 2 +- libguile/net_db.c | 10 +-- libguile/num2integral.i.c | 6 +- libguile/options.c | 4 +- libguile/ports.c | 16 ++--- libguile/posix.c | 82 +++++++++++------------ libguile/procprop.c | 2 +- libguile/ramap.c | 62 +++++++++--------- libguile/random.c | 2 +- libguile/regex-posix.c | 6 +- libguile/scmsigs.c | 12 ++-- libguile/simpos.c | 4 +- libguile/socket.c | 82 +++++++++++------------ libguile/sort.c | 8 +-- libguile/srcprop.c | 10 +-- libguile/stacks.c | 12 ++-- libguile/stime.c | 34 +++++----- libguile/strings.c | 2 +- libguile/strop.c | 8 +-- libguile/struct.c | 12 ++-- libguile/symbols.c | 2 +- libguile/tags.h | 2 +- libguile/unif.c | 94 +++++++++++++-------------- libguile/validate.h | 10 +-- libguile/vectors.c | 2 +- libguile/version.c | 12 ++-- libguile/weaks.c | 8 +-- libguile/win32-socket.c | 4 +- srfi/srfi-1.c | 4 +- srfi/srfi-13.c | 132 +++++++++++++++++++------------------- srfi/srfi-14.c | 10 +-- srfi/srfi-4.c | 62 +++++++++--------- 55 files changed, 435 insertions(+), 435 deletions(-) diff --git a/libguile/__scm.h b/libguile/__scm.h index 395cedee4..5448ff4fd 100644 --- a/libguile/__scm.h +++ b/libguile/__scm.h @@ -563,7 +563,7 @@ SCM_API SCM scm_apply_generic (SCM gf, SCM args); ? scm_apply_generic ((gf), (args)) \ : (scm_wrong_type_arg ((subr), (pos), \ scm_list_ref ((args), \ - SCM_MAKINUM ((pos) - 1))), \ + scm_from_int ((pos) - 1))), \ SCM_UNSPECIFIED)) #define SCM_GASSERTn(cond, gf, args, pos, subr) \ if (!(cond)) SCM_WTA_DISPATCH_n((gf), (args), (pos), (subr)) diff --git a/libguile/backtrace.c b/libguile/backtrace.c index 9bf942932..442d7e5c2 100644 --- a/libguile/backtrace.c +++ b/libguile/backtrace.c @@ -454,7 +454,7 @@ SCM_DEFINE (scm_display_application, "display-application", 1, 2, 0, /* Create a string port used for adaptation of printing parameters. */ sport = scm_mkstrport (SCM_INUM0, - scm_make_string (SCM_MAKINUM (240), + scm_make_string (scm_from_int (240), SCM_UNDEFINED), SCM_OPN | SCM_WRTNG, FUNC_NAME); @@ -583,7 +583,7 @@ display_frame (SCM frame, int nfield, int indentation, SCM sport, SCM port, scm_ indent (nfield - (i ? i : 1), port); /* Frame number. */ - scm_iprin1 (SCM_MAKINUM (n), port, pstate); + scm_iprin1 (scm_from_int (n), port, pstate); /* Real frame marker */ scm_putc (SCM_FRAME_REAL_P (frame) ? '*' : ' ', port); @@ -677,7 +677,7 @@ display_backtrace_body (struct display_backtrace_args *a) /* Create a string port used for adaptation of printing parameters. */ sport = scm_mkstrport (SCM_INUM0, - scm_make_string (SCM_MAKINUM (240), SCM_UNDEFINED), + scm_make_string (scm_from_int (240), SCM_UNDEFINED), SCM_OPN | SCM_WRTNG, FUNC_NAME); @@ -695,7 +695,7 @@ display_backtrace_body (struct display_backtrace_args *a) unsigned int j; indent_p = 1; - frame = scm_stack_ref (a->stack, SCM_MAKINUM (beg)); + frame = scm_stack_ref (a->stack, scm_from_int (beg)); for (i = 0, j = 0; i < n; ++i) { if (SCM_FRAME_REAL_P (frame)) @@ -712,12 +712,12 @@ display_backtrace_body (struct display_backtrace_args *a) } /* Determine size of frame number field. */ - j = SCM_FRAME_NUMBER (scm_stack_ref (a->stack, SCM_MAKINUM (end))); + j = SCM_FRAME_NUMBER (scm_stack_ref (a->stack, scm_from_int (end))); for (i = 0; j > 0; ++i) j /= 10; nfield = i ? i : 1; /* Print frames. */ - frame = scm_stack_ref (a->stack, SCM_MAKINUM (beg)); + frame = scm_stack_ref (a->stack, scm_from_int (beg)); indentation = 1; last_file = SCM_UNDEFINED; for (i = 0; i < n; ++i) diff --git a/libguile/convert.i.c b/libguile/convert.i.c index 282854400..b66e31806 100644 --- a/libguile/convert.i.c +++ b/libguile/convert.i.c @@ -255,7 +255,7 @@ CTYPES2SCM (const CTYPE *data, long n) #ifdef FLOATTYPE SCM_VECTOR_SET (v, i, scm_make_real ((double) data[i])); #else - SCM_VECTOR_SET (v, i, SCM_MAKINUM (data[i])); + SCM_VECTOR_SET (v, i, scm_from_signed_integer (data[i])); #endif return v; } diff --git a/libguile/debug-malloc.c b/libguile/debug-malloc.c index 4d1c1c28b..c51b3f9f8 100644 --- a/libguile/debug-malloc.c +++ b/libguile/debug-malloc.c @@ -217,7 +217,7 @@ SCM_DEFINE (scm_malloc_stats, "malloc-stats", 0, 0, 0, for (i = 0; i < malloc_type_size + N_SEEK; ++i) if (malloc_type[i].key) res = scm_acons (scm_makfrom0str ((char *) malloc_type[i].key), - SCM_MAKINUM ((int) malloc_type[i].data), + SCM_I_MAKINUM ((int) malloc_type[i].data), res); return res; } diff --git a/libguile/dynl.c b/libguile/dynl.c index 16431b0cc..775836cfa 100644 --- a/libguile/dynl.c +++ b/libguile/dynl.c @@ -314,7 +314,7 @@ SCM_DEFINE (scm_dynamic_args_call, "dynamic-args-call", 3, 0, 0, result = (*fptr) (argc, argv); free (argv); - return SCM_MAKINUM (0L + result); + return SCM_I_MAKINUM (0L + result); } #undef FUNC_NAME diff --git a/libguile/environments.c b/libguile/environments.c index 92b46f570..e907f6f76 100644 --- a/libguile/environments.c +++ b/libguile/environments.c @@ -481,7 +481,7 @@ static int observer_print (SCM type, SCM port, scm_print_state *pstate SCM_UNUSED) { SCM address = scm_ulong2num (SCM_UNPACK (type)); - SCM base16 = scm_number_to_string (address, SCM_MAKINUM (16)); + SCM base16 = scm_number_to_string (address, SCM_I_MAKINUM (16)); scm_puts ("#funcs = funcs; body->observers = SCM_EOL; - body->weak_observers = scm_make_weak_value_alist_vector (SCM_MAKINUM (1)); + body->weak_observers = scm_make_weak_value_alist_vector (SCM_I_MAKINUM (1)); } @@ -979,7 +979,7 @@ static int leaf_environment_print (SCM type, SCM port, scm_print_state *pstate SCM_UNUSED) { SCM address = scm_ulong2num (SCM_UNPACK (type)); - SCM base16 = scm_number_to_string (address, SCM_MAKINUM (16)); + SCM base16 = scm_number_to_string (address, SCM_I_MAKINUM (16)); scm_puts ("# 0 && s[0] == '/') #endif /* ndef __MINGW32__ */ - return scm_substring (filename, SCM_INUM0, SCM_MAKINUM (1)); + return scm_substring (filename, SCM_INUM0, SCM_I_MAKINUM (1)); else return scm_dot_string; } else - return scm_substring (filename, SCM_INUM0, SCM_MAKINUM (i + 1)); + return scm_substring (filename, SCM_INUM0, SCM_I_MAKINUM (i + 1)); } #undef FUNC_NAME @@ -1548,12 +1548,12 @@ SCM_DEFINE (scm_basename, "basename", 1, 1, 0, #else if (len > 0 && f[0] == '/') #endif /* ndef __MINGW32__ */ - return scm_substring (filename, SCM_INUM0, SCM_MAKINUM (1)); + return scm_substring (filename, SCM_INUM0, SCM_I_MAKINUM (1)); else return scm_dot_string; } else - return scm_substring (filename, SCM_MAKINUM (i + 1), SCM_MAKINUM (end + 1)); + return scm_substring (filename, SCM_I_MAKINUM (i + 1), SCM_I_MAKINUM (end + 1)); } #undef FUNC_NAME diff --git a/libguile/fports.c b/libguile/fports.c index 3077318e5..af7116b80 100644 --- a/libguile/fports.c +++ b/libguile/fports.c @@ -214,7 +214,7 @@ scm_evict_ports (int fd) fp->fdes = dup (fd); if (fp->fdes == -1) scm_syserror ("scm_evict_ports"); - scm_set_port_revealed_x (port, SCM_MAKINUM (0)); + scm_set_port_revealed_x (port, SCM_I_MAKINUM (0)); } } } @@ -845,9 +845,9 @@ scm_init_fports () { scm_tc16_fport = scm_make_fptob (); - scm_c_define ("_IOFBF", SCM_MAKINUM (_IOFBF)); - scm_c_define ("_IOLBF", SCM_MAKINUM (_IOLBF)); - scm_c_define ("_IONBF", SCM_MAKINUM (_IONBF)); + scm_c_define ("_IOFBF", SCM_I_MAKINUM (_IOFBF)); + scm_c_define ("_IOLBF", SCM_I_MAKINUM (_IOLBF)); + scm_c_define ("_IONBF", SCM_I_MAKINUM (_IONBF)); #include "libguile/fports.x" } diff --git a/libguile/futures.c b/libguile/futures.c index 4fd161733..b2bb99e10 100644 --- a/libguile/futures.c +++ b/libguile/futures.c @@ -60,7 +60,7 @@ count (SCM ls) ++n; ls = SCM_FUTURE_NEXT (ls); } - return SCM_MAKINUM (n); + return SCM_I_MAKINUM (n); } extern SCM scm_future_cache_status (void); @@ -76,7 +76,7 @@ SCM_DEFINE (scm_future_cache_status, "future-cache-status", 0, 0, 0, count (young), count (old), count (undead), - SCM_MAKINUM (nd)); + SCM_I_MAKINUM (nd)); } #undef FUNC_NAME diff --git a/libguile/gc.c b/libguile/gc.c index c8709e03b..b1679c743 100644 --- a/libguile/gc.c +++ b/libguile/gc.c @@ -720,8 +720,8 @@ scm_gc_protect_object (SCM obj) /* This critical section barrier will be replaced by a mutex. */ SCM_REDEFER_INTS; - handle = scm_hashq_create_handle_x (scm_protects, obj, SCM_MAKINUM (0)); - SCM_SETCDR (handle, scm_sum (SCM_CDR (handle), SCM_MAKINUM (1))); + handle = scm_hashq_create_handle_x (scm_protects, obj, SCM_I_MAKINUM (0)); + SCM_SETCDR (handle, scm_sum (SCM_CDR (handle), SCM_I_MAKINUM (1))); protected_obj_count ++; @@ -752,8 +752,8 @@ scm_gc_unprotect_object (SCM obj) } else { - SCM count = scm_difference (SCM_CDR (handle), SCM_MAKINUM (1)); - if (SCM_EQ_P (count, SCM_MAKINUM (0))) + SCM count = scm_difference (SCM_CDR (handle), SCM_I_MAKINUM (1)); + if (SCM_EQ_P (count, SCM_I_MAKINUM (0))) scm_hashq_remove_x (scm_protects, obj); else SCM_SETCDR (handle, count); @@ -774,8 +774,8 @@ scm_gc_register_root (SCM *p) /* This critical section barrier will be replaced by a mutex. */ SCM_REDEFER_INTS; - handle = scm_hashv_create_handle_x (scm_gc_registered_roots, key, SCM_MAKINUM (0)); - SCM_SETCDR (handle, scm_sum (SCM_CDR (handle), SCM_MAKINUM (1))); + handle = scm_hashv_create_handle_x (scm_gc_registered_roots, key, SCM_I_MAKINUM (0)); + SCM_SETCDR (handle, scm_sum (SCM_CDR (handle), SCM_I_MAKINUM (1))); SCM_REALLOW_INTS; } @@ -798,8 +798,8 @@ scm_gc_unregister_root (SCM *p) } else { - SCM count = scm_difference (SCM_CDR (handle), SCM_MAKINUM (1)); - if (SCM_EQ_P (count, SCM_MAKINUM (0))) + SCM count = scm_difference (SCM_CDR (handle), SCM_I_MAKINUM (1)); + if (SCM_EQ_P (count, SCM_I_MAKINUM (0))) scm_hashv_remove_x (scm_gc_registered_roots, key); else SCM_SETCDR (handle, count); diff --git a/libguile/gdbint.c b/libguile/gdbint.c index 3d69c92c4..effd735e0 100644 --- a/libguile/gdbint.c +++ b/libguile/gdbint.c @@ -183,10 +183,10 @@ gdb_read (char *str) } SCM_BEGIN_FOREIGN_BLOCK; unmark_port (gdb_input_port); - scm_seek (gdb_input_port, SCM_INUM0, SCM_MAKINUM (SEEK_SET)); + scm_seek (gdb_input_port, SCM_INUM0, SCM_I_MAKINUM (SEEK_SET)); scm_puts (str, gdb_input_port); scm_truncate_file (gdb_input_port, SCM_UNDEFINED); - scm_seek (gdb_input_port, SCM_INUM0, SCM_MAKINUM (SEEK_SET)); + scm_seek (gdb_input_port, SCM_INUM0, SCM_I_MAKINUM (SEEK_SET)); /* Read one object */ tok_buf_mark_p = SCM_GC_MARK_P (tok_buf); SCM_CLEAR_GC_MARK (tok_buf); @@ -242,7 +242,7 @@ gdb_print (SCM obj) RESET_STRING; SCM_BEGIN_FOREIGN_BLOCK; /* Reset stream */ - scm_seek (gdb_output_port, SCM_INUM0, SCM_MAKINUM (SEEK_SET)); + scm_seek (gdb_output_port, SCM_INUM0, SCM_I_MAKINUM (SEEK_SET)); scm_write (obj, gdb_output_port); scm_truncate_file (gdb_output_port, SCM_UNDEFINED); { @@ -285,13 +285,13 @@ scm_init_gdbint () scm_print_carefully_p = 0; port = scm_mkstrport (SCM_INUM0, - scm_make_string (SCM_MAKINUM (0), SCM_UNDEFINED), + scm_make_string (SCM_I_MAKINUM (0), SCM_UNDEFINED), SCM_OPN | SCM_WRTNG, s); gdb_output_port = scm_permanent_object (port); port = scm_mkstrport (SCM_INUM0, - scm_make_string (SCM_MAKINUM (0), SCM_UNDEFINED), + scm_make_string (SCM_I_MAKINUM (0), SCM_UNDEFINED), SCM_OPN | SCM_RDNG | SCM_WRTNG, s); gdb_input_port = scm_permanent_object (port); diff --git a/libguile/gh_data.c b/libguile/gh_data.c index e08207ffe..0bc5e4f1a 100644 --- a/libguile/gh_data.c +++ b/libguile/gh_data.c @@ -103,7 +103,7 @@ gh_ints2scm (const int *d, long n) long i; SCM v = scm_c_make_vector (n, SCM_UNSPECIFIED); for (i = 0; i < n; ++i) - SCM_VECTOR_SET (v, i, (SCM_FIXABLE (d[i]) ? SCM_MAKINUM (d[i]) : scm_i_long2big (d[i]))); + SCM_VECTOR_SET (v, i, (SCM_FIXABLE (d[i]) ? SCM_I_MAKINUM (d[i]) : scm_i_long2big (d[i]))); return v; } diff --git a/libguile/goops.c b/libguile/goops.c index a8c6132e5..4650add54 100644 --- a/libguile/goops.c +++ b/libguile/goops.c @@ -310,7 +310,7 @@ compute_getters_n_setters (SCM slots) } *cdrloc = scm_cons (scm_cons (SCM_CAAR (slots), scm_cons (init, - SCM_MAKINUM (i++))), + SCM_I_MAKINUM (i++))), SCM_EOL); cdrloc = SCM_CDRLOC (*cdrloc); } @@ -649,7 +649,7 @@ scm_basic_basic_make_class (SCM class, SCM name, SCM dsupers, SCM dslots) SCM_SET_SLOT (z, scm_si_direct_supers, dsupers); cpl = compute_cpl (z); slots = build_slots_list (maplist (dslots), cpl); - nfields = SCM_MAKINUM (scm_ilength (slots)); + nfields = SCM_I_MAKINUM (scm_ilength (slots)); g_n_s = compute_getters_n_setters (slots); SCM_SET_SLOT (z, scm_si_name, name); @@ -779,7 +779,7 @@ create_basic_classes (void) SCM_SET_SLOT (scm_class_class, scm_si_direct_methods, SCM_EOL); SCM_SET_SLOT (scm_class_class, scm_si_cpl, SCM_EOL); /* will be changed */ /* SCM_SET_SLOT (scm_class_class, scm_si_slots, slots_of_class); */ - SCM_SET_SLOT (scm_class_class, scm_si_nfields, SCM_MAKINUM (SCM_N_CLASS_SLOTS)); + SCM_SET_SLOT (scm_class_class, scm_si_nfields, SCM_I_MAKINUM (SCM_N_CLASS_SLOTS)); /* SCM_SET_SLOT (scm_class_class, scm_si_getters_n_setters, compute_getters_n_setters (slots_of_class)); */ SCM_SET_SLOT (scm_class_class, scm_si_redefined, SCM_BOOL_F); @@ -1629,7 +1629,7 @@ scm_make_method_cache (SCM gf) { return scm_list_5 (SCM_IM_DISPATCH, scm_sym_args, - SCM_MAKINUM (1), + SCM_I_MAKINUM (1), scm_c_make_vector (SCM_INITIAL_MCACHE_SIZE, list_of_no_method), gf); @@ -2719,11 +2719,11 @@ scm_add_slot (SCM class, char *slot_name, SCM slot_class, scm_list_1 (slot)))); { SCM n = SCM_SLOT (class, scm_si_nfields); - SCM gns = scm_list_n (name, SCM_BOOL_F, get, set, n, SCM_MAKINUM (1)); + SCM gns = scm_list_n (name, SCM_BOOL_F, get, set, n, SCM_I_MAKINUM (1)); SCM_SET_SLOT (class, scm_si_getters_n_setters, scm_append_x (scm_list_2 (SCM_SLOT (class, scm_si_getters_n_setters), scm_list_1 (gns)))); - SCM_SET_SLOT (class, scm_si_nfields, SCM_MAKINUM (SCM_INUM (n) + 1)); + SCM_SET_SLOT (class, scm_si_nfields, SCM_I_MAKINUM (SCM_INUM (n) + 1)); } } } @@ -2823,7 +2823,7 @@ scm_init_goops_builtins (void) scm_permanent_object (scm_goops_lookup_closure); scm_components = scm_permanent_object (scm_make_weak_key_hash_table - (SCM_MAKINUM (37))); + (SCM_I_MAKINUM (37))); goops_rstate = scm_c_make_rstate ("GOOPS", 5); diff --git a/libguile/gsubr.c b/libguile/gsubr.c index e1cc30700..419fad40d 100644 --- a/libguile/gsubr.c +++ b/libguile/gsubr.c @@ -86,7 +86,7 @@ create_gsubr (int define, const char *name, } SCM_SET_GSUBR_PROC (cclo, subr); SCM_SET_GSUBR_TYPE (cclo, - SCM_MAKINUM (SCM_GSUBR_MAKTYPE (req, opt, rst))); + SCM_I_MAKINUM (SCM_GSUBR_MAKTYPE (req, opt, rst))); if (SCM_REC_PROCNAMES_P) scm_set_procedure_property_x (cclo, scm_sym_name, sym); if (define) @@ -193,7 +193,7 @@ scm_gsubr_apply (SCM args) if (n > SCM_GSUBR_MAX) scm_misc_error (FUNC_NAME, "Function ~S has illegal arity ~S.", - scm_list_2 (self, SCM_MAKINUM (n))); + scm_list_2 (self, SCM_I_MAKINUM (n))); #endif args = SCM_CDR (args); for (i = 0; i < SCM_GSUBR_REQ (typ); i++) { diff --git a/libguile/guardians.c b/libguile/guardians.c index 01db7dfbb..95f95c745 100644 --- a/libguile/guardians.c +++ b/libguile/guardians.c @@ -604,7 +604,7 @@ scm_init_guardians () whine_about_self_centered_zombies, 0, 0); greedily_guarded_whash = - scm_permanent_object (scm_make_doubly_weak_hash_table (SCM_MAKINUM (31))); + scm_permanent_object (scm_make_doubly_weak_hash_table (SCM_I_MAKINUM (31))); #include "libguile/guardians.x" } diff --git a/libguile/hash.c b/libguile/hash.c index 750aeaffe..ddd822c81 100644 --- a/libguile/hash.c +++ b/libguile/hash.c @@ -91,20 +91,20 @@ scm_hasher(SCM obj, unsigned long n, size_t d) case scm_tc7_number: switch SCM_TYP16 (obj) { case scm_tc16_big: - return SCM_INUM (scm_modulo (obj, SCM_MAKINUM (n))); + return SCM_INUM (scm_modulo (obj, SCM_I_MAKINUM (n))); case scm_tc16_real: { double r = SCM_REAL_VALUE (obj); if (floor (r) == r) { obj = scm_inexact_to_exact (obj); if SCM_IMP (obj) return SCM_INUM (obj) % n; - return SCM_INUM (scm_modulo (obj, SCM_MAKINUM (n))); + return SCM_INUM (scm_modulo (obj, SCM_I_MAKINUM (n))); } } /* Fall through */ case scm_tc16_complex: case scm_tc16_fraction: - obj = scm_number_to_string (obj, SCM_MAKINUM (10)); + obj = scm_number_to_string (obj, SCM_I_MAKINUM (10)); /* Fall through */ } /* Fall through */ @@ -172,7 +172,7 @@ SCM_DEFINE (scm_hashq, "hashq", 2, 0, 0, #define FUNC_NAME s_scm_hashq { SCM_VALIDATE_INUM_MIN (2, size, 0); - return SCM_MAKINUM (scm_ihashq (key, SCM_INUM (size))); + return SCM_I_MAKINUM (scm_ihashq (key, SCM_INUM (size))); } #undef FUNC_NAME @@ -208,7 +208,7 @@ SCM_DEFINE (scm_hashv, "hashv", 2, 0, 0, #define FUNC_NAME s_scm_hashv { SCM_VALIDATE_INUM_MIN (2, size, 0); - return SCM_MAKINUM (scm_ihashv (key, SCM_INUM (size))); + return SCM_I_MAKINUM (scm_ihashv (key, SCM_INUM (size))); } #undef FUNC_NAME @@ -231,7 +231,7 @@ SCM_DEFINE (scm_hash, "hash", 2, 0, 0, #define FUNC_NAME s_scm_hash { SCM_VALIDATE_INUM_MIN (2, size, 0); - return SCM_MAKINUM (scm_ihash (key, SCM_INUM (size))); + return SCM_I_MAKINUM (scm_ihash (key, SCM_INUM (size))); } #undef FUNC_NAME diff --git a/libguile/hashtab.c b/libguile/hashtab.c index ce077a397..1b83e4b0f 100644 --- a/libguile/hashtab.c +++ b/libguile/hashtab.c @@ -90,7 +90,7 @@ make_hash_table (int flags, unsigned long k, const char *func_name) { perform the final scan for broken references. Instead we do that ourselves in scan_weak_hashtables. */ vector = scm_i_allocate_weak_vector (flags | SCM_WVECTF_NOSCAN, - SCM_MAKINUM (n), + SCM_I_MAKINUM (n), SCM_EOL, func_name); else @@ -155,7 +155,7 @@ scm_i_rehash (SCM table, if (SCM_HASHTABLE_WEAK_P (table)) new_buckets = scm_i_allocate_weak_vector (SCM_HASHTABLE_FLAGS (table) | SCM_WVECTF_NOSCAN, - SCM_MAKINUM (new_size), + SCM_I_MAKINUM (new_size), SCM_EOL, func_name); else diff --git a/libguile/hooks.c b/libguile/hooks.c index 0804d05ee..5be45b0bc 100644 --- a/libguile/hooks.c +++ b/libguile/hooks.c @@ -260,7 +260,7 @@ SCM_DEFINE (scm_run_hook, "run-hook", 1, 0, 1, SCM_VALIDATE_HOOK (1, hook); if (scm_ilength (args) != SCM_HOOK_ARITY (hook)) SCM_MISC_ERROR ("Hook ~S requires ~A arguments", - scm_list_2 (hook, SCM_MAKINUM (SCM_HOOK_ARITY (hook)))); + scm_list_2 (hook, SCM_I_MAKINUM (SCM_HOOK_ARITY (hook)))); scm_c_run_hook (hook, args); return SCM_UNSPECIFIED; } diff --git a/libguile/ioext.c b/libguile/ioext.c index 59460afa7..9763e526d 100644 --- a/libguile/ioext.c +++ b/libguile/ioext.c @@ -53,7 +53,7 @@ SCM_DEFINE (scm_ftell, "ftell", 1, 0, 0, "@end lisp") #define FUNC_NAME s_scm_ftell { - return scm_seek (fd_port, SCM_INUM0, SCM_MAKINUM (SEEK_CUR)); + return scm_seek (fd_port, SCM_INUM0, SCM_I_MAKINUM (SEEK_CUR)); } #undef FUNC_NAME @@ -127,7 +127,7 @@ SCM_DEFINE (scm_dup_to_fdes, "dup->fdes", 1, 1, 0, newfd = dup (oldfd); if (newfd == -1) SCM_SYSERROR; - fd = SCM_MAKINUM (newfd); + fd = SCM_I_MAKINUM (newfd); } else { @@ -178,7 +178,7 @@ SCM_DEFINE (scm_fileno, "fileno", 1, 0, 0, { port = SCM_COERCE_OUTPORT (port); SCM_VALIDATE_OPFPORT (1, port); - return SCM_MAKINUM (SCM_FPORT_FDES (port)); + return SCM_I_MAKINUM (SCM_FPORT_FDES (port)); } #undef FUNC_NAME diff --git a/libguile/list.c b/libguile/list.c index 74093427f..c22c42594 100644 --- a/libguile/list.c +++ b/libguile/list.c @@ -196,7 +196,7 @@ SCM_DEFINE (scm_length, "length", 1, 0, 0, { long i; SCM_VALIDATE_LIST_COPYLEN (1, lst, i); - return SCM_MAKINUM (i); + return SCM_I_MAKINUM (i); } #undef FUNC_NAME diff --git a/libguile/net_db.c b/libguile/net_db.c index 35abb95f2..b5c0c20e1 100644 --- a/libguile/net_db.c +++ b/libguile/net_db.c @@ -171,8 +171,8 @@ SCM_DEFINE (scm_gethost, "gethost", 0, 1, 0, SCM_VECTOR_SET(result, 0, scm_mem2string (entry->h_name, strlen (entry->h_name))); SCM_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->h_aliases)); - SCM_VECTOR_SET(result, 2, SCM_MAKINUM (entry->h_addrtype + 0L)); - SCM_VECTOR_SET(result, 3, SCM_MAKINUM (entry->h_length + 0L)); + SCM_VECTOR_SET(result, 2, SCM_I_MAKINUM (entry->h_addrtype + 0L)); + SCM_VECTOR_SET(result, 3, SCM_I_MAKINUM (entry->h_length + 0L)); if (sizeof (struct in_addr) != entry->h_length) { SCM_VECTOR_SET(result, 4, SCM_BOOL_F); @@ -239,7 +239,7 @@ SCM_DEFINE (scm_getnet, "getnet", 0, 1, 0, SCM_SYSERROR_MSG ("no such network ~A", scm_list_1 (net), errno); SCM_VECTOR_SET(result, 0, scm_mem2string (entry->n_name, strlen (entry->n_name))); SCM_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->n_aliases)); - SCM_VECTOR_SET(result, 2, SCM_MAKINUM (entry->n_addrtype + 0L)); + SCM_VECTOR_SET(result, 2, SCM_I_MAKINUM (entry->n_addrtype + 0L)); SCM_VECTOR_SET(result, 3, scm_ulong2num (entry->n_net + 0L)); return result; } @@ -285,7 +285,7 @@ SCM_DEFINE (scm_getproto, "getproto", 0, 1, 0, SCM_SYSERROR_MSG ("no such protocol ~A", scm_list_1 (protocol), errno); SCM_VECTOR_SET(result, 0, scm_mem2string (entry->p_name, strlen (entry->p_name))); SCM_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->p_aliases)); - SCM_VECTOR_SET(result, 2, SCM_MAKINUM (entry->p_proto + 0L)); + SCM_VECTOR_SET(result, 2, SCM_I_MAKINUM (entry->p_proto + 0L)); return result; } #undef FUNC_NAME @@ -299,7 +299,7 @@ scm_return_entry (struct servent *entry) SCM_VECTOR_SET(result, 0, scm_mem2string (entry->s_name, strlen (entry->s_name))); SCM_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->s_aliases)); - SCM_VECTOR_SET(result, 2, SCM_MAKINUM (ntohs (entry->s_port) + 0L)); + SCM_VECTOR_SET(result, 2, SCM_I_MAKINUM (ntohs (entry->s_port) + 0L)); SCM_VECTOR_SET(result, 3, scm_mem2string (entry->s_proto, strlen (entry->s_proto))); return result; } diff --git a/libguile/num2integral.i.c b/libguile/num2integral.i.c index 4581d8b65..c5523b38f 100644 --- a/libguile/num2integral.i.c +++ b/libguile/num2integral.i.c @@ -182,17 +182,17 @@ INTEGRAL2NUM (ITYPE n) /* have to use #if here rather than if because of gcc warnings about limited range */ #if SIZEOF_ITYPE < SIZEOF_SCM_T_BITS - return SCM_MAKINUM ((scm_t_signed_bits) n); + return SCM_I_MAKINUM ((scm_t_signed_bits) n); #else /* not SIZEOF_ITYPE < SIZEOF_SCM_T_BITS */ if (UNSIGNED) { if (SCM_POSFIXABLE (n)) - return SCM_MAKINUM ((scm_t_signed_bits) n); + return SCM_I_MAKINUM ((scm_t_signed_bits) n); } else { if (SCM_FIXABLE (n)) - return SCM_MAKINUM ((scm_t_signed_bits) n); + return SCM_I_MAKINUM ((scm_t_signed_bits) n); } return INTEGRAL2BIG (n); #endif /* not SIZEOF_ITYPE < SIZEOF_SCM_T_BITS */ diff --git a/libguile/options.c b/libguile/options.c index 02357e08e..9262d34fa 100644 --- a/libguile/options.c +++ b/libguile/options.c @@ -109,7 +109,7 @@ get_option_setting (const scm_t_option options[], unsigned int n) ls = scm_cons (SCM_PACK (options[i].name), ls); break; case SCM_OPTION_INTEGER: - ls = scm_cons (SCM_MAKINUM (options[i].val), ls); + ls = scm_cons (SCM_I_MAKINUM (options[i].val), ls); ls = scm_cons (SCM_PACK (options[i].name), ls); break; case SCM_OPTION_SCM: @@ -138,7 +138,7 @@ get_documented_option_setting (const scm_t_option options[], unsigned int n) ls = scm_cons (options[i].val ? scm_yes_sym : scm_no_sym, ls); break; case SCM_OPTION_INTEGER: - ls = scm_cons (SCM_MAKINUM (options[i].val), ls); + ls = scm_cons (SCM_I_MAKINUM (options[i].val), ls); break; case SCM_OPTION_SCM: ls = scm_cons (SCM_PACK (options[i].val), ls); diff --git a/libguile/ports.c b/libguile/ports.c index 7da3c704f..dc35a908f 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -587,7 +587,7 @@ SCM_DEFINE (scm_pt_size, "pt-size", 0, 0, 0, "is only included in @code{--enable-guile-debug} builds.") #define FUNC_NAME s_scm_pt_size { - return SCM_MAKINUM (scm_i_port_table_size); + return SCM_I_MAKINUM (scm_i_port_table_size); } #undef FUNC_NAME @@ -641,7 +641,7 @@ SCM_DEFINE (scm_port_revealed, "port-revealed", 1, 0, 0, { port = SCM_COERCE_OUTPORT (port); SCM_VALIDATE_OPENPORT (1, port); - return SCM_MAKINUM (scm_revealed_count (port)); + return SCM_I_MAKINUM (scm_revealed_count (port)); } #undef FUNC_NAME @@ -1411,7 +1411,7 @@ SCM_DEFINE (scm_truncate_file, "truncate-file", 1, 1, 0, if (SCM_STRINGP (object)) SCM_MISC_ERROR("must supply length if OBJECT is a filename", SCM_EOL); - length = scm_seek (object, SCM_INUM0, SCM_MAKINUM (SEEK_CUR)); + length = scm_seek (object, SCM_INUM0, SCM_I_MAKINUM (SEEK_CUR)); } c_length = SCM_NUM2LONG (2, length); if (c_length < 0) @@ -1460,7 +1460,7 @@ SCM_DEFINE (scm_port_line, "port-line", 1, 0, 0, { port = SCM_COERCE_OUTPORT (port); SCM_VALIDATE_OPENPORT (1, port); - return SCM_MAKINUM (SCM_LINUM (port)); + return SCM_I_MAKINUM (SCM_LINUM (port)); } #undef FUNC_NAME @@ -1492,7 +1492,7 @@ SCM_DEFINE (scm_port_column, "port-column", 1, 0, 0, { port = SCM_COERCE_OUTPORT (port); SCM_VALIDATE_OPENPORT (1, port); - return SCM_MAKINUM (SCM_COL (port)); + return SCM_I_MAKINUM (SCM_COL (port)); } #undef FUNC_NAME @@ -1636,9 +1636,9 @@ void scm_init_ports () { /* lseek() symbols. */ - scm_c_define ("SEEK_SET", SCM_MAKINUM (SEEK_SET)); - scm_c_define ("SEEK_CUR", SCM_MAKINUM (SEEK_CUR)); - scm_c_define ("SEEK_END", SCM_MAKINUM (SEEK_END)); + scm_c_define ("SEEK_SET", SCM_I_MAKINUM (SEEK_SET)); + scm_c_define ("SEEK_CUR", SCM_I_MAKINUM (SEEK_CUR)); + scm_c_define ("SEEK_END", SCM_I_MAKINUM (SEEK_END)); scm_tc16_void_port = scm_make_port_type ("void", fill_input_void_port, write_void_port); diff --git a/libguile/posix.c b/libguile/posix.c index b02098fef..d2fb9571f 100644 --- a/libguile/posix.c +++ b/libguile/posix.c @@ -283,7 +283,7 @@ SCM_DEFINE (scm_setgroups, "setgroups", 1, 0, 0, size = ngroups * sizeof (GETGROUPS_T); if (size / sizeof (GETGROUPS_T) != ngroups) - SCM_OUT_OF_RANGE (SCM_ARG1, SCM_MAKINUM (ngroups)); + SCM_OUT_OF_RANGE (SCM_ARG1, SCM_I_MAKINUM (ngroups)); groups = scm_malloc (size); for(i = 0; i < ngroups; i++) groups [i] = SCM_NUM2ULONG (1, SCM_VECTOR_REF (group_vec, i)); @@ -518,7 +518,7 @@ SCM_DEFINE (scm_waitpid, "waitpid", 1, 1, 0, SCM_SYSCALL (i = waitpid (SCM_INUM (pid), &status, ioptions)); if (i == -1) SCM_SYSERROR; - return scm_cons (SCM_MAKINUM (0L + i), SCM_MAKINUM (0L + status)); + return scm_cons (SCM_I_MAKINUM (0L + i), SCM_I_MAKINUM (0L + status)); } #undef FUNC_NAME #endif /* HAVE_WAITPID */ @@ -539,7 +539,7 @@ SCM_DEFINE (scm_status_exit_val, "status:exit-val", 1, 0, 0, go figure. SCM_INUM does not yield an lvalue. */ lstatus = SCM_INUM (status); if (WIFEXITED (lstatus)) - return (SCM_MAKINUM (WEXITSTATUS (lstatus))); + return (SCM_I_MAKINUM (WEXITSTATUS (lstatus))); else return SCM_BOOL_F; } @@ -557,7 +557,7 @@ SCM_DEFINE (scm_status_term_sig, "status:term-sig", 1, 0, 0, lstatus = SCM_INUM (status); if (WIFSIGNALED (lstatus)) - return SCM_MAKINUM (WTERMSIG (lstatus)); + return SCM_I_MAKINUM (WTERMSIG (lstatus)); else return SCM_BOOL_F; } @@ -575,7 +575,7 @@ SCM_DEFINE (scm_status_stop_sig, "status:stop-sig", 1, 0, 0, lstatus = SCM_INUM (status); if (WIFSTOPPED (lstatus)) - return SCM_MAKINUM (WSTOPSIG (lstatus)); + return SCM_I_MAKINUM (WSTOPSIG (lstatus)); else return SCM_BOOL_F; } @@ -589,7 +589,7 @@ SCM_DEFINE (scm_getppid, "getppid", 0, 0, 0, "process.") #define FUNC_NAME s_scm_getppid { - return SCM_MAKINUM (0L + getppid ()); + return SCM_I_MAKINUM (0L + getppid ()); } #undef FUNC_NAME #endif /* HAVE_GETPPID */ @@ -601,7 +601,7 @@ SCM_DEFINE (scm_getuid, "getuid", 0, 0, 0, "Return an integer representing the current real user ID.") #define FUNC_NAME s_scm_getuid { - return SCM_MAKINUM (0L + getuid ()); + return SCM_I_MAKINUM (0L + getuid ()); } #undef FUNC_NAME @@ -612,7 +612,7 @@ SCM_DEFINE (scm_getgid, "getgid", 0, 0, 0, "Return an integer representing the current real group ID.") #define FUNC_NAME s_scm_getgid { - return SCM_MAKINUM (0L + getgid ()); + return SCM_I_MAKINUM (0L + getgid ()); } #undef FUNC_NAME @@ -627,9 +627,9 @@ SCM_DEFINE (scm_geteuid, "geteuid", 0, 0, 0, #define FUNC_NAME s_scm_geteuid { #ifdef HAVE_GETEUID - return SCM_MAKINUM (0L + geteuid ()); + return SCM_I_MAKINUM (0L + geteuid ()); #else - return SCM_MAKINUM (0L + getuid ()); + return SCM_I_MAKINUM (0L + getuid ()); #endif } #undef FUNC_NAME @@ -644,9 +644,9 @@ SCM_DEFINE (scm_getegid, "getegid", 0, 0, 0, #define FUNC_NAME s_scm_getegid { #ifdef HAVE_GETEUID - return SCM_MAKINUM (0L + getegid ()); + return SCM_I_MAKINUM (0L + getegid ()); #else - return SCM_MAKINUM (0L + getgid ()); + return SCM_I_MAKINUM (0L + getgid ()); #endif } #undef FUNC_NAME @@ -741,7 +741,7 @@ SCM_DEFINE (scm_getpgrp, "getpgrp", 0, 0, 0, { int (*fn)(); fn = (int (*) ()) getpgrp; - return SCM_MAKINUM (fn (0)); + return SCM_I_MAKINUM (fn (0)); } #undef FUNC_NAME #endif /* HAVE_GETPGRP */ @@ -847,7 +847,7 @@ SCM_DEFINE (scm_tcgetpgrp, "tcgetpgrp", 1, 0, 0, fd = SCM_FPORT_FDES (port); if ((pgid = tcgetpgrp (fd)) == -1) SCM_SYSERROR; - return SCM_MAKINUM (pgid); + return SCM_I_MAKINUM (pgid); } #undef FUNC_NAME #endif /* HAVE_TCGETPGRP */ @@ -1033,7 +1033,7 @@ SCM_DEFINE (scm_fork, "primitive-fork", 0, 0, 0, pid = fork (); if (pid == -1) SCM_SYSERROR; - return SCM_MAKINUM (0L+pid); + return SCM_I_MAKINUM (0L+pid); } #undef FUNC_NAME #endif /* HAVE_FORK */ @@ -1229,7 +1229,7 @@ SCM_DEFINE (scm_getpid, "getpid", 0, 0, 0, "Return an integer representing the current process ID.") #define FUNC_NAME s_scm_getpid { - return SCM_MAKINUM ((unsigned long) getpid ()); + return SCM_I_MAKINUM ((unsigned long) getpid ()); } #undef FUNC_NAME @@ -1293,8 +1293,8 @@ SCM_DEFINE (scm_putenv, "putenv", 1, 0, 0, if (ptr[SCM_STRING_LENGTH (str) - 1] == '=') { char *alt; - SCM name = scm_substring (str, SCM_MAKINUM (0), - SCM_MAKINUM (SCM_STRING_LENGTH (str) - 1)); + SCM name = scm_substring (str, SCM_I_MAKINUM (0), + SCM_I_MAKINUM (SCM_STRING_LENGTH (str) - 1)); if (getenv (SCM_STRING_CHARS (name)) == NULL) { alt = scm_malloc (SCM_STRING_LENGTH (str) + 2); @@ -1562,7 +1562,7 @@ SCM_DEFINE (scm_getpriority, "getpriority", 2, 0, 0, ret = getpriority (cwhich, cwho); if (errno != 0) SCM_SYSERROR; - return SCM_MAKINUM (ret); + return SCM_I_MAKINUM (ret); } #undef FUNC_NAME #endif /* HAVE_GETPRIORITY */ @@ -1841,70 +1841,70 @@ scm_init_posix () scm_add_feature ("EIDs"); #endif #ifdef WAIT_ANY - scm_c_define ("WAIT_ANY", SCM_MAKINUM (WAIT_ANY)); + scm_c_define ("WAIT_ANY", SCM_I_MAKINUM (WAIT_ANY)); #endif #ifdef WAIT_MYPGRP - scm_c_define ("WAIT_MYPGRP", SCM_MAKINUM (WAIT_MYPGRP)); + scm_c_define ("WAIT_MYPGRP", SCM_I_MAKINUM (WAIT_MYPGRP)); #endif #ifdef WNOHANG - scm_c_define ("WNOHANG", SCM_MAKINUM (WNOHANG)); + scm_c_define ("WNOHANG", SCM_I_MAKINUM (WNOHANG)); #endif #ifdef WUNTRACED - scm_c_define ("WUNTRACED", SCM_MAKINUM (WUNTRACED)); + scm_c_define ("WUNTRACED", SCM_I_MAKINUM (WUNTRACED)); #endif /* access() symbols. */ - scm_c_define ("R_OK", SCM_MAKINUM (R_OK)); - scm_c_define ("W_OK", SCM_MAKINUM (W_OK)); - scm_c_define ("X_OK", SCM_MAKINUM (X_OK)); - scm_c_define ("F_OK", SCM_MAKINUM (F_OK)); + scm_c_define ("R_OK", SCM_I_MAKINUM (R_OK)); + scm_c_define ("W_OK", SCM_I_MAKINUM (W_OK)); + scm_c_define ("X_OK", SCM_I_MAKINUM (X_OK)); + scm_c_define ("F_OK", SCM_I_MAKINUM (F_OK)); #ifdef LC_COLLATE - scm_c_define ("LC_COLLATE", SCM_MAKINUM (LC_COLLATE)); + scm_c_define ("LC_COLLATE", SCM_I_MAKINUM (LC_COLLATE)); #endif #ifdef LC_CTYPE - scm_c_define ("LC_CTYPE", SCM_MAKINUM (LC_CTYPE)); + scm_c_define ("LC_CTYPE", SCM_I_MAKINUM (LC_CTYPE)); #endif #ifdef LC_MONETARY - scm_c_define ("LC_MONETARY", SCM_MAKINUM (LC_MONETARY)); + scm_c_define ("LC_MONETARY", SCM_I_MAKINUM (LC_MONETARY)); #endif #ifdef LC_NUMERIC - scm_c_define ("LC_NUMERIC", SCM_MAKINUM (LC_NUMERIC)); + scm_c_define ("LC_NUMERIC", SCM_I_MAKINUM (LC_NUMERIC)); #endif #ifdef LC_TIME - scm_c_define ("LC_TIME", SCM_MAKINUM (LC_TIME)); + scm_c_define ("LC_TIME", SCM_I_MAKINUM (LC_TIME)); #endif #ifdef LC_MESSAGES - scm_c_define ("LC_MESSAGES", SCM_MAKINUM (LC_MESSAGES)); + scm_c_define ("LC_MESSAGES", SCM_I_MAKINUM (LC_MESSAGES)); #endif #ifdef LC_ALL - scm_c_define ("LC_ALL", SCM_MAKINUM (LC_ALL)); + scm_c_define ("LC_ALL", SCM_I_MAKINUM (LC_ALL)); #endif #ifdef PIPE_BUF scm_c_define ("PIPE_BUF", scm_long2num (PIPE_BUF)); #endif #ifdef PRIO_PROCESS - scm_c_define ("PRIO_PROCESS", SCM_MAKINUM (PRIO_PROCESS)); + scm_c_define ("PRIO_PROCESS", SCM_I_MAKINUM (PRIO_PROCESS)); #endif #ifdef PRIO_PGRP - scm_c_define ("PRIO_PGRP", SCM_MAKINUM (PRIO_PGRP)); + scm_c_define ("PRIO_PGRP", SCM_I_MAKINUM (PRIO_PGRP)); #endif #ifdef PRIO_USER - scm_c_define ("PRIO_USER", SCM_MAKINUM (PRIO_USER)); + scm_c_define ("PRIO_USER", SCM_I_MAKINUM (PRIO_USER)); #endif #ifdef LOCK_SH - scm_c_define ("LOCK_SH", SCM_MAKINUM (LOCK_SH)); + scm_c_define ("LOCK_SH", SCM_I_MAKINUM (LOCK_SH)); #endif #ifdef LOCK_EX - scm_c_define ("LOCK_EX", SCM_MAKINUM (LOCK_EX)); + scm_c_define ("LOCK_EX", SCM_I_MAKINUM (LOCK_EX)); #endif #ifdef LOCK_UN - scm_c_define ("LOCK_UN", SCM_MAKINUM (LOCK_UN)); + scm_c_define ("LOCK_UN", SCM_I_MAKINUM (LOCK_UN)); #endif #ifdef LOCK_NB - scm_c_define ("LOCK_NB", SCM_MAKINUM (LOCK_NB)); + scm_c_define ("LOCK_NB", SCM_I_MAKINUM (LOCK_NB)); #endif #include "libguile/cpp_sig_symbols.c" diff --git a/libguile/procprop.c b/libguile/procprop.c index 5f30c30b2..3ba22e0a5 100644 --- a/libguile/procprop.c +++ b/libguile/procprop.c @@ -130,7 +130,7 @@ scm_i_procedure_arity (SCM proc) default: return SCM_BOOL_F; } - return scm_list_3 (SCM_MAKINUM (a), SCM_MAKINUM (o), scm_from_bool(r)); + return scm_list_3 (SCM_I_MAKINUM (a), SCM_I_MAKINUM (o), scm_from_bool(r)); } static SCM diff --git a/libguile/ramap.c b/libguile/ramap.c index 8f057fc0c..f570d4807 100644 --- a/libguile/ramap.c +++ b/libguile/ramap.c @@ -399,7 +399,7 @@ scm_ramapc (int (*cproc)(), SCM data, SCM ra0, SCM lra, const char *what) *plvra = scm_cons (vra1, SCM_EOL); plvra = SCM_CDRLOC (*plvra); } - inds = scm_make_uve (SCM_ARRAY_NDIM (ra0), SCM_MAKINUM (-1L)); + inds = scm_make_uve (SCM_ARRAY_NDIM (ra0), SCM_I_MAKINUM (-1L)); vinds = (long *) SCM_VELTS (inds); for (k = 0; k <= kmax; k++) vinds[k] = SCM_ARRAY_DIMS (ra0)[k].lbnd; @@ -459,7 +459,7 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore SCM_UNUSED) { default: for (i = base; n--; i += inc) - scm_array_set_x (ra, fill, SCM_MAKINUM (i)); + scm_array_set_x (ra, fill, SCM_I_MAKINUM (i)); break; case scm_tc7_vector: case scm_tc7_wvect: @@ -473,7 +473,7 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore SCM_UNUSED) break; case scm_tc7_byvect: if (SCM_CHARP (fill)) - fill = SCM_MAKINUM ((char) SCM_CHAR (fill)); + fill = SCM_I_MAKINUM ((char) SCM_CHAR (fill)); SCM_ASRTGO (SCM_INUMP (fill) && -128 <= SCM_INUM (fill) && SCM_INUM (fill) < 128, badarg2); @@ -625,7 +625,7 @@ racp (SCM src, SCM dst) for (; n-- > 0; i_s += inc_s, i_d += inc_d) scm_array_set_x (dst, scm_cvref (src, i_s, SCM_UNDEFINED), - SCM_MAKINUM (i_d)); + SCM_I_MAKINUM (i_d)); break; case scm_tc7_string: if (SCM_TYP7 (src) != scm_tc7_string) @@ -992,7 +992,7 @@ scm_ra_sum (SCM ra0, SCM ras) SCM e0 = SCM_UNDEFINED, e1 = SCM_UNDEFINED; for (; n-- > 0; i0 += inc0, i1 += inc1) scm_array_set_x (ra0, scm_sum (RVREF (ra0, i0, e0), RVREF (ra1, i1, e1)), - SCM_MAKINUM (i0)); + SCM_I_MAKINUM (i0)); break; } case scm_tc7_uvect: @@ -1028,7 +1028,7 @@ scm_ra_difference (SCM ra0, SCM ras) for (; n-- > 0; i0 += inc0) scm_array_set_x (ra0, scm_difference (RVREF (ra0, i0, e0), SCM_UNDEFINED), - SCM_MAKINUM (i0)); + SCM_I_MAKINUM (i0)); break; } case scm_tc7_fvect: @@ -1051,7 +1051,7 @@ scm_ra_difference (SCM ra0, SCM ras) { SCM e0 = SCM_UNDEFINED, e1 = SCM_UNDEFINED; for (; n-- > 0; i0 += inc0, i1 += inc1) - scm_array_set_x (ra0, scm_difference (RVREF (ra0, i0, e0), RVREF (ra1, i1, e1)), SCM_MAKINUM (i0)); + scm_array_set_x (ra0, scm_difference (RVREF (ra0, i0, e0), RVREF (ra1, i1, e1)), SCM_I_MAKINUM (i0)); break; } case scm_tc7_fvect: @@ -1087,7 +1087,7 @@ scm_ra_product (SCM ra0, SCM ras) SCM e0 = SCM_UNDEFINED, e1 = SCM_UNDEFINED; for (; n-- > 0; i0 += inc0, i1 += inc1) scm_array_set_x (ra0, scm_product (RVREF (ra0, i0, e0), RVREF (ra1, i1, e1)), - SCM_MAKINUM (i0)); + SCM_I_MAKINUM (i0)); break; } case scm_tc7_uvect: @@ -1133,7 +1133,7 @@ scm_ra_divide (SCM ra0, SCM ras) { SCM e0 = SCM_UNDEFINED; for (; n-- > 0; i0 += inc0) - scm_array_set_x (ra0, scm_divide (RVREF (ra0, i0, e0), SCM_UNDEFINED), SCM_MAKINUM (i0)); + scm_array_set_x (ra0, scm_divide (RVREF (ra0, i0, e0), SCM_UNDEFINED), SCM_I_MAKINUM (i0)); break; } case scm_tc7_fvect: @@ -1166,7 +1166,7 @@ scm_ra_divide (SCM ra0, SCM ras) { SCM e0 = SCM_UNDEFINED, e1 = SCM_UNDEFINED; for (; n-- > 0; i0 += inc0, i1 += inc1) - scm_array_set_x (ra0, scm_divide (RVREF (ra0, i0, e0), RVREF (ra1, i1, e1)), SCM_MAKINUM (i0)); + scm_array_set_x (ra0, scm_divide (RVREF (ra0, i0, e0), RVREF (ra1, i1, e1)), SCM_I_MAKINUM (i0)); break; } case scm_tc7_fvect: @@ -1213,7 +1213,7 @@ ramap (SCM ra0, SCM proc, SCM ras) ra0 = SCM_ARRAY_V (ra0); if (SCM_NULLP (ras)) for (; i <= n; i++) - scm_array_set_x (ra0, scm_call_0 (proc), SCM_MAKINUM (i * inc + base)); + scm_array_set_x (ra0, scm_call_0 (proc), SCM_I_MAKINUM (i * inc + base)); else { SCM ra1 = SCM_CAR (ras); @@ -1235,9 +1235,9 @@ ramap (SCM ra0, SCM proc, SCM ras) { args = SCM_EOL; for (k = SCM_INUM (scm_uniform_vector_length (ras)); k--;) - args = scm_cons (scm_uniform_vector_ref (ve[k], SCM_MAKINUM (i)), args); + args = scm_cons (scm_uniform_vector_ref (ve[k], SCM_I_MAKINUM (i)), args); args = scm_cons (scm_cvref (ra1, i1, SCM_UNDEFINED), args); - scm_array_set_x (ra0, scm_apply_0 (proc, args), SCM_MAKINUM (i * inc + base)); + scm_array_set_x (ra0, scm_apply_0 (proc, args), SCM_I_MAKINUM (i * inc + base)); } } return 1; @@ -1259,7 +1259,7 @@ ramap_dsubr (SCM ra0, SCM proc, SCM ras) default: gencase: for (; n-- > 0; i0 += inc0, i1 += inc1) - scm_array_set_x (ra0, scm_call_1 (proc, RVREF (ra1, i1, e1)), SCM_MAKINUM (i0)); + scm_array_set_x (ra0, scm_call_1 (proc, RVREF (ra1, i1, e1)), SCM_I_MAKINUM (i0)); break; case scm_tc7_fvect: { @@ -1335,8 +1335,8 @@ ramap_rp (SCM ra0, SCM proc, SCM ras) of a cell as raw data. Further: How can we be sure that the values fit into an inum? */ - SCM n1 = SCM_MAKINUM (((long *) SCM_UNPACK (SCM_CDR (ra1)))[i1]); - SCM n2 = SCM_MAKINUM (((long *) SCM_UNPACK (SCM_CDR (ra2)))[i2]); + SCM n1 = SCM_I_MAKINUM (((long *) SCM_UNPACK (SCM_CDR (ra1)))[i1]); + SCM n2 = SCM_I_MAKINUM (((long *) SCM_UNPACK (SCM_CDR (ra2)))[i2]); if (scm_is_false (SCM_SUBRF (proc) (n1, n2))) SCM_BITVEC_CLR (ra0, i0); } @@ -1402,10 +1402,10 @@ ramap_1 (SCM ra0, SCM proc, SCM ras) ra1 = SCM_ARRAY_V (ra1); if (scm_tc7_vector == SCM_TYP7 (ra0) || scm_tc7_wvect == SCM_TYP7 (ra0)) for (; n-- > 0; i0 += inc0, i1 += inc1) - scm_array_set_x (ra0, SCM_SUBRF (proc) (scm_cvref (ra1, i1, SCM_UNDEFINED)), SCM_MAKINUM (i0)); + scm_array_set_x (ra0, SCM_SUBRF (proc) (scm_cvref (ra1, i1, SCM_UNDEFINED)), SCM_I_MAKINUM (i0)); else for (; n-- > 0; i0 += inc0, i1 += inc1) - scm_array_set_x (ra0, SCM_SUBRF (proc) (RVREF (ra1, i1, e1)), SCM_MAKINUM (i0)); + scm_array_set_x (ra0, SCM_SUBRF (proc) (RVREF (ra1, i1, e1)), SCM_I_MAKINUM (i0)); return 1; } @@ -1429,11 +1429,11 @@ ramap_2o (SCM ra0, SCM proc, SCM ras) for (; n-- > 0; i0 += inc0, i1 += inc1) scm_array_set_x (ra0, SCM_SUBRF (proc) (scm_cvref (ra1, i1, SCM_UNDEFINED), SCM_UNDEFINED), - SCM_MAKINUM (i0)); + SCM_I_MAKINUM (i0)); else for (; n-- > 0; i0 += inc0, i1 += inc1) scm_array_set_x (ra0, SCM_SUBRF (proc) (RVREF (ra1, i1, e1), SCM_UNDEFINED), - SCM_MAKINUM (i0)); + SCM_I_MAKINUM (i0)); } else { @@ -1446,12 +1446,12 @@ ramap_2o (SCM ra0, SCM proc, SCM ras) for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2) scm_array_set_x (ra0, SCM_SUBRF (proc) (scm_cvref (ra1, i1, SCM_UNDEFINED), scm_cvref (ra2, i2, SCM_UNDEFINED)), - SCM_MAKINUM (i0)); + SCM_I_MAKINUM (i0)); else for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2) scm_array_set_x (ra0, SCM_SUBRF (proc) (RVREF (ra1, i1, e1), RVREF (ra2, i2, e2)), - SCM_MAKINUM (i0)); + SCM_I_MAKINUM (i0)); } return 1; } @@ -1468,7 +1468,7 @@ ramap_a (SCM ra0, SCM proc, SCM ras) ra0 = SCM_ARRAY_V (ra0); if (SCM_NULLP (ras)) for (; n-- > 0; i0 += inc0) - scm_array_set_x (ra0, SCM_SUBRF (proc) (RVREF (ra0, i0, e0), SCM_UNDEFINED), SCM_MAKINUM (i0)); + scm_array_set_x (ra0, SCM_SUBRF (proc) (RVREF (ra0, i0, e0), SCM_UNDEFINED), SCM_I_MAKINUM (i0)); else { SCM ra1 = SCM_CAR (ras); @@ -1477,7 +1477,7 @@ ramap_a (SCM ra0, SCM proc, SCM ras) ra1 = SCM_ARRAY_V (ra1); for (; n-- > 0; i0 += inc0, i1 += inc1) scm_array_set_x (ra0, SCM_SUBRF (proc) (RVREF (ra0, i0, e0), RVREF (ra1, i1, e1)), - SCM_MAKINUM (i0)); + SCM_I_MAKINUM (i0)); } return 1; } @@ -1628,7 +1628,7 @@ rafe (SCM ra0, SCM proc, SCM ras) { args = SCM_EOL; for (k = SCM_INUM (scm_uniform_vector_length (ras)); k--;) - args = scm_cons (scm_uniform_vector_ref (ve[k], SCM_MAKINUM (i)), args); + args = scm_cons (scm_uniform_vector_ref (ve[k], SCM_I_MAKINUM (i)), args); args = scm_cons2 (scm_cvref (ra0, i0, SCM_UNDEFINED), scm_cvref (ra1, i1, SCM_UNDEFINED), args); scm_apply_0 (proc, args); } @@ -1682,7 +1682,7 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 0, 0, case scm_tc7_wvect: { for (i = 0; i < SCM_VECTOR_LENGTH (ra); i++) - SCM_VECTOR_SET(ra, i, scm_call_1 (proc, SCM_MAKINUM (i))); + SCM_VECTOR_SET(ra, i, scm_call_1 (proc, SCM_I_MAKINUM (i))); return SCM_UNSPECIFIED; } case scm_tc7_string: @@ -1700,15 +1700,15 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 0, 0, { unsigned long int length = SCM_INUM (scm_uniform_vector_length (ra)); for (i = 0; i < length; i++) - scm_array_set_x (ra, scm_call_1 (proc, SCM_MAKINUM (i)), - SCM_MAKINUM (i)); + scm_array_set_x (ra, scm_call_1 (proc, SCM_I_MAKINUM (i)), + SCM_I_MAKINUM (i)); return SCM_UNSPECIFIED; } case scm_tc7_smob: SCM_ASRTGO (SCM_ARRAYP (ra), badarg); { SCM args = SCM_EOL; - SCM inds = scm_make_uve (SCM_ARRAY_NDIM (ra), SCM_MAKINUM (-1L)); + SCM inds = scm_make_uve (SCM_ARRAY_NDIM (ra), SCM_I_MAKINUM (-1L)); long *vinds = (long *) SCM_VELTS (inds); int j, k, kmax = SCM_ARRAY_NDIM (ra) - 1; if (kmax < 0) @@ -1725,10 +1725,10 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 0, 0, for (; vinds[k] <= SCM_ARRAY_DIMS (ra)[k].ubnd; vinds[k]++) { for (j = kmax + 1, args = SCM_EOL; j--;) - args = scm_cons (SCM_MAKINUM (vinds[j]), args); + args = scm_cons (SCM_I_MAKINUM (vinds[j]), args); scm_array_set_x (SCM_ARRAY_V (ra), scm_apply_0 (proc, args), - SCM_MAKINUM (i)); + SCM_I_MAKINUM (i)); i += SCM_ARRAY_DIMS (ra)[k].inc; } k--; diff --git a/libguile/random.c b/libguile/random.c index a05b8ca63..ace6234f0 100644 --- a/libguile/random.c +++ b/libguile/random.c @@ -353,7 +353,7 @@ SCM_DEFINE (scm_random, "random", 1, 1, 0, { unsigned long m = SCM_INUM (n); SCM_ASSERT_RANGE (1, n, m > 0); - return SCM_MAKINUM (scm_c_random (SCM_RSTATE (state), m)); + return SCM_I_MAKINUM (scm_c_random (SCM_RSTATE (state), m)); } SCM_VALIDATE_NIM (1, n); if (SCM_REALP (n)) diff --git a/libguile/regex-posix.c b/libguile/regex-posix.c index 56616fced..8792baf50 100644 --- a/libguile/regex-posix.c +++ b/libguile/regex-posix.c @@ -98,12 +98,12 @@ scm_regexp_error_msg (int regerrno, regex_t *rx) never returns, we would never have the opportunity to free it. Creating it as a SCM object means that the system will GC it at some point. */ - errmsg = scm_make_string (SCM_MAKINUM (80), SCM_UNDEFINED); + errmsg = scm_make_string (SCM_I_MAKINUM (80), SCM_UNDEFINED); SCM_DEFER_INTS; l = regerror (regerrno, rx, SCM_STRING_CHARS (errmsg), 80); if (l > 80) { - errmsg = scm_make_string (SCM_MAKINUM (l), SCM_UNDEFINED); + errmsg = scm_make_string (SCM_I_MAKINUM (l), SCM_UNDEFINED); regerror (regerrno, rx, SCM_STRING_CHARS (errmsg), l); } SCM_ALLOW_INTS; @@ -252,7 +252,7 @@ SCM_DEFINE (scm_regexp_exec, "regexp-exec", 2, 2, 0, SCM_VECTOR_SET(mvec,0, str); for (i = 0; i < nmatches; ++i) if (matches[i].rm_so == -1) - SCM_VECTOR_SET(mvec,i+1, scm_cons (SCM_MAKINUM (-1), SCM_MAKINUM (-1))); + SCM_VECTOR_SET(mvec,i+1, scm_cons (SCM_I_MAKINUM (-1), SCM_I_MAKINUM (-1))); else SCM_VECTOR_SET(mvec,i+1,scm_cons (scm_long2num (matches[i].rm_so + offset), scm_long2num (matches[i].rm_eo + offset))); diff --git a/libguile/scmsigs.c b/libguile/scmsigs.c index 296cd4e10..d5cb7c219 100644 --- a/libguile/scmsigs.c +++ b/libguile/scmsigs.c @@ -430,7 +430,7 @@ SCM_DEFINE (scm_sigaction_for_thread, "sigaction", 1, 3, 0, if (old_action.sa_handler == SIG_DFL || old_action.sa_handler == SIG_IGN) old_handler = scm_long2num ((long) old_action.sa_handler); SCM_ALLOW_INTS; - return scm_cons (old_handler, SCM_MAKINUM (old_action.sa_flags)); + return scm_cons (old_handler, SCM_I_MAKINUM (old_action.sa_flags)); #else if (query_only) { @@ -449,7 +449,7 @@ SCM_DEFINE (scm_sigaction_for_thread, "sigaction", 1, 3, 0, if (old_chandler == SIG_DFL || old_chandler == SIG_IGN) old_handler = scm_long2num ((long) old_chandler); SCM_ALLOW_INTS; - return scm_cons (old_handler, SCM_MAKINUM (0)); + return scm_cons (old_handler, SCM_I_MAKINUM (0)); #endif } #undef FUNC_NAME @@ -500,7 +500,7 @@ SCM_DEFINE (scm_alarm, "alarm", 1, 0, 0, unsigned int j; SCM_VALIDATE_INUM (1, i); j = alarm (SCM_INUM (i)); - return SCM_MAKINUM (j); + return SCM_I_MAKINUM (j); } #undef FUNC_NAME @@ -705,9 +705,9 @@ scm_init_scmsigs () #if defined(HAVE_SETITIMER) || defined(HAVE_GETITIMER) /* Stuff needed by setitimer and getitimer. */ - scm_c_define ("ITIMER_REAL", SCM_MAKINUM (ITIMER_REAL)); - scm_c_define ("ITIMER_VIRTUAL", SCM_MAKINUM (ITIMER_VIRTUAL)); - scm_c_define ("ITIMER_PROF", SCM_MAKINUM (ITIMER_PROF)); + scm_c_define ("ITIMER_REAL", SCM_I_MAKINUM (ITIMER_REAL)); + scm_c_define ("ITIMER_VIRTUAL", SCM_I_MAKINUM (ITIMER_VIRTUAL)); + scm_c_define ("ITIMER_PROF", SCM_I_MAKINUM (ITIMER_PROF)); #endif /* defined(HAVE_SETITIMER) || defined(HAVE_GETITIMER) */ #include "libguile/scmsigs.x" diff --git a/libguile/simpos.c b/libguile/simpos.c index ee17fbd3e..f6459c445 100644 --- a/libguile/simpos.c +++ b/libguile/simpos.c @@ -75,7 +75,7 @@ SCM_DEFINE (scm_system, "system", 0, 1, 0, rv = system (SCM_STRING_CHARS (cmd)); if (rv == -1 || (rv == 127 && errno != 0)) SCM_SYSERROR; - return SCM_MAKINUM (rv); + return SCM_I_MAKINUM (rv); } #undef FUNC_NAME #endif /* HAVE_SYSTEM */ @@ -183,7 +183,7 @@ SCM_DEFINE (scm_system_star, "system*", 0, 0, 1, scm_sigaction (sigint, SCM_CAR (oldint), SCM_CDR (oldint)); scm_sigaction (sigquit, SCM_CAR (oldquit), SCM_CDR (oldquit)); scm_remember_upto_here_2 (oldint, oldquit); - return SCM_MAKINUM (0L + status); + return SCM_I_MAKINUM (0L + status); } } else diff --git a/libguile/socket.c b/libguile/socket.c index 4e4aedab1..811aef925 100644 --- a/libguile/socket.c +++ b/libguile/socket.c @@ -85,7 +85,7 @@ SCM_DEFINE (scm_htons, "htons", 1, 0, 0, if (c_in != SCM_INUM (value)) SCM_OUT_OF_RANGE (1, value); - return SCM_MAKINUM (htons (c_in)); + return SCM_I_MAKINUM (htons (c_in)); } #undef FUNC_NAME @@ -102,7 +102,7 @@ SCM_DEFINE (scm_ntohs, "ntohs", 1, 0, 0, if (c_in != SCM_INUM (value)) SCM_OUT_OF_RANGE (1, value); - return SCM_MAKINUM (ntohs (c_in)); + return SCM_I_MAKINUM (ntohs (c_in)); } #undef FUNC_NAME @@ -590,7 +590,7 @@ SCM_DEFINE (scm_getsockopt, "getsockopt", 3, 0, 0, scm_long2num (ling->l_linger)); #else return scm_cons (scm_long2num (*(int *) optval), - SCM_MAKINUM (0)); + SCM_I_MAKINUM (0)); #endif } else @@ -847,7 +847,7 @@ scm_fill_sockaddr (int fam, SCM address, SCM *args, int which_arg, } #endif default: - scm_out_of_range (proc, SCM_MAKINUM (fam)); + scm_out_of_range (proc, SCM_I_MAKINUM (fam)); } } #undef FUNC_NAME @@ -1038,7 +1038,7 @@ scm_addr_vector (const struct sockaddr *address, int addr_size, #endif default: scm_misc_error (proc, "Unrecognised address family: ~A", - scm_list_1 (SCM_MAKINUM (fam))); + scm_list_1 (SCM_I_MAKINUM (fam))); } return result; } @@ -1175,7 +1175,7 @@ SCM_DEFINE (scm_recv, "recv!", 2, 1, 0, if (rv == -1) SCM_SYSERROR; - return SCM_MAKINUM (rv); + return SCM_I_MAKINUM (rv); } #undef FUNC_NAME @@ -1208,7 +1208,7 @@ SCM_DEFINE (scm_send, "send", 2, 1, 0, SCM_SYSCALL (rv = send (fd, SCM_STRING_CHARS (message), SCM_STRING_LENGTH (message), flg)); if (rv == -1) SCM_SYSERROR; - return SCM_MAKINUM (rv); + return SCM_I_MAKINUM (rv); } #undef FUNC_NAME @@ -1268,7 +1268,7 @@ SCM_DEFINE (scm_recvfrom, "recvfrom!", 2, 3, 0, else address = SCM_BOOL_F; - return scm_cons (SCM_MAKINUM (rv), address); + return scm_cons (SCM_I_MAKINUM (rv), address); } #undef FUNC_NAME @@ -1324,7 +1324,7 @@ SCM_DEFINE (scm_sendto, "sendto", 4, 0, 1, SCM_SYSERROR; } free (soka); - return SCM_MAKINUM (rv); + return SCM_I_MAKINUM (rv); } #undef FUNC_NAME @@ -1335,29 +1335,29 @@ scm_init_socket () { /* protocol families. */ #ifdef AF_UNSPEC - scm_c_define ("AF_UNSPEC", SCM_MAKINUM (AF_UNSPEC)); + scm_c_define ("AF_UNSPEC", SCM_I_MAKINUM (AF_UNSPEC)); #endif #ifdef AF_UNIX - scm_c_define ("AF_UNIX", SCM_MAKINUM (AF_UNIX)); + scm_c_define ("AF_UNIX", SCM_I_MAKINUM (AF_UNIX)); #endif #ifdef AF_INET - scm_c_define ("AF_INET", SCM_MAKINUM (AF_INET)); + scm_c_define ("AF_INET", SCM_I_MAKINUM (AF_INET)); #endif #ifdef AF_INET6 - scm_c_define ("AF_INET6", SCM_MAKINUM (AF_INET6)); + scm_c_define ("AF_INET6", SCM_I_MAKINUM (AF_INET6)); #endif #ifdef PF_UNSPEC - scm_c_define ("PF_UNSPEC", SCM_MAKINUM (PF_UNSPEC)); + scm_c_define ("PF_UNSPEC", SCM_I_MAKINUM (PF_UNSPEC)); #endif #ifdef PF_UNIX - scm_c_define ("PF_UNIX", SCM_MAKINUM (PF_UNIX)); + scm_c_define ("PF_UNIX", SCM_I_MAKINUM (PF_UNIX)); #endif #ifdef PF_INET - scm_c_define ("PF_INET", SCM_MAKINUM (PF_INET)); + scm_c_define ("PF_INET", SCM_I_MAKINUM (PF_INET)); #endif #ifdef PF_INET6 - scm_c_define ("PF_INET6", SCM_MAKINUM (PF_INET6)); + scm_c_define ("PF_INET6", SCM_I_MAKINUM (PF_INET6)); #endif /* standard addresses. */ @@ -1376,82 +1376,82 @@ scm_init_socket () /* socket types. */ #ifdef SOCK_STREAM - scm_c_define ("SOCK_STREAM", SCM_MAKINUM (SOCK_STREAM)); + scm_c_define ("SOCK_STREAM", SCM_I_MAKINUM (SOCK_STREAM)); #endif #ifdef SOCK_DGRAM - scm_c_define ("SOCK_DGRAM", SCM_MAKINUM (SOCK_DGRAM)); + scm_c_define ("SOCK_DGRAM", SCM_I_MAKINUM (SOCK_DGRAM)); #endif #ifdef SOCK_RAW - scm_c_define ("SOCK_RAW", SCM_MAKINUM (SOCK_RAW)); + scm_c_define ("SOCK_RAW", SCM_I_MAKINUM (SOCK_RAW)); #endif /* setsockopt level. */ #ifdef SOL_SOCKET - scm_c_define ("SOL_SOCKET", SCM_MAKINUM (SOL_SOCKET)); + scm_c_define ("SOL_SOCKET", SCM_I_MAKINUM (SOL_SOCKET)); #endif #ifdef SOL_IP - scm_c_define ("SOL_IP", SCM_MAKINUM (SOL_IP)); + scm_c_define ("SOL_IP", SCM_I_MAKINUM (SOL_IP)); #endif #ifdef SOL_TCP - scm_c_define ("SOL_TCP", SCM_MAKINUM (SOL_TCP)); + scm_c_define ("SOL_TCP", SCM_I_MAKINUM (SOL_TCP)); #endif #ifdef SOL_UDP - scm_c_define ("SOL_UDP", SCM_MAKINUM (SOL_UDP)); + scm_c_define ("SOL_UDP", SCM_I_MAKINUM (SOL_UDP)); #endif /* setsockopt names. */ #ifdef SO_DEBUG - scm_c_define ("SO_DEBUG", SCM_MAKINUM (SO_DEBUG)); + scm_c_define ("SO_DEBUG", SCM_I_MAKINUM (SO_DEBUG)); #endif #ifdef SO_REUSEADDR - scm_c_define ("SO_REUSEADDR", SCM_MAKINUM (SO_REUSEADDR)); + scm_c_define ("SO_REUSEADDR", SCM_I_MAKINUM (SO_REUSEADDR)); #endif #ifdef SO_STYLE - scm_c_define ("SO_STYLE", SCM_MAKINUM (SO_STYLE)); + scm_c_define ("SO_STYLE", SCM_I_MAKINUM (SO_STYLE)); #endif #ifdef SO_TYPE - scm_c_define ("SO_TYPE", SCM_MAKINUM (SO_TYPE)); + scm_c_define ("SO_TYPE", SCM_I_MAKINUM (SO_TYPE)); #endif #ifdef SO_ERROR - scm_c_define ("SO_ERROR", SCM_MAKINUM (SO_ERROR)); + scm_c_define ("SO_ERROR", SCM_I_MAKINUM (SO_ERROR)); #endif #ifdef SO_DONTROUTE - scm_c_define ("SO_DONTROUTE", SCM_MAKINUM (SO_DONTROUTE)); + scm_c_define ("SO_DONTROUTE", SCM_I_MAKINUM (SO_DONTROUTE)); #endif #ifdef SO_BROADCAST - scm_c_define ("SO_BROADCAST", SCM_MAKINUM (SO_BROADCAST)); + scm_c_define ("SO_BROADCAST", SCM_I_MAKINUM (SO_BROADCAST)); #endif #ifdef SO_SNDBUF - scm_c_define ("SO_SNDBUF", SCM_MAKINUM (SO_SNDBUF)); + scm_c_define ("SO_SNDBUF", SCM_I_MAKINUM (SO_SNDBUF)); #endif #ifdef SO_RCVBUF - scm_c_define ("SO_RCVBUF", SCM_MAKINUM (SO_RCVBUF)); + scm_c_define ("SO_RCVBUF", SCM_I_MAKINUM (SO_RCVBUF)); #endif #ifdef SO_KEEPALIVE - scm_c_define ("SO_KEEPALIVE", SCM_MAKINUM (SO_KEEPALIVE)); + scm_c_define ("SO_KEEPALIVE", SCM_I_MAKINUM (SO_KEEPALIVE)); #endif #ifdef SO_OOBINLINE - scm_c_define ("SO_OOBINLINE", SCM_MAKINUM (SO_OOBINLINE)); + scm_c_define ("SO_OOBINLINE", SCM_I_MAKINUM (SO_OOBINLINE)); #endif #ifdef SO_NO_CHECK - scm_c_define ("SO_NO_CHECK", SCM_MAKINUM (SO_NO_CHECK)); + scm_c_define ("SO_NO_CHECK", SCM_I_MAKINUM (SO_NO_CHECK)); #endif #ifdef SO_PRIORITY - scm_c_define ("SO_PRIORITY", SCM_MAKINUM (SO_PRIORITY)); + scm_c_define ("SO_PRIORITY", SCM_I_MAKINUM (SO_PRIORITY)); #endif #ifdef SO_LINGER - scm_c_define ("SO_LINGER", SCM_MAKINUM (SO_LINGER)); + scm_c_define ("SO_LINGER", SCM_I_MAKINUM (SO_LINGER)); #endif /* recv/send options. */ #ifdef MSG_OOB - scm_c_define ("MSG_OOB", SCM_MAKINUM (MSG_OOB)); + scm_c_define ("MSG_OOB", SCM_I_MAKINUM (MSG_OOB)); #endif #ifdef MSG_PEEK - scm_c_define ("MSG_PEEK", SCM_MAKINUM (MSG_PEEK)); + scm_c_define ("MSG_PEEK", SCM_I_MAKINUM (MSG_PEEK)); #endif #ifdef MSG_DONTROUTE - scm_c_define ("MSG_DONTROUTE", SCM_MAKINUM (MSG_DONTROUTE)); + scm_c_define ("MSG_DONTROUTE", SCM_I_MAKINUM (MSG_DONTROUTE)); #endif #ifdef __MINGW32__ diff --git a/libguile/sort.c b/libguile/sort.c index cf4c885ad..58d02f9e8 100644 --- a/libguile/sort.c +++ b/libguile/sort.c @@ -594,8 +594,8 @@ SCM_DEFINE (scm_sort_x, "sort!", 2, 0, 0, len = SCM_VECTOR_LENGTH (items); scm_restricted_vector_sort_x (items, less, - SCM_MAKINUM (0L), - SCM_MAKINUM (len)); + SCM_I_MAKINUM (0L), + SCM_I_MAKINUM (len)); return items; } else @@ -633,8 +633,8 @@ SCM_DEFINE (scm_sort, "sort", 2, 0, 0, scm_array_copy_x (items, sortvec); scm_restricted_vector_sort_x (sortvec, less, - SCM_MAKINUM (0L), - SCM_MAKINUM (len)); + SCM_I_MAKINUM (0L), + SCM_I_MAKINUM (len)); return sortvec; } #endif diff --git a/libguile/srcprop.c b/libguile/srcprop.c index 0c74f84bd..4e1c02834 100644 --- a/libguile/srcprop.c +++ b/libguile/srcprop.c @@ -141,8 +141,8 @@ scm_srcprops_to_plist (SCM obj) plist = scm_acons (scm_sym_copy, SRCPROPCOPY (obj), plist); if (!SCM_UNBNDP (SRCPROPFNAME (obj))) plist = scm_acons (scm_sym_filename, SRCPROPFNAME (obj), plist); - plist = scm_acons (scm_sym_column, SCM_MAKINUM (SRCPROPCOL (obj)), plist); - plist = scm_acons (scm_sym_line, SCM_MAKINUM (SRCPROPLINE (obj)), plist); + plist = scm_acons (scm_sym_column, SCM_I_MAKINUM (SRCPROPCOL (obj)), plist); + plist = scm_acons (scm_sym_line, SCM_I_MAKINUM (SRCPROPLINE (obj)), plist); plist = scm_acons (scm_sym_breakpoint, scm_from_bool (SRCPROPBRK (obj)), plist); return plist; } @@ -203,8 +203,8 @@ SCM_DEFINE (scm_source_property, "source-property", 2, 0, 0, if (!SRCPROPSP (p)) goto plist; if (SCM_EQ_P (scm_sym_breakpoint, key)) p = scm_from_bool (SRCPROPBRK (p)); - else if (SCM_EQ_P (scm_sym_line, key)) p = SCM_MAKINUM (SRCPROPLINE (p)); - else if (SCM_EQ_P (scm_sym_column, key)) p = SCM_MAKINUM (SRCPROPCOL (p)); + else if (SCM_EQ_P (scm_sym_line, key)) p = SCM_I_MAKINUM (SRCPROPLINE (p)); + else if (SCM_EQ_P (scm_sym_column, key)) p = SCM_I_MAKINUM (SRCPROPCOL (p)); else if (SCM_EQ_P (scm_sym_filename, key)) p = SRCPROPFNAME (p); else if (SCM_EQ_P (scm_sym_copy, key)) p = SRCPROPCOPY (p); else @@ -312,7 +312,7 @@ scm_init_srcprop () scm_set_smob_free (scm_tc16_srcprops, srcprops_free); scm_set_smob_print (scm_tc16_srcprops, srcprops_print); - scm_source_whash = scm_make_weak_key_hash_table (SCM_MAKINUM (2047)); + scm_source_whash = scm_make_weak_key_hash_table (SCM_I_MAKINUM (2047)); scm_c_define ("source-whash", scm_source_whash); #include "libguile/srcprop.x" diff --git a/libguile/stacks.c b/libguile/stacks.c index d6a8ad838..cf92a267f 100644 --- a/libguile/stacks.c +++ b/libguile/stacks.c @@ -457,7 +457,7 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1, size = n * SCM_FRAME_N_SLOTS; /* Make the stack object. */ - stack = scm_make_struct (scm_stack_type, SCM_MAKINUM (size), SCM_EOL); + stack = scm_make_struct (scm_stack_type, SCM_I_MAKINUM (size), SCM_EOL); SCM_STACK (stack) -> id = id; iframe = &SCM_STACK (stack) -> tail[0]; SCM_STACK (stack) -> frames = iframe; @@ -565,7 +565,7 @@ SCM_DEFINE (scm_stack_length, "stack-length", 1, 0, 0, #define FUNC_NAME s_scm_stack_length { SCM_VALIDATE_STACK (1, stack); - return SCM_MAKINUM (SCM_STACK_LENGTH (stack)); + return SCM_I_MAKINUM (SCM_STACK_LENGTH (stack)); } #undef FUNC_NAME @@ -614,7 +614,7 @@ SCM_DEFINE (scm_last_stack_frame, "last-stack-frame", 1, 0, 0, if (!dframe || SCM_VOIDFRAMEP (*dframe)) return SCM_BOOL_F; - stack = scm_make_struct (scm_stack_type, SCM_MAKINUM (SCM_FRAME_N_SLOTS), + stack = scm_make_struct (scm_stack_type, SCM_I_MAKINUM (SCM_FRAME_N_SLOTS), SCM_EOL); SCM_STACK (stack) -> length = 1; SCM_STACK (stack) -> frames = &SCM_STACK (stack) -> tail[0]; @@ -631,7 +631,7 @@ SCM_DEFINE (scm_frame_number, "frame-number", 1, 0, 0, #define FUNC_NAME s_scm_frame_number { SCM_VALIDATE_FRAME (1, frame); - return SCM_MAKINUM (SCM_FRAME_NUMBER (frame)); + return SCM_I_MAKINUM (SCM_FRAME_NUMBER (frame)); } #undef FUNC_NAME @@ -680,7 +680,7 @@ SCM_DEFINE (scm_frame_previous, "frame-previous", 1, 0, 0, if (n >= SCM_STACK_LENGTH (SCM_CAR (frame))) return SCM_BOOL_F; else - return scm_cons (SCM_CAR (frame), SCM_MAKINUM (n)); + return scm_cons (SCM_CAR (frame), SCM_I_MAKINUM (n)); } #undef FUNC_NAME @@ -696,7 +696,7 @@ SCM_DEFINE (scm_frame_next, "frame-next", 1, 0, 0, if (n == 0) return SCM_BOOL_F; else - return scm_cons (SCM_CAR (frame), SCM_MAKINUM (n - 1)); + return scm_cons (SCM_CAR (frame), SCM_I_MAKINUM (n - 1)); } #undef FUNC_NAME diff --git a/libguile/stime.c b/libguile/stime.c index 1b6d5331e..86fdab3ab 100644 --- a/libguile/stime.c +++ b/libguile/stime.c @@ -124,10 +124,10 @@ SCM_DEFINE (scm_get_internal_real_time, "get-internal-real-time", 0, 0, 0, time_buffer.time -= scm_your_base.time; tmp = scm_long2num (time_buffer.millitm - scm_your_base.millitm); tmp = scm_sum (tmp, - scm_product (SCM_MAKINUM (1000), - SCM_MAKINUM (time_buffer.time))); - return scm_quotient (scm_product (tmp, SCM_MAKINUM (SCM_TIME_UNITS_PER_SECOND)), - SCM_MAKINUM (1000)); + scm_product (SCM_I_MAKINUM (1000), + SCM_I_MAKINUM (time_buffer.time))); + return scm_quotient (scm_product (tmp, SCM_I_MAKINUM (SCM_TIME_UNITS_PER_SECOND)), + SCM_I_MAKINUM (1000)); #else return scm_long2num((time((timet*)0) - scm_your_base) * (int)SCM_TIME_UNITS_PER_SECOND); #endif /* HAVE_FTIME */ @@ -243,7 +243,7 @@ SCM_DEFINE (scm_gettimeofday, "gettimeofday", 0, 0, 0, ftime(&time); return scm_cons (scm_long2num ((long) time.time), - SCM_MAKINUM (time.millitm * 1000)); + SCM_I_MAKINUM (time.millitm * 1000)); # else timet timv; @@ -251,7 +251,7 @@ SCM_DEFINE (scm_gettimeofday, "gettimeofday", 0, 0, 0, if ((timv = time (0)) == -1) SCM_SYSERROR; SCM_ALLOW_INTS; - return scm_cons (scm_long2num (timv), SCM_MAKINUM (0)); + return scm_cons (scm_long2num (timv), SCM_I_MAKINUM (0)); # endif #endif } @@ -262,16 +262,16 @@ filltime (struct tm *bd_time, int zoff, const char *zname) { SCM result = scm_c_make_vector (11, SCM_UNDEFINED); - SCM_VECTOR_SET (result,0, SCM_MAKINUM (bd_time->tm_sec)); - SCM_VECTOR_SET (result,1, SCM_MAKINUM (bd_time->tm_min)); - SCM_VECTOR_SET (result,2, SCM_MAKINUM (bd_time->tm_hour)); - SCM_VECTOR_SET (result,3, SCM_MAKINUM (bd_time->tm_mday)); - SCM_VECTOR_SET (result,4, SCM_MAKINUM (bd_time->tm_mon)); - SCM_VECTOR_SET (result,5, SCM_MAKINUM (bd_time->tm_year)); - SCM_VECTOR_SET (result,6, SCM_MAKINUM (bd_time->tm_wday)); - SCM_VECTOR_SET (result,7, SCM_MAKINUM (bd_time->tm_yday)); - SCM_VECTOR_SET (result,8, SCM_MAKINUM (bd_time->tm_isdst)); - SCM_VECTOR_SET (result,9, SCM_MAKINUM (zoff)); + SCM_VECTOR_SET (result,0, SCM_I_MAKINUM (bd_time->tm_sec)); + SCM_VECTOR_SET (result,1, SCM_I_MAKINUM (bd_time->tm_min)); + SCM_VECTOR_SET (result,2, SCM_I_MAKINUM (bd_time->tm_hour)); + SCM_VECTOR_SET (result,3, SCM_I_MAKINUM (bd_time->tm_mday)); + SCM_VECTOR_SET (result,4, SCM_I_MAKINUM (bd_time->tm_mon)); + SCM_VECTOR_SET (result,5, SCM_I_MAKINUM (bd_time->tm_year)); + SCM_VECTOR_SET (result,6, SCM_I_MAKINUM (bd_time->tm_wday)); + SCM_VECTOR_SET (result,7, SCM_I_MAKINUM (bd_time->tm_yday)); + SCM_VECTOR_SET (result,8, SCM_I_MAKINUM (bd_time->tm_isdst)); + SCM_VECTOR_SET (result,9, SCM_I_MAKINUM (zoff)); SCM_VECTOR_SET (result,10, zname ? scm_makfrom0str (zname) : SCM_BOOL_F); return result; } @@ -717,7 +717,7 @@ SCM_DEFINE (scm_strptime, "strptime", 2, 0, 0, } SCM_ALLOW_INTS; - return scm_cons (filltime (&t, 0, NULL), SCM_MAKINUM (rest - str)); + return scm_cons (filltime (&t, 0, NULL), SCM_I_MAKINUM (rest - str)); } #undef FUNC_NAME #endif /* HAVE_STRPTIME */ diff --git a/libguile/strings.c b/libguile/strings.c index 8bde1bd09..20000980b 100644 --- a/libguile/strings.c +++ b/libguile/strings.c @@ -217,7 +217,7 @@ SCM_DEFINE (scm_string_length, "string-length", 1, 0, 0, #define FUNC_NAME s_scm_string_length { SCM_VALIDATE_STRING (1, string); - return SCM_MAKINUM (SCM_STRING_LENGTH (string)); + return SCM_I_MAKINUM (SCM_STRING_LENGTH (string)); } #undef FUNC_NAME diff --git a/libguile/strop.c b/libguile/strop.c index 8950a482d..ae83f2e24 100644 --- a/libguile/strop.c +++ b/libguile/strop.c @@ -61,7 +61,7 @@ scm_i_index (SCM *str, SCM chr, int direction, SCM sub_start, SCM_ASSERT (SCM_CHARP (chr), chr, SCM_ARG2, why); if (scm_is_false (sub_start)) - sub_start = SCM_MAKINUM (0); + sub_start = SCM_I_MAKINUM (0); SCM_ASSERT (SCM_INUMP (sub_start), sub_start, SCM_ARG3, why); lower = SCM_INUM (sub_start); @@ -69,7 +69,7 @@ scm_i_index (SCM *str, SCM chr, int direction, SCM sub_start, scm_out_of_range (why, sub_start); if (scm_is_false (sub_end)) - sub_end = SCM_MAKINUM (SCM_STRING_LENGTH (*str)); + sub_end = SCM_I_MAKINUM (SCM_STRING_LENGTH (*str)); SCM_ASSERT (SCM_INUMP (sub_end), sub_end, SCM_ARG4, why); upper = SCM_INUM (sub_end); @@ -124,7 +124,7 @@ SCM_DEFINE (scm_string_index, "string-index", 2, 2, 0, pos = scm_i_index (&str, chr, 1, frm, to, FUNC_NAME); return (pos < 0 ? SCM_BOOL_F - : SCM_MAKINUM (pos)); + : SCM_I_MAKINUM (pos)); } #undef FUNC_NAME @@ -154,7 +154,7 @@ SCM_DEFINE (scm_string_rindex, "string-rindex", 2, 2, 0, pos = scm_i_index (&str, chr, -1, frm, to, FUNC_NAME); return (pos < 0 ? SCM_BOOL_F - : SCM_MAKINUM (pos)); + : SCM_I_MAKINUM (pos)); } #undef FUNC_NAME diff --git a/libguile/struct.c b/libguile/struct.c index 5a4fe9cbe..c3f5e63c4 100644 --- a/libguile/struct.c +++ b/libguile/struct.c @@ -114,7 +114,7 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0, { if (field_desc[x + 2] != '-') SCM_MISC_ERROR ("missing dash field at position ~A", - scm_list_1 (SCM_MAKINUM (x / 2))); + scm_list_1 (SCM_I_MAKINUM (x / 2))); x += 2; goto recheck_ref; } @@ -793,14 +793,14 @@ void scm_init_struct () { scm_struct_table - = scm_permanent_object (scm_make_weak_key_hash_table (SCM_MAKINUM (31))); + = scm_permanent_object (scm_make_weak_key_hash_table (SCM_I_MAKINUM (31))); required_vtable_fields = scm_makfrom0str ("prsrpw"); scm_permanent_object (required_vtable_fields); - scm_c_define ("vtable-index-layout", SCM_MAKINUM (scm_vtable_index_layout)); - scm_c_define ("vtable-index-vtable", SCM_MAKINUM (scm_vtable_index_vtable)); + scm_c_define ("vtable-index-layout", SCM_I_MAKINUM (scm_vtable_index_layout)); + scm_c_define ("vtable-index-vtable", SCM_I_MAKINUM (scm_vtable_index_vtable)); scm_c_define ("vtable-index-printer", - SCM_MAKINUM (scm_vtable_index_printer)); - scm_c_define ("vtable-offset-user", SCM_MAKINUM (scm_vtable_offset_user)); + SCM_I_MAKINUM (scm_vtable_index_printer)); + scm_c_define ("vtable-offset-user", SCM_I_MAKINUM (scm_vtable_offset_user)); #include "libguile/struct.x" } diff --git a/libguile/symbols.c b/libguile/symbols.c index d76888fe0..5fe06b269 100644 --- a/libguile/symbols.c +++ b/libguile/symbols.c @@ -406,7 +406,7 @@ scm_c_symbol2str (SCM obj, char *str, size_t *lenp) void scm_symbols_prehistory () { - symbols = scm_make_weak_key_hash_table (SCM_MAKINUM (2139)); + symbols = scm_make_weak_key_hash_table (SCM_I_MAKINUM (2139)); scm_permanent_object (symbols); } diff --git a/libguile/tags.h b/libguile/tags.h index dd9012659..82669e3cb 100644 --- a/libguile/tags.h +++ b/libguile/tags.h @@ -384,7 +384,7 @@ typedef unsigned long scm_t_bits; /* Checking if a SCM variable holds an immediate integer: See numbers.h for * the definition of the following macros: SCM_I_FIXNUM_BIT, - * SCM_MOST_POSITIVE_FIXNUM, SCM_INUMP, SCM_MAKINUM, SCM_INUM. */ + * SCM_MOST_POSITIVE_FIXNUM, SCM_INUMP, SCM_I_MAKINUM, SCM_INUM. */ /* Checking if a SCM variable holds a pair (for historical reasons, in Guile * also known as a cons-cell): This is done by first checking that the SCM diff --git a/libguile/unif.c b/libguile/unif.c index 5268062da..a3bc710f8 100644 --- a/libguile/unif.c +++ b/libguile/unif.c @@ -218,11 +218,11 @@ SCM_DEFINE (scm_uniform_vector_length, "uniform-vector-length", 1, 0, 0, badarg1:SCM_WRONG_TYPE_ARG (1, v); case scm_tc7_vector: case scm_tc7_wvect: - return SCM_MAKINUM (SCM_VECTOR_LENGTH (v)); + return SCM_I_MAKINUM (SCM_VECTOR_LENGTH (v)); case scm_tc7_string: - return SCM_MAKINUM (SCM_STRING_LENGTH (v)); + return SCM_I_MAKINUM (SCM_STRING_LENGTH (v)); case scm_tc7_bvect: - return SCM_MAKINUM (SCM_BITVECTOR_LENGTH (v)); + return SCM_I_MAKINUM (SCM_BITVECTOR_LENGTH (v)); case scm_tc7_byvect: case scm_tc7_uvect: case scm_tc7_ivect: @@ -233,7 +233,7 @@ SCM_DEFINE (scm_uniform_vector_length, "uniform-vector-length", 1, 0, 0, #if SCM_SIZEOF_LONG_LONG != 0 case scm_tc7_llvect: #endif - return SCM_MAKINUM (SCM_UVECTOR_LENGTH (v)); + return SCM_I_MAKINUM (SCM_UVECTOR_LENGTH (v)); } } #undef FUNC_NAME @@ -347,10 +347,10 @@ SCM_DEFINE (scm_array_rank, "array-rank", 1, 0, 0, case scm_tc7_llvect: #endif case scm_tc7_svect: - return SCM_MAKINUM (1L); + return SCM_I_MAKINUM (1L); case scm_tc7_smob: if (SCM_ARRAYP (ra)) - return SCM_MAKINUM (SCM_ARRAY_NDIM (ra)); + return SCM_I_MAKINUM (SCM_ARRAY_NDIM (ra)); return SCM_INUM0; } } @@ -397,10 +397,10 @@ SCM_DEFINE (scm_array_dimensions, "array-dimensions", 1, 0, 0, s = SCM_ARRAY_DIMS (ra); while (k--) res = scm_cons (s[k].lbnd - ? scm_cons2 (SCM_MAKINUM (s[k].lbnd), - SCM_MAKINUM (s[k].ubnd), + ? scm_cons2 (SCM_I_MAKINUM (s[k].lbnd), + SCM_I_MAKINUM (s[k].ubnd), SCM_EOL) - : SCM_MAKINUM (1 + s[k].ubnd), + : SCM_I_MAKINUM (1 + s[k].ubnd), res); return res; } @@ -425,7 +425,7 @@ SCM_DEFINE (scm_shared_array_offset, "shared-array-offset", 1, 0, 0, #define FUNC_NAME s_scm_shared_array_offset { SCM_ASSERT (SCM_ARRAYP (ra), ra, SCM_ARG1, FUNC_NAME); - return SCM_MAKINUM (SCM_ARRAY_BASE (ra)); + return SCM_I_MAKINUM (SCM_ARRAY_BASE (ra)); } #undef FUNC_NAME @@ -442,7 +442,7 @@ SCM_DEFINE (scm_shared_array_increments, "shared-array-increments", 1, 0, 0, k = SCM_ARRAY_NDIM (ra); s = SCM_ARRAY_DIMS (ra); while (k--) - res = scm_cons (SCM_MAKINUM (s[k].inc), res); + res = scm_cons (SCM_I_MAKINUM (s[k].inc), res); return res; } #undef FUNC_NAME @@ -565,7 +565,7 @@ SCM_DEFINE (scm_dimensions_to_uniform_array, "dimensions->uniform-array", 2, 1, if (!SCM_UNBNDP (fill)) scm_array_fill_x (answer, fill); else if (SCM_SYMBOLP (prot)) - scm_array_fill_x (answer, SCM_MAKINUM (0)); + scm_array_fill_x (answer, SCM_I_MAKINUM (0)); else scm_array_fill_x (answer, prot); return answer; @@ -590,7 +590,7 @@ SCM_DEFINE (scm_dimensions_to_uniform_array, "dimensions->uniform-array", 2, 1, if (!SCM_UNBNDP (fill)) scm_array_fill_x (ra, fill); else if (SCM_SYMBOLP (prot)) - scm_array_fill_x (ra, SCM_MAKINUM (0)); + scm_array_fill_x (ra, SCM_I_MAKINUM (0)); else scm_array_fill_x (ra, prot); @@ -678,7 +678,7 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1, s = SCM_ARRAY_DIMS (ra); for (k = 0; k < SCM_ARRAY_NDIM (ra); k++) { - inds = scm_cons (SCM_MAKINUM (s[k].lbnd), inds); + inds = scm_cons (SCM_I_MAKINUM (s[k].lbnd), inds); if (s[k].ubnd < s[k].lbnd) { if (1 == SCM_ARRAY_NDIM (ra)) @@ -709,7 +709,7 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1, { if (s[k].ubnd > s[k].lbnd) { - SCM_SETCAR (indptr, SCM_MAKINUM (SCM_INUM (SCM_CAR (indptr)) + 1)); + SCM_SETCAR (indptr, SCM_I_MAKINUM (SCM_INUM (SCM_CAR (indptr)) + 1)); imap = scm_apply_0 (mapfunc, scm_reverse (inds)); if (SCM_ARRAYP (oldra)) @@ -891,7 +891,7 @@ SCM_DEFINE (scm_enclose_array, "enclose-array", 1, 0, 1, SCM_VALIDATE_REST_ARGUMENT (axes); if (SCM_NULLP (axes)) - axes = scm_cons ((SCM_ARRAYP (ra) ? SCM_MAKINUM (SCM_ARRAY_NDIM (ra) - 1) : SCM_INUM0), SCM_EOL); + axes = scm_cons ((SCM_ARRAYP (ra) ? SCM_I_MAKINUM (SCM_ARRAY_NDIM (ra) - 1) : SCM_INUM0), SCM_EOL); ninr = scm_ilength (axes); if (ninr < 0) SCM_WRONG_NUM_ARGS (); @@ -933,7 +933,7 @@ SCM_DEFINE (scm_enclose_array, "enclose-array", 1, 0, 1, noutr = ndim - ninr; if (noutr < 0) SCM_WRONG_NUM_ARGS (); - axv = scm_make_string (SCM_MAKINUM (ndim), SCM_MAKE_CHAR (0)); + axv = scm_make_string (SCM_I_MAKINUM (ndim), SCM_MAKE_CHAR (0)); res = scm_make_ra (noutr); SCM_ARRAY_BASE (res) = SCM_ARRAY_BASE (ra_inr); SCM_ARRAY_V (res) = ra_inr; @@ -1094,7 +1094,7 @@ SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0, /* not reached */ outrng: - scm_out_of_range (FUNC_NAME, SCM_MAKINUM (pos)); + scm_out_of_range (FUNC_NAME, SCM_I_MAKINUM (pos)); wna: SCM_WRONG_NUM_ARGS (); case scm_tc7_smob: @@ -1119,14 +1119,14 @@ SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0, case scm_tc7_string: return SCM_MAKE_CHAR (SCM_STRING_UCHARS (v)[pos]); case scm_tc7_byvect: - return SCM_MAKINUM (((char *) SCM_UVECTOR_BASE (v))[pos]); + return SCM_I_MAKINUM (((char *) SCM_UVECTOR_BASE (v))[pos]); case scm_tc7_uvect: return scm_ulong2num (((unsigned long *) SCM_VELTS (v))[pos]); case scm_tc7_ivect: return scm_long2num (((signed long *) SCM_VELTS (v))[pos]); case scm_tc7_svect: - return SCM_MAKINUM (((short *) SCM_CELL_WORD_1 (v))[pos]); + return SCM_I_MAKINUM (((short *) SCM_CELL_WORD_1 (v))[pos]); #if SCM_SIZEOF_LONG_LONG != 0 case scm_tc7_llvect: return scm_long_long2num (((long long *) SCM_CELL_WORD_1 (v))[pos]); @@ -1165,13 +1165,13 @@ scm_cvref (SCM v, unsigned long pos, SCM last) case scm_tc7_string: return SCM_MAKE_CHAR (SCM_STRING_UCHARS (v)[pos]); case scm_tc7_byvect: - return SCM_MAKINUM (((char *) SCM_UVECTOR_BASE (v))[pos]); + return SCM_I_MAKINUM (((char *) SCM_UVECTOR_BASE (v))[pos]); case scm_tc7_uvect: return scm_ulong2num(((unsigned long *) SCM_VELTS (v))[pos]); case scm_tc7_ivect: return scm_long2num(((signed long *) SCM_VELTS (v))[pos]); case scm_tc7_svect: - return SCM_MAKINUM (((short *) SCM_CELL_WORD_1 (v))[pos]); + return SCM_I_MAKINUM (((short *) SCM_CELL_WORD_1 (v))[pos]); #if SCM_SIZEOF_LONG_LONG != 0 case scm_tc7_llvect: return scm_long_long2num (((long long *) SCM_CELL_WORD_1 (v))[pos]); @@ -1263,7 +1263,7 @@ SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1, SCM_WRONG_TYPE_ARG (1, v); /* not reached */ outrng: - scm_out_of_range (FUNC_NAME, SCM_MAKINUM (pos)); + scm_out_of_range (FUNC_NAME, SCM_I_MAKINUM (pos)); wna: SCM_WRONG_NUM_ARGS (); case scm_tc7_smob: /* enclosed */ @@ -1282,7 +1282,7 @@ SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1, break; case scm_tc7_byvect: if (SCM_CHARP (obj)) - obj = SCM_MAKINUM ((char) SCM_CHAR (obj)); + obj = SCM_I_MAKINUM ((char) SCM_CHAR (obj)); SCM_ASRTGO (SCM_INUMP (obj), badobj); ((char *) SCM_UVECTOR_BASE (v))[pos] = SCM_INUM (obj); break; @@ -1609,7 +1609,7 @@ loop: if (!SCM_EQ_P (v, ra) && !SCM_EQ_P (cra, ra)) scm_array_copy_x (cra, ra); - return SCM_MAKINUM (ans); + return SCM_I_MAKINUM (ans); } #undef FUNC_NAME @@ -1740,7 +1740,7 @@ loop: if (SCM_TYP7 (v) == scm_tc7_bvect) ans *= SCM_LONG_BIT; - return SCM_MAKINUM (ans); + return SCM_I_MAKINUM (ans); } #undef FUNC_NAME @@ -1772,7 +1772,7 @@ SCM_DEFINE (scm_bit_count, "bit-count", 2, 0, 0, w >>= 4; } if (i == 0) { - return SCM_MAKINUM (count); + return SCM_I_MAKINUM (count); } else { --i; w = SCM_UNPACK (SCM_VELTS (bitvector)[i]); @@ -1828,17 +1828,17 @@ SCM_DEFINE (scm_bit_position, "bit-position", 3, 0, 0, switch (w & 0x0f) { default: - return SCM_MAKINUM (pos); + return SCM_I_MAKINUM (pos); case 2: case 6: case 10: case 14: - return SCM_MAKINUM (pos + 1); + return SCM_I_MAKINUM (pos + 1); case 4: case 12: - return SCM_MAKINUM (pos + 2); + return SCM_I_MAKINUM (pos + 2); case 8: - return SCM_MAKINUM (pos + 3); + return SCM_I_MAKINUM (pos + 3); case 0: pos += 4; w >>= 4; @@ -1899,7 +1899,7 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0, { k = SCM_UNPACK (SCM_VELTS (kv)[--i]); if (k >= vlen) - scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k)); + scm_out_of_range (FUNC_NAME, SCM_I_MAKINUM (k)); SCM_BITVEC_CLR(v, k); } else if (SCM_EQ_P (obj, SCM_BOOL_T)) @@ -1907,7 +1907,7 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0, { k = SCM_UNPACK (SCM_VELTS (kv)[--i]); if (k >= vlen) - scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k)); + scm_out_of_range (FUNC_NAME, SCM_I_MAKINUM (k)); SCM_BITVEC_SET(v, k); } else @@ -1969,7 +1969,7 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0, { k = SCM_UNPACK (SCM_VELTS (kv)[--i]); if (k >= vlen) - scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k)); + scm_out_of_range (FUNC_NAME, SCM_I_MAKINUM (k)); if (!SCM_BITVEC_REF(v, k)) count++; } @@ -1978,7 +1978,7 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0, { k = SCM_UNPACK (SCM_VELTS (kv)[--i]); if (k >= vlen) - scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k)); + scm_out_of_range (FUNC_NAME, SCM_I_MAKINUM (k)); if (SCM_BITVEC_REF (v, k)) count++; } @@ -1999,13 +1999,13 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0, for (; k; k >>= 4) count += cnt_tab[k & 0x0f]; if (0 == i--) - return SCM_MAKINUM (count); + return SCM_I_MAKINUM (count); /* urg. repetitive (see above.) */ k = SCM_UNPACK (SCM_VELTS (kv)[i]) & (fObj ? SCM_UNPACK(SCM_VELTS (v)[i]) : ~SCM_UNPACK (SCM_VELTS (v)[i])); } } - return SCM_MAKINUM (count); + return SCM_I_MAKINUM (count); } #undef FUNC_NAME @@ -2082,7 +2082,7 @@ ra2l (SCM ra, unsigned long base, unsigned long k) do { i -= inc; - res = scm_cons (scm_uniform_vector_ref (SCM_ARRAY_V (ra), SCM_MAKINUM (i)), res); + res = scm_cons (scm_uniform_vector_ref (SCM_ARRAY_V (ra), SCM_I_MAKINUM (i)), res); } while (i != base); return res; @@ -2126,7 +2126,7 @@ SCM_DEFINE (scm_array_to_list, "array->list", 1, 0, 0, signed char *data = (signed char *) SCM_VELTS (v); unsigned long k = SCM_UVECTOR_LENGTH (v); while (k != 0) - res = scm_cons (SCM_MAKINUM (data[--k]), res); + res = scm_cons (SCM_I_MAKINUM (data[--k]), res); return res; } case scm_tc7_uvect: @@ -2206,7 +2206,7 @@ SCM_DEFINE (scm_list_to_uniform_array, "list->uniform-array", 3, 0, 0, { n = scm_ilength (row); SCM_ASSERT (n >= 0, lst, SCM_ARG3, FUNC_NAME); - shp = scm_cons (SCM_MAKINUM (n), shp); + shp = scm_cons (SCM_I_MAKINUM (n), shp); if (SCM_NIMP (row)) row = SCM_CAR (row); } @@ -2222,7 +2222,7 @@ SCM_DEFINE (scm_list_to_uniform_array, "list->uniform-array", 3, 0, 0, { unsigned long int length = SCM_INUM (scm_uniform_vector_length (ra)); for (k = 0; k < length; k++, lst = SCM_CDR (lst)) - scm_array_set_x (ra, SCM_CAR (lst), SCM_MAKINUM (k)); + scm_array_set_x (ra, SCM_CAR (lst), SCM_I_MAKINUM (k)); return ra; } if (l2ra (lst, ra, SCM_ARRAY_BASE (ra), 0)) @@ -2260,7 +2260,7 @@ l2ra (SCM lst, SCM ra, unsigned long base, unsigned long k) { if (!SCM_CONSP (lst)) return 0; - scm_array_set_x (SCM_ARRAY_V (ra), SCM_CAR (lst), SCM_MAKINUM (base)); + scm_array_set_x (SCM_ARRAY_V (ra), SCM_CAR (lst), SCM_I_MAKINUM (base)); base += inc; lst = SCM_CDR (lst); } @@ -2327,7 +2327,7 @@ tail: default: /* scm_tc7_bvect and scm_tc7_llvect only? */ if (n-- > 0) - scm_iprin1 (scm_uniform_vector_ref (ra, SCM_MAKINUM (j)), port, pstate); + scm_iprin1 (scm_uniform_vector_ref (ra, SCM_I_MAKINUM (j)), port, pstate); for (j += inc; n-- > 0; j += inc) { scm_putc (' ', port); @@ -2570,9 +2570,9 @@ loop: case scm_tc7_byvect: return SCM_MAKE_CHAR ('\0'); case scm_tc7_uvect: - return SCM_MAKINUM (1L); + return SCM_I_MAKINUM (1L); case scm_tc7_ivect: - return SCM_MAKINUM (-1L); + return SCM_I_MAKINUM (-1L); case scm_tc7_svect: return scm_str2symbol ("s"); #if SCM_SIZEOF_LONG_LONG != 0 @@ -2615,8 +2615,8 @@ scm_init_unif () scm_set_smob_free (scm_tc16_array, array_free); scm_set_smob_print (scm_tc16_array, scm_raprin1); scm_set_smob_equalp (scm_tc16_array, scm_array_equal_p); - exactly_one_third = scm_permanent_object (scm_make_ratio (SCM_MAKINUM (1), - SCM_MAKINUM (3))); + exactly_one_third = scm_permanent_object (scm_make_ratio (SCM_I_MAKINUM (1), + SCM_I_MAKINUM (3))); scm_add_feature ("array"); #include "libguile/unif.x" } diff --git a/libguile/validate.h b/libguile/validate.h index 99a63deda..31c5d1e53 100644 --- a/libguile/validate.h +++ b/libguile/validate.h @@ -99,10 +99,10 @@ (scm_num2double (arg, pos, FUNC_NAME)) #define SCM_OUT_OF_RANGE(pos, arg) \ - do { scm_out_of_range_pos (FUNC_NAME, arg, SCM_MAKINUM (pos)); } while (0) + do { scm_out_of_range_pos (FUNC_NAME, arg, scm_from_int (pos)); } while (0) #define SCM_ASSERT_RANGE(pos, arg, f) \ - do { if (!(f)) scm_out_of_range_pos (FUNC_NAME, arg, SCM_MAKINUM (pos)); } while (0) + do { if (!(f)) scm_out_of_range_pos (FUNC_NAME, arg, scm_from_int (pos)); } while (0) #define SCM_MUST_MALLOC_TYPE(type) \ ((type *) scm_must_malloc (sizeof (type), FUNC_NAME)) @@ -250,7 +250,7 @@ #define SCM_VALIDATE_INUM_MIN_DEF_COPY(pos, k, min, default, cvar) \ do { \ if (SCM_UNBNDP (k)) \ - k = SCM_MAKINUM (default); \ + k = SCM_I_MAKINUM (default); \ SCM_ASSERT (SCM_INUMP (k), k, pos, FUNC_NAME); \ SCM_ASSERT_RANGE (pos, k, (SCM_INUM (k) >= min)); \ cvar = SCM_INUM (k); \ @@ -259,7 +259,7 @@ #define SCM_VALIDATE_INUM_DEF(pos, k, default) \ do { \ if (SCM_UNBNDP (k)) \ - k = SCM_MAKINUM (default); \ + k = SCM_I_MAKINUM (default); \ else SCM_ASSERT (SCM_INUMP (k), k, pos, FUNC_NAME); \ } while (0) @@ -267,7 +267,7 @@ do { \ if (SCM_UNBNDP (k)) \ { \ - k = SCM_MAKINUM (default); \ + k = SCM_I_MAKINUM (default); \ cvar = default; \ } \ else \ diff --git a/libguile/vectors.c b/libguile/vectors.c index 894a8320e..e95ffdcd0 100644 --- a/libguile/vectors.c +++ b/libguile/vectors.c @@ -46,7 +46,7 @@ scm_vector_length (SCM v) { SCM_GASSERT1 (SCM_VECTORP(v), g_vector_length, v, SCM_ARG1, s_vector_length); - return SCM_MAKINUM (SCM_VECTOR_LENGTH (v)); + return SCM_I_MAKINUM (SCM_VECTOR_LENGTH (v)); } SCM_REGISTER_PROC (s_list_to_vector, "list->vector", 1, 0, 0, scm_vector); diff --git a/libguile/version.c b/libguile/version.c index 0cfdc31de..9c25cf608 100644 --- a/libguile/version.c +++ b/libguile/version.c @@ -35,8 +35,8 @@ SCM_DEFINE (scm_major_version, "major-version", 0, 0, 0, "E.g., the 1 in \"1.6.5\".") #define FUNC_NAME s_scm_major_version { - return scm_number_to_string (SCM_MAKINUM(SCM_MAJOR_VERSION), - SCM_MAKINUM(10)); + return scm_number_to_string (SCM_I_MAKINUM(SCM_MAJOR_VERSION), + SCM_I_MAKINUM(10)); } #undef FUNC_NAME @@ -48,8 +48,8 @@ SCM_DEFINE (scm_minor_version, "minor-version", 0, 0, 0, "E.g., the 6 in \"1.6.5\".") #define FUNC_NAME s_scm_minor_version { - return scm_number_to_string (SCM_MAKINUM(SCM_MINOR_VERSION), - SCM_MAKINUM(10)); + return scm_number_to_string (SCM_I_MAKINUM(SCM_MINOR_VERSION), + SCM_I_MAKINUM(10)); } #undef FUNC_NAME @@ -61,8 +61,8 @@ SCM_DEFINE (scm_micro_version, "micro-version", 0, 0, 0, "E.g., the 5 in \"1.6.5\".") #define FUNC_NAME s_scm_micro_version { - return scm_number_to_string (SCM_MAKINUM(SCM_MICRO_VERSION), - SCM_MAKINUM(10)); + return scm_number_to_string (SCM_I_MAKINUM(SCM_MICRO_VERSION), + SCM_I_MAKINUM(10)); } #undef FUNC_NAME diff --git a/libguile/weaks.c b/libguile/weaks.c index 99ff92b55..33df4519e 100644 --- a/libguile/weaks.c +++ b/libguile/weaks.c @@ -150,7 +150,7 @@ SCM_DEFINE (scm_weak_vector, "weak-vector", 0, 0, 1, while the vector is being created. */ i = scm_ilength (l); SCM_ASSERT (i >= 0, l, SCM_ARG1, FUNC_NAME); - res = scm_make_weak_vector (SCM_MAKINUM (i), SCM_UNSPECIFIED); + res = scm_make_weak_vector (SCM_I_MAKINUM (i), SCM_UNSPECIFIED); /* no alloc, so this loop is safe. @@ -192,7 +192,7 @@ SCM_DEFINE (scm_make_weak_key_alist_vector, "make-weak-key-alist-vector", 0, 1, #define FUNC_NAME s_scm_make_weak_key_alist_vector { return scm_i_allocate_weak_vector - (1, SCM_UNBNDP (size) ? SCM_MAKINUM (31) : size, SCM_EOL, FUNC_NAME); + (1, SCM_UNBNDP (size) ? SCM_I_MAKINUM (31) : size, SCM_EOL, FUNC_NAME); } #undef FUNC_NAME @@ -204,7 +204,7 @@ SCM_DEFINE (scm_make_weak_value_alist_vector, "make-weak-value-alist-vector", 0, #define FUNC_NAME s_scm_make_weak_value_alist_vector { return scm_i_allocate_weak_vector - (2, SCM_UNBNDP (size) ? SCM_MAKINUM (31) : size, SCM_EOL, FUNC_NAME); + (2, SCM_UNBNDP (size) ? SCM_I_MAKINUM (31) : size, SCM_EOL, FUNC_NAME); } #undef FUNC_NAME @@ -216,7 +216,7 @@ SCM_DEFINE (scm_make_doubly_weak_alist_vector, "make-doubly-weak-alist-vector", #define FUNC_NAME s_scm_make_doubly_weak_alist_vector { return scm_i_allocate_weak_vector - (3, SCM_UNBNDP (size) ? SCM_MAKINUM (31) : size, SCM_EOL, FUNC_NAME); + (3, SCM_UNBNDP (size) ? SCM_I_MAKINUM (31) : size, SCM_EOL, FUNC_NAME); } #undef FUNC_NAME diff --git a/libguile/win32-socket.c b/libguile/win32-socket.c index 35a72da01..3d6cb6625 100644 --- a/libguile/win32-socket.c +++ b/libguile/win32-socket.c @@ -614,9 +614,9 @@ scm_socket_symbols_Win32 (socket_error_t * e) if (e->error) { if (e->correct_str) - scm_c_define (e->correct_str, SCM_MAKINUM (e->error)); + scm_c_define (e->correct_str, SCM_I_MAKINUM (e->error)); if (e->replace && e->replace_str) - scm_c_define (e->replace_str, SCM_MAKINUM (e->replace)); + scm_c_define (e->replace_str, SCM_I_MAKINUM (e->replace)); } e++; } diff --git a/srfi/srfi-1.c b/srfi/srfi-1.c index b7d0b5ecf..eef97d7ef 100644 --- a/srfi/srfi-1.c +++ b/srfi/srfi-1.c @@ -169,7 +169,7 @@ SCM_DEFINE (scm_srfi1_count, "count", 2, 0, 1, } } done: - return SCM_MAKINUM (count); + return scm_from_long (count); } #undef FUNC_NAME @@ -480,7 +480,7 @@ SCM_DEFINE (scm_srfi1_length_plus, "length+", 1, 0, 0, #define FUNC_NAME s_scm_srfi1_length_plus { long len = scm_ilength (lst); - return (len >= 0 ? SCM_MAKINUM (len) : SCM_BOOL_F); + return (len >= 0 ? SCM_I_MAKINUM (len) : SCM_BOOL_F); } #undef FUNC_NAME diff --git a/srfi/srfi-13.c b/srfi/srfi-13.c index eb26c3711..945d6d5ef 100644 --- a/srfi/srfi-13.c +++ b/srfi/srfi-13.c @@ -111,7 +111,7 @@ SCM_DEFINE (scm_string_tabulate, "string-tabulate", 2, 0, 0, i = 0; while (i < clen) { - ch = scm_call_1 (proc, SCM_MAKINUM (i)); + ch = scm_call_1 (proc, SCM_I_MAKINUM (i)); if (!SCM_CHARP (ch)) SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 (proc)); *p++ = SCM_CHAR (ch); @@ -368,7 +368,7 @@ SCM_DEFINE (scm_substring_shared, "substring/shared", 2, 1, 0, SCM_VALIDATE_STRING (1, str); SCM_VALIDATE_INUM (2, start); if (SCM_UNBNDP (end)) - end = SCM_MAKINUM (SCM_STRING_LENGTH (str)); + end = SCM_I_MAKINUM (SCM_STRING_LENGTH (str)); else SCM_VALIDATE_INUM (3, end); if (SCM_INUM (start) == 0 && @@ -860,18 +860,18 @@ SCM_DEFINE (scm_string_compare, "string-compare", 5, 4, 0, while (cstart1 < cend1 && cstart2 < cend2) { if (cstr1[cstart1] < cstr2[cstart2]) - return scm_call_1 (proc_lt, SCM_MAKINUM (cstart1)); + return scm_call_1 (proc_lt, SCM_I_MAKINUM (cstart1)); else if (cstr1[cstart1] > cstr2[cstart2]) - return scm_call_1 (proc_gt, SCM_MAKINUM (cstart1)); + return scm_call_1 (proc_gt, SCM_I_MAKINUM (cstart1)); cstart1++; cstart2++; } if (cstart1 < cend1) - return scm_call_1 (proc_gt, SCM_MAKINUM (cstart1)); + return scm_call_1 (proc_gt, SCM_I_MAKINUM (cstart1)); else if (cstart2 < cend2) - return scm_call_1 (proc_lt, SCM_MAKINUM (cstart1)); + return scm_call_1 (proc_lt, SCM_I_MAKINUM (cstart1)); else - return scm_call_1 (proc_eq, SCM_MAKINUM (cstart1)); + return scm_call_1 (proc_eq, SCM_I_MAKINUM (cstart1)); } #undef FUNC_NAME @@ -903,18 +903,18 @@ SCM_DEFINE (scm_string_compare_ci, "string-compare-ci", 5, 4, 0, while (cstart1 < cend1 && cstart2 < cend2) { if (scm_c_downcase (cstr1[cstart1]) < scm_c_downcase (cstr2[cstart2])) - return scm_call_1 (proc_lt, SCM_MAKINUM (cstart1)); + return scm_call_1 (proc_lt, SCM_I_MAKINUM (cstart1)); else if (scm_c_downcase (cstr1[cstart1]) > scm_c_downcase (cstr2[cstart2])) - return scm_call_1 (proc_gt, SCM_MAKINUM (cstart1)); + return scm_call_1 (proc_gt, SCM_I_MAKINUM (cstart1)); cstart1++; cstart2++; } if (cstart1 < cend1) - return scm_call_1 (proc_gt, SCM_MAKINUM (cstart1)); + return scm_call_1 (proc_gt, SCM_I_MAKINUM (cstart1)); else if (cstart2 < cend2) - return scm_call_1 (proc_lt, SCM_MAKINUM (cstart1)); + return scm_call_1 (proc_lt, SCM_I_MAKINUM (cstart1)); else - return scm_call_1 (proc_eq, SCM_MAKINUM (cstart1)); + return scm_call_1 (proc_eq, SCM_I_MAKINUM (cstart1)); } #undef FUNC_NAME @@ -949,7 +949,7 @@ SCM_DEFINE (scm_string_eq, "string=", 2, 4, 0, else if (cstart2 < cend2) return SCM_BOOL_F; else - return SCM_MAKINUM (cstart1); + return SCM_I_MAKINUM (cstart1); } #undef FUNC_NAME @@ -973,16 +973,16 @@ SCM_DEFINE (scm_string_neq, "string<>", 2, 4, 0, while (cstart1 < cend1 && cstart2 < cend2) { if (cstr1[cstart1] < cstr2[cstart2]) - return SCM_MAKINUM (cstart1); + return SCM_I_MAKINUM (cstart1); else if (cstr1[cstart1] > cstr2[cstart2]) - return SCM_MAKINUM (cstart1); + return SCM_I_MAKINUM (cstart1); cstart1++; cstart2++; } if (cstart1 < cend1) - return SCM_MAKINUM (cstart1); + return SCM_I_MAKINUM (cstart1); else if (cstart2 < cend2) - return SCM_MAKINUM (cstart1); + return SCM_I_MAKINUM (cstart1); else return SCM_BOOL_F; } @@ -1008,7 +1008,7 @@ SCM_DEFINE (scm_string_lt, "string<", 2, 4, 0, while (cstart1 < cend1 && cstart2 < cend2) { if (cstr1[cstart1] < cstr2[cstart2]) - return SCM_MAKINUM (cstart1); + return SCM_I_MAKINUM (cstart1); else if (cstr1[cstart1] > cstr2[cstart2]) return SCM_BOOL_F; cstart1++; @@ -1017,7 +1017,7 @@ SCM_DEFINE (scm_string_lt, "string<", 2, 4, 0, if (cstart1 < cend1) return SCM_BOOL_F; else if (cstart2 < cend2) - return SCM_MAKINUM (cstart1); + return SCM_I_MAKINUM (cstart1); else return SCM_BOOL_F; } @@ -1045,12 +1045,12 @@ SCM_DEFINE (scm_string_gt, "string>", 2, 4, 0, if (cstr1[cstart1] < cstr2[cstart2]) return SCM_BOOL_F; else if (cstr1[cstart1] > cstr2[cstart2]) - return SCM_MAKINUM (cstart1); + return SCM_I_MAKINUM (cstart1); cstart1++; cstart2++; } if (cstart1 < cend1) - return SCM_MAKINUM (cstart1); + return SCM_I_MAKINUM (cstart1); else if (cstart2 < cend2) return SCM_BOOL_F; else @@ -1078,7 +1078,7 @@ SCM_DEFINE (scm_string_le, "string<=", 2, 4, 0, while (cstart1 < cend1 && cstart2 < cend2) { if (cstr1[cstart1] < cstr2[cstart2]) - return SCM_MAKINUM (cstart1); + return SCM_I_MAKINUM (cstart1); else if (cstr1[cstart1] > cstr2[cstart2]) return SCM_BOOL_F; cstart1++; @@ -1087,9 +1087,9 @@ SCM_DEFINE (scm_string_le, "string<=", 2, 4, 0, if (cstart1 < cend1) return SCM_BOOL_F; else if (cstart2 < cend2) - return SCM_MAKINUM (cstart1); + return SCM_I_MAKINUM (cstart1); else - return SCM_MAKINUM (cstart1); + return SCM_I_MAKINUM (cstart1); } #undef FUNC_NAME @@ -1115,16 +1115,16 @@ SCM_DEFINE (scm_string_ge, "string>=", 2, 4, 0, if (cstr1[cstart1] < cstr2[cstart2]) return SCM_BOOL_F; else if (cstr1[cstart1] > cstr2[cstart2]) - return SCM_MAKINUM (cstart1); + return SCM_I_MAKINUM (cstart1); cstart1++; cstart2++; } if (cstart1 < cend1) - return SCM_MAKINUM (cstart1); + return SCM_I_MAKINUM (cstart1); else if (cstart2 < cend2) return SCM_BOOL_F; else - return SCM_MAKINUM (cstart1); + return SCM_I_MAKINUM (cstart1); } #undef FUNC_NAME @@ -1160,7 +1160,7 @@ SCM_DEFINE (scm_string_ci_eq, "string-ci=", 2, 4, 0, else if (cstart2 < cend2) return SCM_BOOL_F; else - return SCM_MAKINUM (cstart1); + return SCM_I_MAKINUM (cstart1); } #undef FUNC_NAME @@ -1185,16 +1185,16 @@ SCM_DEFINE (scm_string_ci_neq, "string-ci<>", 2, 4, 0, while (cstart1 < cend1 && cstart2 < cend2) { if (scm_c_downcase (cstr1[cstart1]) < scm_c_downcase (cstr2[cstart2])) - return SCM_MAKINUM (cstart1); + return SCM_I_MAKINUM (cstart1); else if (scm_c_downcase (cstr1[cstart1]) > scm_c_downcase (cstr2[cstart2])) - return SCM_MAKINUM (cstart1); + return SCM_I_MAKINUM (cstart1); cstart1++; cstart2++; } if (cstart1 < cend1) - return SCM_MAKINUM (cstart1); + return SCM_I_MAKINUM (cstart1); else if (cstart2 < cend2) - return SCM_MAKINUM (cstart1); + return SCM_I_MAKINUM (cstart1); else return SCM_BOOL_F; } @@ -1221,7 +1221,7 @@ SCM_DEFINE (scm_string_ci_lt, "string-ci<", 2, 4, 0, while (cstart1 < cend1 && cstart2 < cend2) { if (scm_c_downcase (cstr1[cstart1]) < scm_c_downcase (cstr2[cstart2])) - return SCM_MAKINUM (cstart1); + return SCM_I_MAKINUM (cstart1); else if (scm_c_downcase (cstr1[cstart1]) > scm_c_downcase (cstr2[cstart2])) return SCM_BOOL_F; cstart1++; @@ -1230,7 +1230,7 @@ SCM_DEFINE (scm_string_ci_lt, "string-ci<", 2, 4, 0, if (cstart1 < cend1) return SCM_BOOL_F; else if (cstart2 < cend2) - return SCM_MAKINUM (cstart1); + return SCM_I_MAKINUM (cstart1); else return SCM_BOOL_F; } @@ -1259,12 +1259,12 @@ SCM_DEFINE (scm_string_ci_gt, "string-ci>", 2, 4, 0, if (scm_c_downcase (cstr1[cstart1]) < scm_c_downcase (cstr2[cstart2])) return SCM_BOOL_F; else if (scm_c_downcase (cstr1[cstart1]) > scm_c_downcase (cstr2[cstart2])) - return SCM_MAKINUM (cstart1); + return SCM_I_MAKINUM (cstart1); cstart1++; cstart2++; } if (cstart1 < cend1) - return SCM_MAKINUM (cstart1); + return SCM_I_MAKINUM (cstart1); else if (cstart2 < cend2) return SCM_BOOL_F; else @@ -1293,7 +1293,7 @@ SCM_DEFINE (scm_string_ci_le, "string-ci<=", 2, 4, 0, while (cstart1 < cend1 && cstart2 < cend2) { if (scm_c_downcase (cstr1[cstart1]) < scm_c_downcase (cstr2[cstart2])) - return SCM_MAKINUM (cstart1); + return SCM_I_MAKINUM (cstart1); else if (scm_c_downcase (cstr1[cstart1]) > scm_c_downcase (cstr2[cstart2])) return SCM_BOOL_F; cstart1++; @@ -1302,9 +1302,9 @@ SCM_DEFINE (scm_string_ci_le, "string-ci<=", 2, 4, 0, if (cstart1 < cend1) return SCM_BOOL_F; else if (cstart2 < cend2) - return SCM_MAKINUM (cstart1); + return SCM_I_MAKINUM (cstart1); else - return SCM_MAKINUM (cstart1); + return SCM_I_MAKINUM (cstart1); } #undef FUNC_NAME @@ -1331,16 +1331,16 @@ SCM_DEFINE (scm_string_ci_ge, "string-ci>=", 2, 4, 0, if (scm_c_downcase (cstr1[cstart1]) < scm_c_downcase (cstr2[cstart2])) return SCM_BOOL_F; else if (scm_c_downcase (cstr1[cstart1]) > scm_c_downcase (cstr2[cstart2])) - return SCM_MAKINUM (cstart1); + return SCM_I_MAKINUM (cstart1); cstart1++; cstart2++; } if (cstart1 < cend1) - return SCM_MAKINUM (cstart1); + return SCM_I_MAKINUM (cstart1); else if (cstart2 < cend2) return SCM_BOOL_F; else - return SCM_MAKINUM (cstart1); + return SCM_I_MAKINUM (cstart1); } #undef FUNC_NAME @@ -1364,12 +1364,12 @@ SCM_DEFINE (scm_string_prefix_length, "string-prefix-length", 2, 4, 0, while (cstart1 < cend1 && cstart2 < cend2) { if (cstr1[cstart1] != cstr2[cstart2]) - return SCM_MAKINUM (len); + return SCM_I_MAKINUM (len); len++; cstart1++; cstart2++; } - return SCM_MAKINUM (len); + return SCM_I_MAKINUM (len); } #undef FUNC_NAME @@ -1393,12 +1393,12 @@ SCM_DEFINE (scm_string_prefix_length_ci, "string-prefix-length-ci", 2, 4, 0, while (cstart1 < cend1 && cstart2 < cend2) { if (scm_c_downcase (cstr1[cstart1]) != scm_c_downcase (cstr2[cstart2])) - return SCM_MAKINUM (len); + return SCM_I_MAKINUM (len); len++; cstart1++; cstart2++; } - return SCM_MAKINUM (len); + return SCM_I_MAKINUM (len); } #undef FUNC_NAME @@ -1424,10 +1424,10 @@ SCM_DEFINE (scm_string_suffix_length, "string-suffix-length", 2, 4, 0, cend1--; cend2--; if (cstr1[cend1] != cstr2[cend2]) - return SCM_MAKINUM (len); + return SCM_I_MAKINUM (len); len++; } - return SCM_MAKINUM (len); + return SCM_I_MAKINUM (len); } #undef FUNC_NAME @@ -1453,10 +1453,10 @@ SCM_DEFINE (scm_string_suffix_length_ci, "string-suffix-length-ci", 2, 4, 0, cend1--; cend2--; if (scm_c_downcase (cstr1[cend1]) != scm_c_downcase (cstr2[cend2])) - return SCM_MAKINUM (len); + return SCM_I_MAKINUM (len); len++; } - return SCM_MAKINUM (len); + return SCM_I_MAKINUM (len); } #undef FUNC_NAME @@ -1608,7 +1608,7 @@ SCM_DEFINE (scm_string_indexS, "string-index", 2, 2, 0, while (cstart < cend) { if (cchr == cstr[cstart]) - return SCM_MAKINUM (cstart); + return SCM_I_MAKINUM (cstart); cstart++; } } @@ -1617,7 +1617,7 @@ SCM_DEFINE (scm_string_indexS, "string-index", 2, 2, 0, while (cstart < cend) { if (SCM_CHARSET_GET (char_pred, cstr[cstart])) - return SCM_MAKINUM (cstart); + return SCM_I_MAKINUM (cstart); cstart++; } } @@ -1629,7 +1629,7 @@ SCM_DEFINE (scm_string_indexS, "string-index", 2, 2, 0, SCM res; res = scm_call_1 (char_pred, SCM_MAKE_CHAR (cstr[cstart])); if (scm_is_true (res)) - return SCM_MAKINUM (cstart); + return SCM_I_MAKINUM (cstart); cstart++; } } @@ -1668,7 +1668,7 @@ SCM_DEFINE (scm_string_index_right, "string-index-right", 2, 2, 0, { cend--; if (cchr == cstr[cend]) - return SCM_MAKINUM (cend); + return SCM_I_MAKINUM (cend); } } else if (SCM_CHARSETP (char_pred)) @@ -1677,7 +1677,7 @@ SCM_DEFINE (scm_string_index_right, "string-index-right", 2, 2, 0, { cend--; if (SCM_CHARSET_GET (char_pred, cstr[cend])) - return SCM_MAKINUM (cend); + return SCM_I_MAKINUM (cend); } } else @@ -1689,7 +1689,7 @@ SCM_DEFINE (scm_string_index_right, "string-index-right", 2, 2, 0, cend--; res = scm_call_1 (char_pred, SCM_MAKE_CHAR (cstr[cend])); if (scm_is_true (res)) - return SCM_MAKINUM (cend); + return SCM_I_MAKINUM (cend); } } return SCM_BOOL_F; @@ -1727,7 +1727,7 @@ SCM_DEFINE (scm_string_skip, "string-skip", 2, 2, 0, while (cstart < cend) { if (cchr != cstr[cstart]) - return SCM_MAKINUM (cstart); + return SCM_I_MAKINUM (cstart); cstart++; } } @@ -1736,7 +1736,7 @@ SCM_DEFINE (scm_string_skip, "string-skip", 2, 2, 0, while (cstart < cend) { if (!SCM_CHARSET_GET (char_pred, cstr[cstart])) - return SCM_MAKINUM (cstart); + return SCM_I_MAKINUM (cstart); cstart++; } } @@ -1748,7 +1748,7 @@ SCM_DEFINE (scm_string_skip, "string-skip", 2, 2, 0, SCM res; res = scm_call_1 (char_pred, SCM_MAKE_CHAR (cstr[cstart])); if (scm_is_false (res)) - return SCM_MAKINUM (cstart); + return SCM_I_MAKINUM (cstart); cstart++; } } @@ -1788,7 +1788,7 @@ SCM_DEFINE (scm_string_skip_right, "string-skip-right", 2, 2, 0, { cend--; if (cchr != cstr[cend]) - return SCM_MAKINUM (cend); + return SCM_I_MAKINUM (cend); } } else if (SCM_CHARSETP (char_pred)) @@ -1797,7 +1797,7 @@ SCM_DEFINE (scm_string_skip_right, "string-skip-right", 2, 2, 0, { cend--; if (!SCM_CHARSET_GET (char_pred, cstr[cend])) - return SCM_MAKINUM (cend); + return SCM_I_MAKINUM (cend); } } else @@ -1809,7 +1809,7 @@ SCM_DEFINE (scm_string_skip_right, "string-skip-right", 2, 2, 0, cend--; res = scm_call_1 (char_pred, SCM_MAKE_CHAR (cstr[cend])); if (scm_is_false (res)) - return SCM_MAKINUM (cend); + return SCM_I_MAKINUM (cend); } } return SCM_BOOL_F; @@ -1872,7 +1872,7 @@ SCM_DEFINE (scm_string_count, "string-count", 2, 2, 0, cstart++; } } - return SCM_MAKINUM (count); + return SCM_I_MAKINUM (count); } #undef FUNC_NAME @@ -1909,7 +1909,7 @@ SCM_DEFINE (scm_string_contains, "string-contains", 2, 4, 0, j++; } if (j == cend2) - return SCM_MAKINUM (cstart1); + return SCM_I_MAKINUM (cstart1); cstart1++; } return SCM_BOOL_F; @@ -1951,7 +1951,7 @@ SCM_DEFINE (scm_string_contains_ci, "string-contains-ci", 2, 4, 0, j++; } if (j == cend2) - return SCM_MAKINUM (cstart1); + return SCM_I_MAKINUM (cstart1); cstart1++; } return SCM_BOOL_F; @@ -2652,7 +2652,7 @@ SCM_DEFINE (scm_string_for_each_index, "string-for-each-index", 2, 2, 0, 4, end, cend); while (cstart < cend) { - scm_call_1 (proc, SCM_MAKINUM (cstart)); + scm_call_1 (proc, SCM_I_MAKINUM (cstart)); cstart++; } return SCM_UNSPECIFIED; diff --git a/srfi/srfi-14.c b/srfi/srfi-14.c index 0ab29672a..551514aba 100644 --- a/srfi/srfi-14.c +++ b/srfi/srfi-14.c @@ -186,7 +186,7 @@ SCM_DEFINE (scm_char_set_hash, "char-set-hash", 1, 1, 0, if (p[k] != 0) val = p[k] + (val << 1); } - return SCM_MAKINUM (val % bnd); + return SCM_I_MAKINUM (val % bnd); } #undef FUNC_NAME @@ -204,7 +204,7 @@ SCM_DEFINE (scm_char_set_cursor, "char-set-cursor", 1, 0, 0, if (SCM_CHARSET_GET (cs, idx)) break; } - return SCM_MAKINUM (idx); + return SCM_I_MAKINUM (idx); } #undef FUNC_NAME @@ -247,7 +247,7 @@ SCM_DEFINE (scm_char_set_cursor_next, "char-set-cursor-next", 2, 0, 0, if (SCM_CHARSET_GET (cs, ccursor)) break; } - return SCM_MAKINUM (ccursor); + return SCM_I_MAKINUM (ccursor); } #undef FUNC_NAME @@ -752,7 +752,7 @@ SCM_DEFINE (scm_char_set_size, "char-set-size", 1, 0, 0, for (k = 0; k < SCM_CHARSET_SIZE; k++) if (SCM_CHARSET_GET (cs, k)) count++; - return SCM_MAKINUM (count); + return SCM_I_MAKINUM (count); } #undef FUNC_NAME @@ -775,7 +775,7 @@ SCM_DEFINE (scm_char_set_count, "char-set-count", 2, 0, 0, if (scm_is_true (res)) count++; } - return SCM_MAKINUM (count); + return SCM_I_MAKINUM (count); } #undef FUNC_NAME diff --git a/srfi/srfi-4.c b/srfi/srfi-4.c index d6507551d..45efe728f 100644 --- a/srfi/srfi-4.c +++ b/srfi/srfi-4.c @@ -308,7 +308,7 @@ SCM_DEFINE (scm_make_u8vector, "make-u8vector", 1, 1, 0, unsigned int s = scm_num2uint (fill, 2, FUNC_NAME); f = s; if ((unsigned int) f != s) - scm_out_of_range_pos (FUNC_NAME, fill, SCM_MAKINUM (2)); + scm_out_of_range_pos (FUNC_NAME, fill, SCM_I_MAKINUM (2)); } p = (int_u8 *) SCM_UVEC_BASE (uvec); while (count-- > 0) @@ -358,7 +358,7 @@ SCM_DEFINE (scm_u8vector_ref, "u8vector-ref", 2, 0, 0, idx = scm_num2int (index, 2, FUNC_NAME); if (idx < 0 || idx >= SCM_UVEC_LENGTH (uvec)) - scm_out_of_range_pos (FUNC_NAME, index, SCM_MAKINUM (2)); + scm_out_of_range_pos (FUNC_NAME, index, SCM_I_MAKINUM (2)); return scm_short2num (((int_u8 *) SCM_UVEC_BASE (uvec))[idx]); } @@ -382,12 +382,12 @@ SCM_DEFINE (scm_u8vector_set_x, "u8vector-set!", 3, 0, 0, idx = scm_num2int (index, 2, FUNC_NAME); if (idx < 0 || idx >= SCM_UVEC_LENGTH (uvec)) - scm_out_of_range_pos (FUNC_NAME, index, SCM_MAKINUM (2)); + scm_out_of_range_pos (FUNC_NAME, index, SCM_I_MAKINUM (2)); s = scm_num2uint (value, 3, FUNC_NAME); f = s; if ((unsigned int) f != s) - scm_out_of_range_pos (FUNC_NAME, value, SCM_MAKINUM (3)); + scm_out_of_range_pos (FUNC_NAME, value, SCM_I_MAKINUM (3)); ((int_u8 *) SCM_UVEC_BASE (uvec))[idx] = f; return SCM_UNSPECIFIED; @@ -413,7 +413,7 @@ SCM_DEFINE (scm_u8vector_to_list, "u8vector->list", 1, 0, 0, while (idx-- > 0) { p--; - res = scm_cons (SCM_MAKINUM (*p), res); + res = scm_cons (SCM_I_MAKINUM (*p), res); } return res; } @@ -494,7 +494,7 @@ SCM_DEFINE (scm_make_s8vector, "make-s8vector", 1, 1, 0, signed int s = scm_num2int (fill, 2, FUNC_NAME); f = s; if ((signed int) f != s) - scm_out_of_range_pos (FUNC_NAME, fill, SCM_MAKINUM (2)); + scm_out_of_range_pos (FUNC_NAME, fill, SCM_I_MAKINUM (2)); } p = (int_s8 *) SCM_UVEC_BASE (uvec); while (count-- > 0) @@ -544,7 +544,7 @@ SCM_DEFINE (scm_s8vector_ref, "s8vector-ref", 2, 0, 0, idx = scm_num2int (index, 2, FUNC_NAME); if (idx < 0 || idx >= SCM_UVEC_LENGTH (uvec)) - scm_out_of_range_pos (FUNC_NAME, index, SCM_MAKINUM (2)); + scm_out_of_range_pos (FUNC_NAME, index, SCM_I_MAKINUM (2)); return scm_short2num (((int_s8 *) SCM_UVEC_BASE (uvec))[idx]); } @@ -568,12 +568,12 @@ SCM_DEFINE (scm_s8vector_set_x, "s8vector-set!", 3, 0, 0, idx = scm_num2int (index, 2, FUNC_NAME); if (idx < 0 || idx >= SCM_UVEC_LENGTH (uvec)) - scm_out_of_range_pos (FUNC_NAME, index, SCM_MAKINUM (2)); + scm_out_of_range_pos (FUNC_NAME, index, SCM_I_MAKINUM (2)); s = scm_num2int (value, 3, FUNC_NAME); f = s; if ((signed int) f != s) - scm_out_of_range_pos (FUNC_NAME, value, SCM_MAKINUM (3)); + scm_out_of_range_pos (FUNC_NAME, value, SCM_I_MAKINUM (3)); ((int_s8 *) SCM_UVEC_BASE (uvec))[idx] = f; return SCM_UNSPECIFIED; @@ -599,7 +599,7 @@ SCM_DEFINE (scm_s8vector_to_list, "s8vector->list", 1, 0, 0, while (idx-- > 0) { p--; - res = scm_cons (SCM_MAKINUM (*p), res); + res = scm_cons (SCM_I_MAKINUM (*p), res); } return res; } @@ -727,7 +727,7 @@ SCM_DEFINE (scm_u16vector_ref, "u16vector-ref", 2, 0, 0, idx = scm_num2int (index, 2, FUNC_NAME); if (idx < 0 || idx >= SCM_UVEC_LENGTH (uvec)) - scm_out_of_range_pos (FUNC_NAME, index, SCM_MAKINUM (2)); + scm_out_of_range_pos (FUNC_NAME, index, SCM_I_MAKINUM (2)); return scm_ushort2num (((int_u16 *) SCM_UVEC_BASE (uvec))[idx]); } @@ -750,7 +750,7 @@ SCM_DEFINE (scm_u16vector_set_x, "u16vector-set!", 3, 0, 0, idx = scm_num2int (index, 2, FUNC_NAME); if (idx < 0 || idx >= SCM_UVEC_LENGTH (uvec)) - scm_out_of_range_pos (FUNC_NAME, index, SCM_MAKINUM (2)); + scm_out_of_range_pos (FUNC_NAME, index, SCM_I_MAKINUM (2)); f = scm_num2ushort (value, 3, FUNC_NAME); @@ -778,7 +778,7 @@ SCM_DEFINE (scm_u16vector_to_list, "u16vector->list", 1, 0, 0, while (idx-- > 0) { p--; - res = scm_cons (SCM_MAKINUM (*p), res); + res = scm_cons (SCM_I_MAKINUM (*p), res); } return res; } @@ -897,7 +897,7 @@ SCM_DEFINE (scm_s16vector_ref, "s16vector-ref", 2, 0, 0, idx = scm_num2int (index, 2, FUNC_NAME); if (idx < 0 || idx >= SCM_UVEC_LENGTH (uvec)) - scm_out_of_range_pos (FUNC_NAME, index, SCM_MAKINUM (2)); + scm_out_of_range_pos (FUNC_NAME, index, SCM_I_MAKINUM (2)); return scm_short2num (((int_s16 *) SCM_UVEC_BASE (uvec))[idx]); } @@ -920,7 +920,7 @@ SCM_DEFINE (scm_s16vector_set_x, "s16vector-set!", 3, 0, 0, idx = scm_num2int (index, 2, FUNC_NAME); if (idx < 0 || idx >= SCM_UVEC_LENGTH (uvec)) - scm_out_of_range_pos (FUNC_NAME, index, SCM_MAKINUM (2)); + scm_out_of_range_pos (FUNC_NAME, index, SCM_I_MAKINUM (2)); f = scm_num2short (value, 3, FUNC_NAME); @@ -948,7 +948,7 @@ SCM_DEFINE (scm_s16vector_to_list, "s16vector->list", 1, 0, 0, while (idx-- > 0) { p--; - res = scm_cons (SCM_MAKINUM (*p), res); + res = scm_cons (SCM_I_MAKINUM (*p), res); } return res; } @@ -1070,7 +1070,7 @@ SCM_DEFINE (scm_u32vector_ref, "u32vector-ref", 2, 0, 0, idx = scm_num2int (index, 2, FUNC_NAME); if (idx < 0 || idx >= SCM_UVEC_LENGTH (uvec)) - scm_out_of_range_pos (FUNC_NAME, index, SCM_MAKINUM (2)); + scm_out_of_range_pos (FUNC_NAME, index, SCM_I_MAKINUM (2)); return scm_uint2num (((int_u32 *) SCM_UVEC_BASE (uvec))[idx]); } @@ -1093,7 +1093,7 @@ SCM_DEFINE (scm_u32vector_set_x, "u32vector-set!", 3, 0, 0, idx = scm_num2int (index, 2, FUNC_NAME); if (idx < 0 || idx >= SCM_UVEC_LENGTH (uvec)) - scm_out_of_range_pos (FUNC_NAME, index, SCM_MAKINUM (2)); + scm_out_of_range_pos (FUNC_NAME, index, SCM_I_MAKINUM (2)); f = scm_num2uint (value, 3, FUNC_NAME); @@ -1241,7 +1241,7 @@ SCM_DEFINE (scm_s32vector_ref, "s32vector-ref", 2, 0, 0, idx = scm_num2int (index, 2, FUNC_NAME); if (idx < 0 || idx >= SCM_UVEC_LENGTH (uvec)) - scm_out_of_range_pos (FUNC_NAME, index, SCM_MAKINUM (2)); + scm_out_of_range_pos (FUNC_NAME, index, SCM_I_MAKINUM (2)); return scm_int2num (((int_s32 *) SCM_UVEC_BASE (uvec))[idx]); } @@ -1264,7 +1264,7 @@ SCM_DEFINE (scm_s32vector_set_x, "s32vector-set!", 3, 0, 0, idx = scm_num2int (index, 2, FUNC_NAME); if (idx < 0 || idx >= SCM_UVEC_LENGTH (uvec)) - scm_out_of_range_pos (FUNC_NAME, index, SCM_MAKINUM (2)); + scm_out_of_range_pos (FUNC_NAME, index, SCM_I_MAKINUM (2)); f = scm_num2int (value, 3, FUNC_NAME); @@ -1414,7 +1414,7 @@ SCM_DEFINE (scm_u64vector_ref, "u64vector-ref", 2, 0, 0, idx = scm_num2int (index, 2, FUNC_NAME); if (idx < 0 || idx >= SCM_UVEC_LENGTH (uvec)) - scm_out_of_range_pos (FUNC_NAME, index, SCM_MAKINUM (2)); + scm_out_of_range_pos (FUNC_NAME, index, SCM_I_MAKINUM (2)); return scm_ulong_long2num (((int_u64 *) SCM_UVEC_BASE (uvec))[idx]); } @@ -1437,7 +1437,7 @@ SCM_DEFINE (scm_u64vector_set_x, "u64vector-set!", 3, 0, 0, idx = scm_num2int (index, 2, FUNC_NAME); if (idx < 0 || idx >= SCM_UVEC_LENGTH (uvec)) - scm_out_of_range_pos (FUNC_NAME, index, SCM_MAKINUM (2)); + scm_out_of_range_pos (FUNC_NAME, index, SCM_I_MAKINUM (2)); f = scm_num2ulong_long (value, 3, FUNC_NAME); @@ -1585,7 +1585,7 @@ SCM_DEFINE (scm_s64vector_ref, "s64vector-ref", 2, 0, 0, idx = scm_num2int (index, 2, FUNC_NAME); if (idx < 0 || idx >= SCM_UVEC_LENGTH (uvec)) - scm_out_of_range_pos (FUNC_NAME, index, SCM_MAKINUM (2)); + scm_out_of_range_pos (FUNC_NAME, index, SCM_I_MAKINUM (2)); return scm_long_long2num (((int_s64 *) SCM_UVEC_BASE (uvec))[idx]); } @@ -1608,7 +1608,7 @@ SCM_DEFINE (scm_s64vector_set_x, "s64vector-set!", 3, 0, 0, idx = scm_num2int (index, 2, FUNC_NAME); if (idx < 0 || idx >= SCM_UVEC_LENGTH (uvec)) - scm_out_of_range_pos (FUNC_NAME, index, SCM_MAKINUM (2)); + scm_out_of_range_pos (FUNC_NAME, index, SCM_I_MAKINUM (2)); f = scm_num2long_long (value, 3, FUNC_NAME); @@ -1716,7 +1716,7 @@ SCM_DEFINE (scm_make_f32vector, "make-f32vector", 1, 1, 0, /* This test somehow fails for even the simplest inexact numbers, like 3.1. Must find out how to check properly. */ if (f != d) - scm_out_of_range_pos (FUNC_NAME, fill, SCM_MAKINUM (2)); + scm_out_of_range_pos (FUNC_NAME, fill, SCM_I_MAKINUM (2)); #endif /* 0 */ } p = (float_f32 *) SCM_UVEC_BASE (uvec); @@ -1767,7 +1767,7 @@ SCM_DEFINE (scm_f32vector_ref, "f32vector-ref", 2, 0, 0, idx = scm_num2int (index, 2, FUNC_NAME); if (idx < 0 || idx >= SCM_UVEC_LENGTH (uvec)) - scm_out_of_range_pos (FUNC_NAME, index, SCM_MAKINUM (2)); + scm_out_of_range_pos (FUNC_NAME, index, SCM_I_MAKINUM (2)); return scm_make_real (((float_f32 *) SCM_UVEC_BASE (uvec))[idx]); } @@ -1791,7 +1791,7 @@ SCM_DEFINE (scm_f32vector_set_x, "f32vector-set!", 3, 0, 0, idx = scm_num2int (index, 2, FUNC_NAME); if (idx < 0 || idx >= SCM_UVEC_LENGTH (uvec)) - scm_out_of_range_pos (FUNC_NAME, index, SCM_MAKINUM (2)); + scm_out_of_range_pos (FUNC_NAME, index, SCM_I_MAKINUM (2)); d = scm_num2dbl (value, FUNC_NAME); f = d; @@ -1799,7 +1799,7 @@ SCM_DEFINE (scm_f32vector_set_x, "f32vector-set!", 3, 0, 0, /* This test somehow fails for even the simplest inexact numbers, like 3.1. Must find out how to check properly. */ if (f != d) - scm_out_of_range_pos (FUNC_NAME, value, SCM_MAKINUM (3)); + scm_out_of_range_pos (FUNC_NAME, value, SCM_I_MAKINUM (3)); #endif /* 0 */ ((float_f32 *) SCM_UVEC_BASE (uvec))[idx] = f; @@ -1858,7 +1858,7 @@ SCM_DEFINE (scm_list_to_f32vector, "list->f32vector", 1, 0, 0, /* This test somehow fails for even the simplest inexact numbers, like 3.1. Must find out how to check properly. */ if (d != f) - scm_out_of_range_pos (FUNC_NAME, l, SCM_MAKINUM (1)); + scm_out_of_range_pos (FUNC_NAME, l, SCM_I_MAKINUM (1)); #endif /* 0 */ *p++ = f; l = SCM_CDR (l); @@ -1954,7 +1954,7 @@ SCM_DEFINE (scm_f64vector_ref, "f64vector-ref", 2, 0, 0, idx = scm_num2int (index, 2, FUNC_NAME); if (idx < 0 || idx >= SCM_UVEC_LENGTH (uvec)) - scm_out_of_range_pos (FUNC_NAME, index, SCM_MAKINUM (2)); + scm_out_of_range_pos (FUNC_NAME, index, SCM_I_MAKINUM (2)); return scm_make_real (((float_f64 *) SCM_UVEC_BASE (uvec))[idx]); } @@ -1977,7 +1977,7 @@ SCM_DEFINE (scm_f64vector_set_x, "f64vector-set!", 3, 0, 0, idx = scm_num2int (index, 2, FUNC_NAME); if (idx < 0 || idx >= SCM_UVEC_LENGTH (uvec)) - scm_out_of_range_pos (FUNC_NAME, index, SCM_MAKINUM (2)); + scm_out_of_range_pos (FUNC_NAME, index, SCM_I_MAKINUM (2)); f = scm_num2dbl (value, FUNC_NAME); From 67b74a4c3e2a372c1a403cddc127538352d13b0e Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Thu, 8 Jul 2004 16:01:02 +0000 Subject: [PATCH 52/58] (LLONG_MIN, LLONG_MAX, ULLONG_MAX): Removed and used SCM_I_LLONG_MIN etc. instead. * numbers.h (SCM_MAKINUM, SCM_I_MAKINUM): Renamed SCM_MAKINUM to SCM_I_MAKINUM and changed all uses. --- test-suite/standalone/test-num2integral.c | 44 +++++++++-------------- 1 file changed, 17 insertions(+), 27 deletions(-) diff --git a/test-suite/standalone/test-num2integral.c b/test-suite/standalone/test-num2integral.c index 70cd033f7..dfac54f58 100644 --- a/test-suite/standalone/test-num2integral.c +++ b/test-suite/standalone/test-num2integral.c @@ -20,16 +20,6 @@ #include #include -/* if you need to change this, change numbers.c as well */ -#if SCM_SIZEOF_LONG_LONG != 0 -# ifndef LLONG_MAX -# define ULLONG_MAX ((unsigned long long) (-1)) -# define LLONG_MAX ((long long) (ULLONG_MAX >> 1)) -# define LLONG_MIN (~LLONG_MAX) -# endif -#endif - - SCM out_of_range_handler (void *data, SCM key, SCM args); SCM call_num2long_long_body (void *data); SCM call_num2ulong_long_body (void *data); @@ -61,31 +51,31 @@ test_long_long () { #if SCM_SIZEOF_LONG_LONG != 0 { - SCM n = scm_long_long2num (LLONG_MIN); + SCM n = scm_long_long2num (SCM_I_LLONG_MIN); long long result = scm_num2long_long(n, 0, "main"); - assert (result == LLONG_MIN); + assert (result == SCM_I_LLONG_MIN); } /* LLONG_MIN - 1 */ { - SCM n = scm_difference (scm_long_long2num (LLONG_MIN), SCM_MAKINUM(1)); + SCM n = scm_difference (scm_long_long2num (SCM_I_LLONG_MIN), scm_from_int (1)); SCM caught = scm_internal_catch (SCM_BOOL_T, call_num2long_long_body, &n, out_of_range_handler, NULL); assert (scm_is_true (caught)); } - /* LLONG_MIN + LLONG_MIN/2 */ + /* SCM_I_LLONG_MIN + SCM_I_LLONG_MIN/2 */ { - SCM n = scm_sum (scm_long_long2num (LLONG_MIN), - scm_long_long2num (LLONG_MIN / 2)); + SCM n = scm_sum (scm_long_long2num (SCM_I_LLONG_MIN), + scm_long_long2num (SCM_I_LLONG_MIN / 2)); SCM caught = scm_internal_catch (SCM_BOOL_T, call_num2long_long_body, &n, out_of_range_handler, NULL); assert (scm_is_true (caught)); } - /* LLONG_MAX + 1 */ + /* SCM_I_LLONG_MAX + 1 */ { - SCM n = scm_sum (scm_long_long2num (LLONG_MAX), SCM_MAKINUM(1)); + SCM n = scm_sum (scm_long_long2num (SCM_I_LLONG_MAX), scm_from_int (1)); SCM caught = scm_internal_catch (SCM_BOOL_T, call_num2long_long_body, &n, out_of_range_handler, NULL); assert (scm_is_true (caught)); @@ -93,7 +83,7 @@ test_long_long () /* 2^1024 */ { - SCM n = scm_ash (SCM_MAKINUM (1), SCM_MAKINUM (1024)); + SCM n = scm_ash (scm_from_int (1), scm_from_int (1024)); SCM caught = scm_internal_catch (SCM_BOOL_T, call_num2long_long_body, &n, out_of_range_handler, NULL); assert (scm_is_true (caught)); @@ -101,8 +91,8 @@ test_long_long () /* -2^1024 */ { - SCM n = scm_difference (SCM_MAKINUM (0), - scm_ash (SCM_MAKINUM (1), SCM_MAKINUM (1024))); + SCM n = scm_difference (scm_from_int (0), + scm_ash (scm_from_int (1), scm_from_int (1024))); SCM caught = scm_internal_catch (SCM_BOOL_T, call_num2long_long_body, &n, out_of_range_handler, NULL); assert (scm_is_true (caught)); @@ -117,22 +107,22 @@ test_ulong_long () #if SCM_SIZEOF_LONG_LONG != 0 { - SCM n = scm_ulong_long2num (ULLONG_MAX); + SCM n = scm_ulong_long2num (SCM_I_ULLONG_MAX); unsigned long long result = scm_num2ulong_long(n, 0, "main"); - assert (result == ULLONG_MAX); + assert (result == SCM_I_ULLONG_MAX); } /* -1 */ { - SCM n = SCM_MAKINUM (-1); + SCM n = scm_from_int (-1); SCM caught = scm_internal_catch (SCM_BOOL_T, call_num2ulong_long_body, &n, out_of_range_handler, NULL); assert (scm_is_true (caught)); } - /* ULLONG_MAX + 1 */ + /* SCM_I_ULLONG_MAX + 1 */ { - SCM n = scm_sum (scm_ulong_long2num (ULLONG_MAX), SCM_MAKINUM(1)); + SCM n = scm_sum (scm_ulong_long2num (SCM_I_ULLONG_MAX), scm_from_int (1)); SCM caught = scm_internal_catch (SCM_BOOL_T, call_num2ulong_long_body, &n, out_of_range_handler, NULL); assert (scm_is_true (caught)); @@ -140,7 +130,7 @@ test_ulong_long () /* 2^1024 */ { - SCM n = scm_ash (SCM_MAKINUM (1), SCM_MAKINUM (1024)); + SCM n = scm_ash (scm_from_int (1), scm_from_int (1024)); SCM caught = scm_internal_catch (SCM_BOOL_T, call_num2long_long_body, &n, out_of_range_handler, NULL); assert (scm_is_true (caught)); From 79e9bca7e9a7cae22b8b4162368a0776e10f5106 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Thu, 8 Jul 2004 16:03:01 +0000 Subject: [PATCH 53/58] Use scm_from_int instead of SCM_MAKINUM and scm_is_eq instead SCM_EQ_P. --- test-suite/standalone/test-unwind.c | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/test-suite/standalone/test-unwind.c b/test-suite/standalone/test-unwind.c index 0704859d7..ca04df344 100644 --- a/test-suite/standalone/test-unwind.c +++ b/test-suite/standalone/test-unwind.c @@ -213,20 +213,20 @@ check_fluid () SCM f = scm_make_fluid (); SCM x; - scm_fluid_set_x (f, SCM_MAKINUM (12)); + scm_fluid_set_x (f, scm_from_int (12)); scm_frame_begin (0); - scm_frame_fluid (f, SCM_MAKINUM (13)); + scm_frame_fluid (f, scm_from_int (13)); x = scm_fluid_ref (f); scm_frame_end (); - if (!SCM_EQ_P (x, SCM_MAKINUM (13))) + if (!scm_is_eq (x, scm_from_int (13))) { printf ("setting fluid didn't work\n"); exit (1); } - if (!SCM_EQ_P (scm_fluid_ref (f), SCM_MAKINUM (12))) + if (!scm_is_eq (scm_fluid_ref (f), scm_from_int (12))) { printf ("resetting fluid didn't work\n"); exit (1); From aacc831855fa1885e8d596526ad62bb608f99acf Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Thu, 8 Jul 2004 16:03:45 +0000 Subject: [PATCH 54/58] *** empty log message *** --- test-suite/ChangeLog | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog index 690b5d3e2..78fe924a6 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -1,3 +1,8 @@ +2004-07-08 Marius Vollmer + + * standalone/test-unwind.c: Use scm_from_int instead of + SCM_MAKINUM and scm_is_eq instead SCM_EQ_P. + 2004-07-07 Marius Vollmer * standalone/test-conversion.c: Don't define SCM_T_INTMAX_MIN, From af3d28494d23f912626364055bef814ac0068e58 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Thu, 8 Jul 2004 22:50:45 +0000 Subject: [PATCH 55/58] Bugfix: set SCM_I_GSC_T_UINTMAX, not SCM_I_GSC_T_INTMAX in two places. --- configure.in | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/configure.in b/configure.in index 29252ce58..4d9aefb7f 100644 --- a/configure.in +++ b/configure.in @@ -558,10 +558,10 @@ elif test "$ac_cv_sizeof_unsigned___int64" -ne 0; then SCM_I_GSC_T_UINTMAX_LIMITS='"unknown"' elif test "$ac_cv_sizeof_unsigned_long_long" -ne 0; then SCM_I_GSC_T_UINTMAX='"unsigned long long"' - SCM_I_GSC_T_INTMAX_LIMITS='"SCM_I_ULLONG"' + SCM_I_GSC_T_UINTMAX_LIMITS='"SCM_I_ULLONG"' else SCM_I_GSC_T_UINTMAX='"unsigned long"' - SCM_I_GSC_T_INTMAX_LIMITS='"ULONG"' + SCM_I_GSC_T_UINTMAX_LIMITS='"ULONG"' fi AC_SUBST([SCM_I_GSC_T_UINTMAX]) AC_SUBST([SCM_I_GSC_T_UINTMAX_LIMITS]) From b7341ea4543259bafa3ba415e9a69fb7d440d6a1 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Thu, 8 Jul 2004 22:53:33 +0000 Subject: [PATCH 56/58] *** empty log message *** --- ChangeLog | 5 +++++ THANKS | 1 + 2 files changed, 6 insertions(+) diff --git a/ChangeLog b/ChangeLog index 182f13558..ba89a8a3f 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2004-07-09 Marius Vollmer + + * configure.in: Bugfix: set SCM_I_GSC_T_UINTMAX, not + SCM_I_GSC_T_INTMAX in two places. Thanks to Andreas Vögele! + 2004-07-07 Marius Vollmer * configure.in: When checking for suitable types for scm_t_int8, diff --git a/THANKS b/THANKS index 54ce554c1..daa40c722 100644 --- a/THANKS +++ b/THANKS @@ -61,6 +61,7 @@ For fixes or providing information which led to a fix: Panagiotis Vossos Neil W. Van Dyke Aaron VanDevender + Andreas Vögele Michael Talbot-Wilson Andy Wingo Keith Wright From 803d27f9d02c5b9e59bb37b847b75b682655449a Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Fri, 9 Jul 2004 22:08:43 +0000 Subject: [PATCH 57/58] (scm_hashq, scm_hashv, scm_hash): Restrict to size>=1 rather than size>=0, since 0<=hash Date: Fri, 9 Jul 2004 22:14:19 +0000 Subject: [PATCH 58/58] New file. --- test-suite/tests/hash.test | 63 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 63 insertions(+) create mode 100644 test-suite/tests/hash.test diff --git a/test-suite/tests/hash.test b/test-suite/tests/hash.test new file mode 100644 index 000000000..f4db4bfe2 --- /dev/null +++ b/test-suite/tests/hash.test @@ -0,0 +1,63 @@ +;;;; hash.test --- test guile hashing -*- scheme -*- +;;;; +;;;; Copyright (C) 2004 Free Software Foundation, Inc. +;;;; +;;;; This library is free software; you can redistribute it and/or +;;;; modify it under the terms of the GNU Lesser General Public +;;;; License as published by the Free Software Foundation; either +;;;; version 2.1 of the License, or (at your option) any later version. +;;;; +;;;; This library is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;;; Lesser General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU Lesser General Public +;;;; License along with this library; if not, write to the Free Software +;;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +(define-module (test-suite test-numbers) + #:use-module (test-suite lib) + #:use-module (ice-9 documentation)) + +;;; +;;; hash +;;; + +(with-test-prefix "hash" + (pass-if (->bool (object-documentation hash))) + (pass-if-exception "hash #t -1" exception:out-of-range + (hash #t -1)) + (pass-if-exception "hash #t 0" exception:out-of-range + (hash #t 0)) + (pass-if (= 0 (hash #t 1))) + (pass-if (= 0 (hash #f 1))) + (pass-if (= 0 (hash noop 1)))) + +;;; +;;; hashv +;;; + +(with-test-prefix "hashv" + (pass-if (->bool (object-documentation hashv))) + (pass-if-exception "hashv #t -1" exception:out-of-range + (hashv #t -1)) + (pass-if-exception "hashv #t 0" exception:out-of-range + (hashv #t 0)) + (pass-if (= 0 (hashv #t 1))) + (pass-if (= 0 (hashv #f 1))) + (pass-if (= 0 (hashv noop 1)))) + +;;; +;;; hashq +;;; + +(with-test-prefix "hashq" + (pass-if (->bool (object-documentation hashq))) + (pass-if-exception "hashq #t -1" exception:out-of-range + (hashq #t -1)) + (pass-if-exception "hashq #t 0" exception:out-of-range + (hashq #t 0)) + (pass-if (= 0 (hashq #t 1))) + (pass-if (= 0 (hashq #f 1))) + (pass-if (= 0 (hashq noop 1))))