boolean.c 3.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121
  1. /* Copyright 1995-1996,2000-2001,2006,2008-2011,2018,2019
  2. Free Software Foundation, Inc.
  3. This file is part of Guile.
  4. Guile is free software: you can redistribute it and/or modify it
  5. under the terms of the GNU Lesser General Public License as published
  6. by the Free Software Foundation, either version 3 of the License, or
  7. (at your option) any later version.
  8. Guile is distributed in the hope that it will be useful, but WITHOUT
  9. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  10. FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
  11. License for more details.
  12. You should have received a copy of the GNU Lesser General Public
  13. License along with Guile. If not, see
  14. <https://www.gnu.org/licenses/>. */
  15. #ifdef HAVE_CONFIG_H
  16. # include <config.h>
  17. #endif
  18. #include "error.h"
  19. #include "gsubr.h"
  20. #include "verify.h"
  21. #include "boolean.h"
  22. /*
  23. * These compile-time tests verify the properties needed for the
  24. * efficient test macros defined in boolean.h, which are defined in
  25. * terms of the SCM_MATCHES_BITS_IN_COMMON macro.
  26. *
  27. * See the comments preceeding the definitions of SCM_BOOL_F and
  28. * SCM_MATCHES_BITS_IN_COMMON in scm.h for more information.
  29. */
  30. verify (SCM_BITS_DIFFER_IN_EXACTLY_ONE_BIT_POSITION \
  31. (SCM_BOOL_F_BITS, SCM_BOOL_T_BITS));
  32. verify (SCM_BITS_DIFFER_IN_EXACTLY_ONE_BIT_POSITION \
  33. (SCM_ELISP_NIL_BITS, SCM_BOOL_F_BITS));
  34. verify (SCM_BITS_DIFFER_IN_EXACTLY_ONE_BIT_POSITION \
  35. (SCM_ELISP_NIL_BITS, SCM_EOL_BITS));
  36. verify (SCM_BITS_DIFFER_IN_EXACTLY_TWO_BIT_POSITIONS \
  37. (SCM_ELISP_NIL_BITS, SCM_BOOL_F_BITS, SCM_BOOL_T_BITS, \
  38. SCM_XXX_ANOTHER_BOOLEAN_DONT_USE_0));
  39. verify (SCM_BITS_DIFFER_IN_EXACTLY_TWO_BIT_POSITIONS \
  40. (SCM_ELISP_NIL_BITS, SCM_BOOL_F_BITS, SCM_EOL_BITS, \
  41. SCM_XXX_ANOTHER_LISP_FALSE_DONT_USE));
  42. SCM_DEFINE (scm_not, "not", 1, 0, 0,
  43. (SCM x),
  44. "Return @code{#t} iff @var{x} is false, else return @code{#f}.")
  45. #define FUNC_NAME s_scm_not
  46. {
  47. return scm_from_bool (scm_is_false (x));
  48. }
  49. #undef FUNC_NAME
  50. SCM_DEFINE (scm_nil_p, "nil?", 1, 0, 0,
  51. (SCM x),
  52. "Return @code{#t} if @var{x} would be interpreted as @code{nil}\n"
  53. "by Emacs Lisp code, else return @code{#f}.\n"
  54. "\n"
  55. "@example\n"
  56. "(nil? #nil) @result{} #t\n"
  57. "(nil? #f) @result{} #t\n"
  58. "(nil? '()) @result{} #t\n"
  59. "(nil? 3) @result{} #f\n"
  60. "@end example")
  61. #define FUNC_NAME s_scm_nil_p
  62. {
  63. return scm_from_bool (scm_is_lisp_false (x));
  64. }
  65. #undef FUNC_NAME
  66. SCM_DEFINE (scm_boolean_p, "boolean?", 1, 0, 0,
  67. (SCM obj),
  68. "Return @code{#t} iff @var{obj} is @code{#t} or false.")
  69. #define FUNC_NAME s_scm_boolean_p
  70. {
  71. return scm_from_bool (scm_is_bool (obj));
  72. }
  73. #undef FUNC_NAME
  74. int
  75. scm_to_bool (SCM x)
  76. {
  77. if (scm_is_false (x))
  78. return 0;
  79. else if (scm_is_eq (x, SCM_BOOL_T))
  80. return 1;
  81. else
  82. scm_wrong_type_arg (NULL, 0, x);
  83. }
  84. /* We keep this primitive as a function in addition to the same-named macro
  85. because some applications (e.g., GNU LilyPond 2.13.9) expect it to be a
  86. function. */
  87. #undef scm_is_bool
  88. int
  89. scm_is_bool (SCM obj)
  90. {
  91. /* This must match the macro definition of `scm_is_bool ()'. */
  92. return scm_is_bool_or_nil (obj);
  93. }
  94. void
  95. scm_init_boolean ()
  96. {
  97. #include "boolean.x"
  98. }