libguile/boolean.c

   1 /*      Copyright (C) 1995, 1996, 2000, 2001, 2006, 2008, 2009, 2010 Free Software Foundation, Inc.
   2  *
   3  * This library is free software; you can redistribute it and/or
   4  * modify it under the terms of the GNU Lesser General Public License
   5  * as published by the Free Software Foundation; either version 3 of
   6  * the License, or (at your option) any later version.
   7  *
   8  * This library is distributed in the hope that it will be useful, but
   9  * WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  11  * Lesser General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU Lesser General Public
  14  * License along with this library; if not, write to the Free Software
  15  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  16  * 02110-1301 USA
  17  */
  18
  19
  20 \f
  21 #ifdef HAVE_CONFIG_H
  22 # include <config.h>
  23 #endif
  24
  25 #include "libguile/_scm.h"
  26
  27 #include "libguile/validate.h"
  28 #include "libguile/boolean.h"
  29 #include "libguile/lang.h"
  30 #include "libguile/tags.h"
  31
  32 #include "verify.h"
  33
  34 \f
  35
  36 /*
  37  * These compile-time tests verify the properties needed for the
  38  * efficient test macros defined in boolean.h, which are defined in
  39  * terms of the SCM_MATCHES_BITS_IN_COMMON macro.
  40  *
  41  * See the comments preceeding the definitions of SCM_BOOL_F and
  42  * SCM_MATCHES_BITS_IN_COMMON in tags.h for more information.
  43  */
  44 verify (SCM_VALUES_DIFFER_IN_EXACTLY_ONE_BIT_POSITION           \
  45                 (SCM_BOOL_F, SCM_BOOL_T));
  46 verify (SCM_VALUES_DIFFER_IN_EXACTLY_ONE_BIT_POSITION           \
  47                 (SCM_ELISP_NIL, SCM_BOOL_F));
  48 verify (SCM_VALUES_DIFFER_IN_EXACTLY_ONE_BIT_POSITION           \
  49                 (SCM_ELISP_NIL, SCM_EOL));
  50 verify (SCM_VALUES_DIFFER_IN_EXACTLY_TWO_BIT_POSITIONS          \
  51                 (SCM_ELISP_NIL, SCM_BOOL_F, SCM_BOOL_T,         \
  52                  SCM_XXX_ANOTHER_BOOLEAN_DONT_USE));
  53 verify (SCM_VALUES_DIFFER_IN_EXACTLY_TWO_BIT_POSITIONS          \
  54                 (SCM_ELISP_NIL, SCM_BOOL_F, SCM_EOL,            \
  55                  SCM_XXX_ANOTHER_LISP_FALSE_DONT_USE));
  56
  57 SCM_DEFINE (scm_not, "not", 1, 0, 0,
  58             (SCM x),
  59             "Return @code{#t} iff @var{x} is @code{#f}, else return @code{#f}.")
  60 #define FUNC_NAME s_scm_not
  61 {
  62   return scm_from_bool (scm_is_false_or_nil (x));
  63 }
  64 #undef FUNC_NAME
  65
  66
  67 SCM_DEFINE (scm_boolean_p, "boolean?", 1, 0, 0,
  68            (SCM obj),
  69             "Return @code{#t} iff @var{obj} is either @code{#t} or @code{#f}.")
  70 #define FUNC_NAME s_scm_boolean_p
  71 {
  72   return scm_from_bool (scm_is_bool_or_nil (obj));
  73 }
  74 #undef FUNC_NAME
  75
  76 int
  77 scm_to_bool (SCM x)
  78 {
  79   /* XXX Should this first test use scm_is_false_or_nil instead? */
  80   if (scm_is_eq (x, SCM_BOOL_F))
  81     return 0;
  82   else if (scm_is_eq (x, SCM_BOOL_T))
  83     return 1;
  84   else
  85     scm_wrong_type_arg (NULL, 0, x);
  86 }
  87
  88 /* We keep this primitive as a function in addition to the same-named macro
  89    because some applications (e.g., GNU LilyPond 2.13.9) expect it to be a
  90    function.  */
  91 #undef scm_is_bool
  92 int
  93 scm_is_bool (SCM obj)
  94 {
  95   /* This must match the macro definition of `scm_is_bool ()'.  */
  96   return scm_is_bool_and_not_nil (obj);
  97 }
  98
  99 \f
 100 void
 101 scm_init_boolean ()
 102 {
 103 #include "libguile/boolean.x"
 104 }
 105
 106
 107 /*
 108   Local Variables:
 109   c-file-style: "gnu"
 110   End:
 111 */