libguile/strorder.c

   1 /*      Copyright (C) 1995, 1996, 1999, 2000, 2004, 2006, 2008 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 \f
  20 #ifdef HAVE_CONFIG_H
  21 # include <config.h>
  22 #endif
  23
  24 #include "libguile/_scm.h"
  25 #include "libguile/chars.h"
  26 #include "libguile/strings.h"
  27 #include "libguile/symbols.h"
  28
  29 #include "libguile/validate.h"
  30 #include "libguile/strorder.h"
  31 #include "libguile/srfi-13.h"
  32 \f
  33
  34 SCM_C_INLINE_KEYWORD static SCM
  35 srfi13_cmp (SCM s1, SCM s2, SCM (*cmp) (SCM, SCM, SCM, SCM, SCM, SCM))
  36 {
  37   if (scm_is_true (cmp (s1, s2,
  38                         SCM_UNDEFINED, SCM_UNDEFINED,
  39                         SCM_UNDEFINED, SCM_UNDEFINED)))
  40     return SCM_BOOL_T;
  41   else
  42     return SCM_BOOL_F;
  43 }
  44
  45 SCM_DEFINE1 (scm_string_equal_p, "string=?", scm_tc7_rpsubr,
  46              (SCM s1, SCM s2),
  47             "Lexicographic equality predicate; return @code{#t} if the two\n"
  48             "strings are the same length and contain the same characters in\n"
  49             "the same positions, otherwise return @code{#f}.\n"
  50             "\n"
  51             "The procedure @code{string-ci=?} treats upper and lower case\n"
  52             "letters as though they were the same character, but\n"
  53             "@code{string=?} treats upper and lower case as distinct\n"
  54             "characters.")
  55 #define FUNC_NAME s_scm_string_equal_p
  56 {
  57   return srfi13_cmp (s1, s2, scm_string_eq);
  58 }
  59 #undef FUNC_NAME
  60
  61 SCM_DEFINE1 (scm_string_ci_equal_p, "string-ci=?", scm_tc7_rpsubr,
  62              (SCM s1, SCM s2),
  63             "Case-insensitive string equality predicate; return @code{#t} if\n"
  64             "the two strings are the same length and their component\n"
  65             "characters match (ignoring case) at each position; otherwise\n"
  66             "return @code{#f}.")
  67 #define FUNC_NAME s_scm_string_ci_equal_p
  68 {
  69   return srfi13_cmp (s1, s2, scm_string_ci_eq);
  70 }
  71 #undef FUNC_NAME
  72
  73 SCM_DEFINE1 (scm_string_less_p, "string<?", scm_tc7_rpsubr,
  74              (SCM s1, SCM s2),
  75             "Lexicographic ordering predicate; return @code{#t} if @var{s1}\n"
  76             "is lexicographically less than @var{s2}.")
  77 #define FUNC_NAME s_scm_string_less_p
  78 {
  79   return srfi13_cmp (s1, s2, scm_string_lt);
  80 }
  81 #undef FUNC_NAME
  82
  83 SCM_DEFINE1 (scm_string_leq_p, "string<=?", scm_tc7_rpsubr,
  84              (SCM s1, SCM s2),
  85             "Lexicographic ordering predicate; return @code{#t} if @var{s1}\n"
  86             "is lexicographically less than or equal to @var{s2}.")
  87 #define FUNC_NAME s_scm_string_leq_p
  88 {
  89   return srfi13_cmp (s1, s2, scm_string_le);
  90 }
  91 #undef FUNC_NAME
  92
  93 SCM_DEFINE1 (scm_string_gr_p, "string>?", scm_tc7_rpsubr,
  94              (SCM s1, SCM s2),
  95             "Lexicographic ordering predicate; return @code{#t} if @var{s1}\n"
  96             "is lexicographically greater than @var{s2}.")
  97 #define FUNC_NAME s_scm_string_gr_p
  98 {
  99   return srfi13_cmp (s1, s2, scm_string_gt);
 100 }
 101 #undef FUNC_NAME
 102
 103 SCM_DEFINE1 (scm_string_geq_p, "string>=?", scm_tc7_rpsubr,
 104              (SCM s1, SCM s2),
 105             "Lexicographic ordering predicate; return @code{#t} if @var{s1}\n"
 106             "is lexicographically greater than or equal to @var{s2}.")
 107 #define FUNC_NAME s_scm_string_geq_p
 108 {
 109   return srfi13_cmp (s1, s2, scm_string_ge);
 110 }
 111 #undef FUNC_NAME
 112
 113 SCM_DEFINE1 (scm_string_ci_less_p, "string-ci<?", scm_tc7_rpsubr,
 114              (SCM s1, SCM s2),
 115             "Case insensitive lexicographic ordering predicate; return\n"
 116             "@code{#t} if @var{s1} is lexicographically less than @var{s2}\n"
 117             "regardless of case.")
 118 #define FUNC_NAME s_scm_string_ci_less_p
 119 {
 120   return srfi13_cmp (s1, s2, scm_string_ci_lt);
 121 }
 122 #undef FUNC_NAME
 123
 124 SCM_DEFINE1 (scm_string_ci_leq_p, "string-ci<=?", scm_tc7_rpsubr,
 125              (SCM s1, SCM s2),
 126             "Case insensitive lexicographic ordering predicate; return\n"
 127             "@code{#t} if @var{s1} is lexicographically less than or equal\n"
 128             "to @var{s2} regardless of case.")
 129 #define FUNC_NAME s_scm_string_ci_leq_p
 130 {
 131   return srfi13_cmp (s1, s2, scm_string_ci_le);
 132 }
 133 #undef FUNC_NAME
 134
 135 SCM_DEFINE1 (scm_string_ci_gr_p, "string-ci>?", scm_tc7_rpsubr,
 136              (SCM s1, SCM s2),
 137             "Case insensitive lexicographic ordering predicate; return\n"
 138             "@code{#t} if @var{s1} is lexicographically greater than\n"
 139             "@var{s2} regardless of case.")
 140 #define FUNC_NAME s_scm_string_ci_gr_p
 141 {
 142   return srfi13_cmp (s1, s2, scm_string_ci_gt);
 143 }
 144 #undef FUNC_NAME
 145
 146 SCM_DEFINE1 (scm_string_ci_geq_p, "string-ci>=?", scm_tc7_rpsubr,
 147              (SCM s1, SCM s2),
 148             "Case insensitive lexicographic ordering predicate; return\n"
 149             "@code{#t} if @var{s1} is lexicographically greater than or\n"
 150             "equal to @var{s2} regardless of case.")
 151 #define FUNC_NAME s_scm_string_ci_geq_p
 152 {
 153   return srfi13_cmp (s1, s2, scm_string_ci_ge);
 154 }
 155 #undef FUNC_NAME
 156
 157 \f
 158
 159 void
 160 scm_init_strorder ()
 161 {
 162 #include "libguile/strorder.x"
 163 }
 164
 165
 166 /*
 167   Local Variables:
 168   c-file-style: "gnu"
 169   End:
 170 */