libguile/strorder.c

   1 /*      Copyright (C) 1995, 1996, 1999, 2000 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
   5  * License as published by the Free Software Foundation; either
   6  * version 2.1 of the License, or (at your option) any later version.
   7  *
   8  * This library is distributed in the hope that it will be useful,
   9  * but 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
  16  */
  17
  18 \f
  19
  20 #include "libguile/_scm.h"
  21 #include "libguile/chars.h"
  22 #include "libguile/strings.h"
  23 #include "libguile/symbols.h"
  24
  25 #include "libguile/validate.h"
  26 #include "libguile/strorder.h"
  27 \f
  28
  29 SCM_DEFINE1 (scm_string_equal_p, "string=?", scm_tc7_rpsubr,
  30              (SCM s1, SCM s2),
  31             "Lexicographic equality predicate; return @code{#t} if the two\n"
  32             "strings are the same length and contain the same characters in\n"
  33             "the same positions, otherwise return @code{#f}.\n"
  34             "\n"
  35             "The procedure @code{string-ci=?} treats upper and lower case\n"
  36             "letters as though they were the same character, but\n"
  37             "@code{string=?} treats upper and lower case as distinct\n"
  38             "characters.")
  39 #define FUNC_NAME s_scm_string_equal_p
  40 {
  41   size_t length;
  42
  43   SCM_VALIDATE_STRING (1, s1);
  44   SCM_VALIDATE_STRING (2, s2);
  45
  46   length = SCM_STRING_LENGTH (s2);
  47   if (SCM_STRING_LENGTH (s1) == length)
  48     {
  49       unsigned char *c1 = SCM_STRING_UCHARS (s1) + length - 1;
  50       unsigned char *c2 = SCM_STRING_UCHARS (s2) + length - 1;
  51       size_t i;
  52
  53       /* comparing from back to front typically finds mismatches faster */
  54       for (i = 0; i != length; ++i, --c1, --c2)
  55         if (*c1 != *c2)
  56           return SCM_BOOL_F;
  57
  58       return SCM_BOOL_T;
  59     }
  60   else
  61     {
  62       return SCM_BOOL_F;
  63     }
  64 }
  65 #undef FUNC_NAME
  66
  67
  68 SCM_DEFINE1 (scm_string_ci_equal_p, "string-ci=?", scm_tc7_rpsubr,
  69              (SCM s1, SCM s2),
  70             "Case-insensitive string equality predicate; return @code{#t} if\n"
  71             "the two strings are the same length and their component\n"
  72             "characters match (ignoring case) at each position; otherwise\n"
  73             "return @code{#f}.")
  74 #define FUNC_NAME s_scm_string_ci_equal_p
  75 {
  76   size_t length;
  77
  78   SCM_VALIDATE_STRING (1, s1);
  79   SCM_VALIDATE_STRING (2, s2);
  80
  81   length = SCM_STRING_LENGTH (s2);
  82   if (SCM_STRING_LENGTH (s1) == length)
  83     {
  84       unsigned char *c1 = SCM_STRING_UCHARS (s1) + length - 1;
  85       unsigned char *c2 = SCM_STRING_UCHARS (s2) + length - 1;
  86       size_t i;
  87
  88       /* comparing from back to front typically finds mismatches faster */
  89       for (i = 0; i != length; ++i, --c1, --c2)
  90         if (scm_c_upcase (*c1) != scm_c_upcase (*c2))
  91           return SCM_BOOL_F;
  92
  93       return SCM_BOOL_T;
  94     }
  95   else
  96     {
  97       return SCM_BOOL_F;
  98     }
  99 }
 100 #undef FUNC_NAME
 101
 102
 103 /* Helper function for the lexicographic ordering predicates.
 104  * No argument checking is performed.  */
 105 static SCM
 106 string_less_p (SCM s1, SCM s2)
 107 {
 108   size_t i, length1, length2, lengthm;
 109   unsigned char *c1, *c2;
 110
 111   length1 = SCM_STRING_LENGTH (s1);
 112   length2 = SCM_STRING_LENGTH (s2);
 113   lengthm = min (length1, length2);
 114   c1 = SCM_STRING_UCHARS (s1);
 115   c2 = SCM_STRING_UCHARS (s2);
 116
 117   for (i = 0; i != lengthm; ++i, ++c1, ++c2) {
 118     int c = *c1 - *c2;
 119     if (c < 0) return SCM_BOOL_T;
 120     if (c > 0) return SCM_BOOL_F;
 121   }
 122
 123   return SCM_BOOL (length1 < length2);
 124 }
 125
 126
 127 SCM_DEFINE1 (scm_string_less_p, "string<?", scm_tc7_rpsubr,
 128              (SCM s1, SCM s2),
 129             "Lexicographic ordering predicate; return @code{#t} if @var{s1}\n"
 130             "is lexicographically less than @var{s2}.")
 131 #define FUNC_NAME s_scm_string_less_p
 132 {
 133   SCM_VALIDATE_STRING (1, s1);
 134   SCM_VALIDATE_STRING (2, s2);
 135
 136   return string_less_p (s1, s2);
 137 }
 138 #undef FUNC_NAME
 139
 140
 141 SCM_DEFINE1 (scm_string_leq_p, "string<=?", scm_tc7_rpsubr,
 142              (SCM s1, SCM s2),
 143             "Lexicographic ordering predicate; return @code{#t} if @var{s1}\n"
 144             "is lexicographically less than or equal to @var{s2}.")
 145 #define FUNC_NAME s_scm_string_leq_p
 146 {
 147   SCM_VALIDATE_STRING (1, s1);
 148   SCM_VALIDATE_STRING (2, s2);
 149
 150   return SCM_BOOL_NOT (string_less_p (s2, s1));
 151 }
 152 #undef FUNC_NAME
 153
 154
 155 SCM_DEFINE1 (scm_string_gr_p, "string>?", scm_tc7_rpsubr,
 156              (SCM s1, SCM s2),
 157             "Lexicographic ordering predicate; return @code{#t} if @var{s1}\n"
 158             "is lexicographically greater than @var{s2}.")
 159 #define FUNC_NAME s_scm_string_gr_p
 160 {
 161   SCM_VALIDATE_STRING (1, s1);
 162   SCM_VALIDATE_STRING (2, s2);
 163
 164   return string_less_p (s2, s1);
 165 }
 166 #undef FUNC_NAME
 167
 168
 169 SCM_DEFINE1 (scm_string_geq_p, "string>=?", scm_tc7_rpsubr,
 170              (SCM s1, SCM s2),
 171             "Lexicographic ordering predicate; return @code{#t} if @var{s1}\n"
 172             "is lexicographically greater than or equal to @var{s2}.")
 173 #define FUNC_NAME s_scm_string_geq_p
 174 {
 175   SCM_VALIDATE_STRING (1, s1);
 176   SCM_VALIDATE_STRING (2, s2);
 177
 178   return SCM_BOOL_NOT (string_less_p (s1, s2));
 179 }
 180 #undef FUNC_NAME
 181
 182
 183 /* Helper function for the case insensitive lexicographic ordering
 184  * predicates.  No argument checking is performed.  */
 185 static SCM
 186 string_ci_less_p (SCM s1, SCM s2)
 187 {
 188   size_t i, length1, length2, lengthm;
 189   unsigned char *c1, *c2;
 190
 191   length1 = SCM_STRING_LENGTH (s1);
 192   length2 = SCM_STRING_LENGTH (s2);
 193   lengthm = min (length1, length2);
 194   c1 = SCM_STRING_UCHARS (s1);
 195   c2 = SCM_STRING_UCHARS (s2);
 196
 197   for (i = 0; i != lengthm; ++i, ++c1, ++c2) {
 198     int c = scm_c_upcase (*c1) - scm_c_upcase (*c2);
 199     if (c < 0) return SCM_BOOL_T;
 200     if (c > 0) return SCM_BOOL_F;
 201   }
 202
 203   return SCM_BOOL (length1 < length2);
 204 }
 205
 206
 207 SCM_DEFINE1 (scm_string_ci_less_p, "string-ci<?", scm_tc7_rpsubr,
 208              (SCM s1, SCM s2),
 209             "Case insensitive lexicographic ordering predicate; return\n"
 210             "@code{#t} if @var{s1} is lexicographically less than @var{s2}\n"
 211             "regardless of case.")
 212 #define FUNC_NAME s_scm_string_ci_less_p
 213 {
 214   SCM_VALIDATE_STRING (1, s1);
 215   SCM_VALIDATE_STRING (2, s2);
 216
 217   return string_ci_less_p (s1, s2);
 218 }
 219 #undef FUNC_NAME
 220
 221
 222 SCM_DEFINE1 (scm_string_ci_leq_p, "string-ci<=?", scm_tc7_rpsubr,
 223              (SCM s1, SCM s2),
 224             "Case insensitive lexicographic ordering predicate; return\n"
 225             "@code{#t} if @var{s1} is lexicographically less than or equal\n"
 226             "to @var{s2} regardless of case.")
 227 #define FUNC_NAME s_scm_string_ci_leq_p
 228 {
 229   SCM_VALIDATE_STRING (1, s1);
 230   SCM_VALIDATE_STRING (2, s2);
 231
 232   return SCM_BOOL_NOT (string_ci_less_p (s2, s1));
 233 }
 234 #undef FUNC_NAME
 235
 236
 237 SCM_DEFINE1 (scm_string_ci_gr_p, "string-ci>?", scm_tc7_rpsubr,
 238              (SCM s1, SCM s2),
 239             "Case insensitive lexicographic ordering predicate; return\n"
 240             "@code{#t} if @var{s1} is lexicographically greater than\n"
 241             "@var{s2} regardless of case.")
 242 #define FUNC_NAME s_scm_string_ci_gr_p
 243 {
 244   SCM_VALIDATE_STRING (1, s1);
 245   SCM_VALIDATE_STRING (2, s2);
 246
 247   return string_ci_less_p (s2, s1);
 248 }
 249 #undef FUNC_NAME
 250
 251
 252 SCM_DEFINE1 (scm_string_ci_geq_p, "string-ci>=?", scm_tc7_rpsubr,
 253              (SCM s1, SCM s2),
 254             "Case insensitive lexicographic ordering predicate; return\n"
 255             "@code{#t} if @var{s1} is lexicographically greater than or\n"
 256             "equal to @var{s2} regardless of case.")
 257 #define FUNC_NAME s_scm_string_ci_geq_p
 258 {
 259   SCM_VALIDATE_STRING (1, s1);
 260   SCM_VALIDATE_STRING (2, s2);
 261
 262   return SCM_BOOL_NOT (string_ci_less_p (s1, s2));
 263 }
 264 #undef FUNC_NAME
 265
 266 \f
 267
 268 void
 269 scm_init_strorder ()
 270 {
 271 #include "libguile/strorder.x"
 272 }
 273
 274
 275 /*
 276   Local Variables:
 277   c-file-style: "gnu"
 278   End:
 279 */