libguile/strorder.c

   1 /*      Copyright (C) 1995,1996 Free Software Foundation, Inc.
   2  *
   3  * This program is free software; you can redistribute it and/or modify
   4  * it under the terms of the GNU General Public License as published by
   5  * the Free Software Foundation; either version 2, or (at your option)
   6  * any later version.
   7  *
   8  * This program 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
  11  * GNU General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License
  14  * along with this software; see the file COPYING.  If not, write to
  15  * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  16  *
  17  * As a special exception, the Free Software Foundation gives permission
  18  * for additional uses of the text contained in its release of GUILE.
  19  *
  20  * The exception is that, if you link the GUILE library with other files
  21  * to produce an executable, this does not by itself cause the
  22  * resulting executable to be covered by the GNU General Public License.
  23  * Your use of that executable is in no way restricted on account of
  24  * linking the GUILE library code into it.
  25  *
  26  * This exception does not however invalidate any other reasons why
  27  * the executable file might be covered by the GNU General Public License.
  28  *
  29  * This exception applies only to the code released by the
  30  * Free Software Foundation under the name GUILE.  If you copy
  31  * code from other Free Software Foundation releases into a copy of
  32  * GUILE, as the General Public License permits, the exception does
  33  * not apply to the code that you add in this way.  To avoid misleading
  34  * anyone as to the status of such modified files, you must delete
  35  * this exception notice from them.
  36  *
  37  * If you write modifications of your own for GUILE, it is your choice
  38  * whether to permit this exception to apply to your modifications.
  39  * If you do not wish that, delete this exception notice.
  40  */
  41 \f
  42
  43 #include <stdio.h>
  44 #include "_scm.h"
  45
  46 \f
  47
  48 SCM_PROC1 (s_string_equal_p, "string=?", scm_tc7_rpsubr, scm_string_equal_p);
  49 #ifdef __STDC__
  50 SCM
  51 scm_string_equal_p (SCM s1, SCM s2)
  52 #else
  53 SCM
  54 scm_string_equal_p (s1, s2)
  55      SCM s1;
  56      SCM s2;
  57 #endif
  58 {
  59   register scm_sizet i;
  60   register char *c1, *c2;
  61   SCM_ASSERT (SCM_NIMP (s1) && SCM_ROSTRINGP (s1), s1, SCM_ARG1, s_string_equal_p);
  62   SCM_ASSERT (SCM_NIMP (s2) && SCM_ROSTRINGP (s2), s2, SCM_ARG2, s_string_equal_p);
  63
  64   i = SCM_ROLENGTH (s2);
  65   if (SCM_ROLENGTH (s1) != i)
  66     {
  67       return SCM_BOOL_F;
  68     }
  69   c1 = SCM_ROCHARS (s1);
  70   c2 = SCM_ROCHARS (s2);
  71   while (0 != i--)
  72     if (*c1++ != *c2++)
  73       return SCM_BOOL_F;
  74   return SCM_BOOL_T;
  75 }
  76
  77 SCM_PROC1 (s_string_ci_equal_p, "string-ci=?", scm_tc7_rpsubr, scm_string_ci_equal_p);
  78 #ifdef __STDC__
  79 SCM
  80 scm_string_ci_equal_p (SCM s1, SCM s2)
  81 #else
  82 SCM
  83 scm_string_ci_equal_p (s1, s2)
  84      SCM s1;
  85      SCM s2;
  86 #endif
  87 {
  88   register scm_sizet i;
  89   register unsigned char *c1, *c2;
  90   SCM_ASSERT (SCM_NIMP (s1) && SCM_ROSTRINGP (s1), s1, SCM_ARG1, s_string_ci_equal_p);
  91   SCM_ASSERT (SCM_NIMP (s2) && SCM_ROSTRINGP (s2), s2, SCM_ARG2, s_string_ci_equal_p);
  92   i = SCM_ROLENGTH (s2);
  93   if (SCM_ROLENGTH (s1) != i)
  94     {
  95       return SCM_BOOL_F;
  96     }
  97   c1 = SCM_ROUCHARS (s1);
  98   c2 = SCM_ROUCHARS (s2);
  99   while (0 != i--)
 100     if (scm_upcase(*c1++) != scm_upcase(*c2++))
 101       return SCM_BOOL_F;
 102   return SCM_BOOL_T;
 103 }
 104
 105 SCM_PROC1 (s_string_less_p, "string<?", scm_tc7_rpsubr, scm_string_less_p);
 106 #ifdef __STDC__
 107 SCM
 108 scm_string_less_p (SCM s1, SCM s2)
 109 #else
 110 SCM
 111 scm_string_less_p (s1, s2)
 112      SCM s1;
 113      SCM s2;
 114 #endif
 115 {
 116   register scm_sizet i, len, s2len;
 117   register unsigned char *c1, *c2;
 118   register int c;
 119
 120   SCM_ASSERT (SCM_NIMP (s1) && SCM_ROSTRINGP (s1), s1, SCM_ARG1, s_string_less_p);
 121   SCM_ASSERT (SCM_NIMP (s2) && SCM_ROSTRINGP (s2), s2, SCM_ARG2, s_string_less_p);
 122   len = SCM_ROLENGTH (s1);
 123   s2len = i = SCM_ROLENGTH (s2);
 124   if (len>i) i = len;
 125   c1 = SCM_ROUCHARS (s1);
 126   c2 = SCM_ROUCHARS (s2);
 127
 128   for (i = 0;i<len;i++) {
 129     c = (*c1++ - *c2++);
 130     if (c>0)
 131       return SCM_BOOL_F;
 132     if (c<0)
 133       return SCM_BOOL_T;
 134   }
 135   {
 136     SCM answer;
 137     answer = (s2len != len) ? SCM_BOOL_T : SCM_BOOL_F;
 138     return answer;
 139   }
 140 }
 141
 142 SCM_PROC1 (s_string_leq_p, "string<=?", scm_tc7_rpsubr, scm_string_leq_p);
 143 #ifdef __STDC__
 144 SCM
 145 scm_string_leq_p (SCM s1, SCM s2)
 146 #else
 147 SCM
 148 scm_string_leq_p (s1, s2)
 149      SCM s1;
 150      SCM s2;
 151 #endif
 152 {
 153   return SCM_BOOL_NOT (scm_string_less_p (s2, s1));
 154 }
 155
 156 SCM_PROC1 (s_string_gr_p, "string>?", scm_tc7_rpsubr, scm_string_gr_p);
 157 #ifdef __STDC__
 158 SCM
 159 scm_string_gr_p (SCM s1, SCM s2)
 160 #else
 161 SCM
 162 scm_string_gr_p (s1, s2)
 163      SCM s1;
 164      SCM s2;
 165 #endif
 166 {
 167   return scm_string_less_p (s2, s1);
 168 }
 169
 170 SCM_PROC1 (s_string_geq_p, "string>=?", scm_tc7_rpsubr, scm_string_geq_p);
 171 #ifdef __STDC__
 172 SCM
 173 scm_string_geq_p (SCM s1, SCM s2)
 174 #else
 175 SCM
 176 scm_string_geq_p (s1, s2)
 177      SCM s1;
 178      SCM s2;
 179 #endif
 180 {
 181   return SCM_BOOL_NOT (scm_string_less_p (s1, s2));
 182 }
 183
 184 SCM_PROC1 (s_string_ci_less_p, "string-ci<?", scm_tc7_rpsubr, scm_string_ci_less_p);
 185 #ifdef __STDC__
 186 SCM
 187 scm_string_ci_less_p (SCM s1, SCM s2)
 188 #else
 189 SCM
 190 scm_string_ci_less_p (s1, s2)
 191      SCM s1;
 192      SCM s2;
 193 #endif
 194 {
 195   register scm_sizet i, len, s2len;
 196   register unsigned char *c1, *c2;
 197   register int c;
 198   SCM_ASSERT (SCM_NIMP (s1) && SCM_ROSTRINGP (s1), s1, SCM_ARG1, s_string_ci_less_p);
 199   SCM_ASSERT (SCM_NIMP (s2) && SCM_ROSTRINGP (s2), s2, SCM_ARG2, s_string_ci_less_p);
 200   len = SCM_ROLENGTH (s1);
 201   s2len = i = SCM_ROLENGTH (s2);
 202   if (len>i) i=len;
 203   c1 = SCM_ROUCHARS (s1);
 204   c2 = SCM_ROUCHARS (s2);
 205   for (i = 0;i<len;i++) {
 206     c = (scm_upcase(*c1++) - scm_upcase(*c2++));
 207     if (c>0) return SCM_BOOL_F;
 208     if (c<0) return SCM_BOOL_T;
 209   }
 210   return (s2len != len) ? SCM_BOOL_T : SCM_BOOL_F;
 211 }
 212
 213 SCM_PROC1 (s_string_ci_leq_p, "string-ci<=?", scm_tc7_rpsubr, scm_string_ci_leq_p);
 214 #ifdef __STDC__
 215 SCM
 216 scm_string_ci_leq_p (SCM s1, SCM s2)
 217 #else
 218 SCM
 219 scm_string_ci_leq_p (s1, s2)
 220      SCM s1;
 221      SCM s2;
 222 #endif
 223 {
 224   return SCM_BOOL_NOT (scm_string_ci_less_p (s2, s1));
 225 }
 226
 227 SCM_PROC1 (s_string_ci_gr_p, "string-ci>?", scm_tc7_rpsubr, scm_string_ci_gr_p);
 228 #ifdef __STDC__
 229 SCM
 230 scm_string_ci_gr_p (SCM s1, SCM s2)
 231 #else
 232 SCM
 233 scm_string_ci_gr_p (s1, s2)
 234      SCM s1;
 235      SCM s2;
 236 #endif
 237 {
 238   return scm_string_ci_less_p (s2, s1);
 239 }
 240
 241 SCM_PROC1 (s_string_ci_geq_p, "string-ci>=?", scm_tc7_rpsubr, scm_string_ci_geq_p);
 242 #ifdef __STDC__
 243 SCM
 244 scm_string_ci_geq_p (SCM s1, SCM s2)
 245 #else
 246 SCM
 247 scm_string_ci_geq_p (s1, s2)
 248      SCM s1;
 249      SCM s2;
 250 #endif
 251 {
 252   return SCM_BOOL_NOT (scm_string_ci_less_p (s1, s2));
 253 }
 254
 255 \f
 256 #ifdef __STDC__
 257 void
 258 scm_init_strorder (void)
 259 #else
 260 void
 261 scm_init_strorder ()
 262 #endif
 263 {
 264 #include "strorder.x"
 265 }
 266