Commit | Line | Data |
---|---|---|
f2c9fcb0 | 1 | /* Copyright (C) 1995, 1996, 1999, 2000 Free Software Foundation, Inc. |
0f2d19dd JB |
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 | |
82892bed JB |
15 | * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, |
16 | * Boston, MA 02111-1307 USA | |
0f2d19dd JB |
17 | * |
18 | * As a special exception, the Free Software Foundation gives permission | |
19 | * for additional uses of the text contained in its release of GUILE. | |
20 | * | |
21 | * The exception is that, if you link the GUILE library with other files | |
22 | * to produce an executable, this does not by itself cause the | |
23 | * resulting executable to be covered by the GNU General Public License. | |
24 | * Your use of that executable is in no way restricted on account of | |
25 | * linking the GUILE library code into it. | |
26 | * | |
27 | * This exception does not however invalidate any other reasons why | |
28 | * the executable file might be covered by the GNU General Public License. | |
29 | * | |
30 | * This exception applies only to the code released by the | |
31 | * Free Software Foundation under the name GUILE. If you copy | |
32 | * code from other Free Software Foundation releases into a copy of | |
33 | * GUILE, as the General Public License permits, the exception does | |
34 | * not apply to the code that you add in this way. To avoid misleading | |
35 | * anyone as to the status of such modified files, you must delete | |
36 | * this exception notice from them. | |
37 | * | |
38 | * If you write modifications of your own for GUILE, it is your choice | |
39 | * whether to permit this exception to apply to your modifications. | |
82892bed | 40 | * If you do not wish that, delete this exception notice. */ |
6e8d25a6 GB |
41 | |
42 | /* Software engineering face-lift by Greg J. Badros, 11-Dec-1999, | |
43 | gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */ | |
0f2d19dd JB |
44 | \f |
45 | ||
a0599745 MD |
46 | #include "libguile/_scm.h" |
47 | #include "libguile/chars.h" | |
a002f1a2 DH |
48 | #include "libguile/strings.h" |
49 | #include "libguile/symbols.h" | |
0f2d19dd | 50 | |
a0599745 MD |
51 | #include "libguile/validate.h" |
52 | #include "libguile/strorder.h" | |
0f2d19dd JB |
53 | \f |
54 | ||
c3ee7520 | 55 | SCM_DEFINE1 (scm_string_equal_p, "string=?", scm_tc7_rpsubr, |
6e8d25a6 | 56 | (SCM s1, SCM s2), |
5ffe9968 | 57 | "Lexicographic equality predicate; \n" |
942e5b91 MG |
58 | "Returns @code{#t} if the two strings are the same length and\n" |
59 | "contain the same characters in the same positions, otherwise\n" | |
60 | "returns @code{#f}. (r5rs)\n\n" | |
61 | "The procedure @code{string-ci=?} treats upper and lower case\n" | |
62 | "letters as though they were the same character, but\n" | |
63 | "@code{string=?} treats upper and lower case as distinct\n" | |
64 | "characters.") | |
6e8d25a6 | 65 | #define FUNC_NAME s_scm_string_equal_p |
0f2d19dd | 66 | { |
e9bfab50 | 67 | scm_sizet length; |
0f2d19dd | 68 | |
e9bfab50 DH |
69 | SCM_VALIDATE_STRING (1, s1); |
70 | SCM_VALIDATE_STRING (2, s2); | |
71 | ||
72 | length = SCM_STRING_LENGTH (s2); | |
73 | if (SCM_STRING_LENGTH (s1) == length) | |
0f2d19dd | 74 | { |
34f0f2b8 DH |
75 | unsigned char *c1 = SCM_STRING_UCHARS (s1) + length - 1; |
76 | unsigned char *c2 = SCM_STRING_UCHARS (s2) + length - 1; | |
e9bfab50 DH |
77 | scm_sizet i; |
78 | ||
79 | /* comparing from back to front typically finds mismatches faster */ | |
80 | for (i = 0; i != length; ++i, --c1, --c2) | |
81 | if (*c1 != *c2) | |
82 | return SCM_BOOL_F; | |
83 | ||
84 | return SCM_BOOL_T; | |
0f2d19dd | 85 | } |
e9bfab50 DH |
86 | else |
87 | { | |
0f2d19dd | 88 | return SCM_BOOL_F; |
e9bfab50 | 89 | } |
0f2d19dd | 90 | } |
6e8d25a6 | 91 | #undef FUNC_NAME |
0f2d19dd | 92 | |
e9bfab50 | 93 | |
c3ee7520 | 94 | SCM_DEFINE1 (scm_string_ci_equal_p, "string-ci=?", scm_tc7_rpsubr, |
6e8d25a6 | 95 | (SCM s1, SCM s2), |
942e5b91 MG |
96 | "Case-insensitive string equality predicate; returns @code{#t}\n" |
97 | "if the two strings are the same length and their component\n" | |
98 | "characters match (ignoring case) at each position; otherwise\n" | |
99 | "returns @code{#f}. (r5rs)") | |
6e8d25a6 | 100 | #define FUNC_NAME s_scm_string_ci_equal_p |
0f2d19dd | 101 | { |
e9bfab50 | 102 | scm_sizet length; |
6e8d25a6 | 103 | |
e9bfab50 DH |
104 | SCM_VALIDATE_STRING (1, s1); |
105 | SCM_VALIDATE_STRING (2, s2); | |
106 | ||
107 | length = SCM_STRING_LENGTH (s2); | |
108 | if (SCM_STRING_LENGTH (s1) == length) | |
0f2d19dd | 109 | { |
34f0f2b8 DH |
110 | unsigned char *c1 = SCM_STRING_UCHARS (s1) + length - 1; |
111 | unsigned char *c2 = SCM_STRING_UCHARS (s2) + length - 1; | |
e9bfab50 DH |
112 | scm_sizet i; |
113 | ||
114 | /* comparing from back to front typically finds mismatches faster */ | |
115 | for (i = 0; i != length; ++i, --c1, --c2) | |
116 | if (scm_upcase (*c1) != scm_upcase (*c2)) | |
117 | return SCM_BOOL_F; | |
118 | ||
119 | return SCM_BOOL_T; | |
0f2d19dd | 120 | } |
e9bfab50 DH |
121 | else |
122 | { | |
0f2d19dd | 123 | return SCM_BOOL_F; |
e9bfab50 | 124 | } |
0f2d19dd | 125 | } |
6e8d25a6 | 126 | #undef FUNC_NAME |
0f2d19dd | 127 | |
e9bfab50 | 128 | |
3ba5a6c2 DH |
129 | /* Helper function for the lexicographic ordering predicates. |
130 | * No argument checking is performed. */ | |
131 | static SCM | |
132 | string_less_p (SCM s1, SCM s2) | |
0f2d19dd | 133 | { |
e9bfab50 DH |
134 | scm_sizet i, length1, length2, lengthm; |
135 | unsigned char *c1, *c2; | |
136 | ||
e9bfab50 DH |
137 | length1 = SCM_STRING_LENGTH (s1); |
138 | length2 = SCM_STRING_LENGTH (s2); | |
139 | lengthm = min (length1, length2); | |
34f0f2b8 DH |
140 | c1 = SCM_STRING_UCHARS (s1); |
141 | c2 = SCM_STRING_UCHARS (s2); | |
0f2d19dd | 142 | |
e9bfab50 DH |
143 | for (i = 0; i != lengthm; ++i, ++c1, ++c2) { |
144 | int c = *c1 - *c2; | |
145 | if (c < 0) return SCM_BOOL_T; | |
146 | if (c > 0) return SCM_BOOL_F; | |
0f2d19dd | 147 | } |
e9bfab50 DH |
148 | |
149 | return SCM_BOOL (length1 < length2); | |
0f2d19dd | 150 | } |
3ba5a6c2 DH |
151 | |
152 | ||
153 | SCM_DEFINE1 (scm_string_less_p, "string<?", scm_tc7_rpsubr, | |
154 | (SCM s1, SCM s2), | |
942e5b91 MG |
155 | "Lexicographic ordering predicate; returns @code{#t} if\n" |
156 | "@var{s1} is lexicographically less than @var{s2}. (r5rs)") | |
3ba5a6c2 DH |
157 | #define FUNC_NAME s_scm_string_less_p |
158 | { | |
159 | SCM_VALIDATE_STRING (1, s1); | |
160 | SCM_VALIDATE_STRING (2, s2); | |
161 | ||
162 | return string_less_p (s1, s2); | |
163 | } | |
6e8d25a6 | 164 | #undef FUNC_NAME |
0f2d19dd | 165 | |
e9bfab50 | 166 | |
c3ee7520 | 167 | SCM_DEFINE1 (scm_string_leq_p, "string<=?", scm_tc7_rpsubr, |
6e8d25a6 | 168 | (SCM s1, SCM s2), |
942e5b91 MG |
169 | "Lexicographic ordering predicate; returns @code{#t} if\n" |
170 | "@var{s1} is lexicographically less than or equal to @var{s2}.\n" | |
171 | "(r5rs)") | |
6e8d25a6 | 172 | #define FUNC_NAME s_scm_string_leq_p |
0f2d19dd | 173 | { |
3ba5a6c2 DH |
174 | SCM_VALIDATE_STRING (1, s1); |
175 | SCM_VALIDATE_STRING (2, s2); | |
176 | ||
177 | return SCM_BOOL_NOT (string_less_p (s2, s1)); | |
0f2d19dd | 178 | } |
6e8d25a6 | 179 | #undef FUNC_NAME |
0f2d19dd | 180 | |
e9bfab50 | 181 | |
c3ee7520 | 182 | SCM_DEFINE1 (scm_string_gr_p, "string>?", scm_tc7_rpsubr, |
6e8d25a6 | 183 | (SCM s1, SCM s2), |
942e5b91 MG |
184 | "Lexicographic ordering predicate; returns @code{#t} if\n" |
185 | "@var{s1} is lexicographically greater than @var{s2}. (r5rs)") | |
6e8d25a6 | 186 | #define FUNC_NAME s_scm_string_gr_p |
0f2d19dd | 187 | { |
3ba5a6c2 DH |
188 | SCM_VALIDATE_STRING (1, s1); |
189 | SCM_VALIDATE_STRING (2, s2); | |
190 | ||
191 | return string_less_p (s2, s1); | |
0f2d19dd | 192 | } |
6e8d25a6 | 193 | #undef FUNC_NAME |
0f2d19dd | 194 | |
e9bfab50 | 195 | |
c3ee7520 | 196 | SCM_DEFINE1 (scm_string_geq_p, "string>=?", scm_tc7_rpsubr, |
6e8d25a6 | 197 | (SCM s1, SCM s2), |
942e5b91 MG |
198 | "Lexicographic ordering predicate; returns @code{#t} if\n" |
199 | "@var{s1} is lexicographically greater than or equal to\n" | |
200 | "@var{s2}. (r5rs)") | |
6e8d25a6 | 201 | #define FUNC_NAME s_scm_string_geq_p |
0f2d19dd | 202 | { |
3ba5a6c2 DH |
203 | SCM_VALIDATE_STRING (1, s1); |
204 | SCM_VALIDATE_STRING (2, s2); | |
205 | ||
206 | return SCM_BOOL_NOT (string_less_p (s1, s2)); | |
0f2d19dd | 207 | } |
6e8d25a6 | 208 | #undef FUNC_NAME |
0f2d19dd | 209 | |
e9bfab50 | 210 | |
3ba5a6c2 DH |
211 | /* Helper function for the case insensitive lexicographic ordering |
212 | * predicates. No argument checking is performed. */ | |
213 | static SCM | |
214 | string_ci_less_p (SCM s1, SCM s2) | |
0f2d19dd | 215 | { |
e9bfab50 DH |
216 | scm_sizet i, length1, length2, lengthm; |
217 | unsigned char *c1, *c2; | |
218 | ||
e9bfab50 DH |
219 | length1 = SCM_STRING_LENGTH (s1); |
220 | length2 = SCM_STRING_LENGTH (s2); | |
221 | lengthm = min (length1, length2); | |
34f0f2b8 DH |
222 | c1 = SCM_STRING_UCHARS (s1); |
223 | c2 = SCM_STRING_UCHARS (s2); | |
e9bfab50 DH |
224 | |
225 | for (i = 0; i != lengthm; ++i, ++c1, ++c2) { | |
226 | int c = scm_upcase (*c1) - scm_upcase (*c2); | |
227 | if (c < 0) return SCM_BOOL_T; | |
228 | if (c > 0) return SCM_BOOL_F; | |
0f2d19dd | 229 | } |
e9bfab50 DH |
230 | |
231 | return SCM_BOOL (length1 < length2); | |
0f2d19dd | 232 | } |
3ba5a6c2 DH |
233 | |
234 | ||
235 | SCM_DEFINE1 (scm_string_ci_less_p, "string-ci<?", scm_tc7_rpsubr, | |
236 | (SCM s1, SCM s2), | |
942e5b91 MG |
237 | "Case insensitive lexicographic ordering predicate;\n" |
238 | "returns @code{#t} if @var{s1} is lexicographically less than\n" | |
3ba5a6c2 DH |
239 | "@var{s2} regardless of case. (r5rs)") |
240 | #define FUNC_NAME s_scm_string_ci_less_p | |
241 | { | |
242 | SCM_VALIDATE_STRING (1, s1); | |
243 | SCM_VALIDATE_STRING (2, s2); | |
244 | ||
245 | return string_ci_less_p (s1, s2); | |
246 | } | |
6e8d25a6 | 247 | #undef FUNC_NAME |
0f2d19dd | 248 | |
e9bfab50 | 249 | |
c3ee7520 | 250 | SCM_DEFINE1 (scm_string_ci_leq_p, "string-ci<=?", scm_tc7_rpsubr, |
6e8d25a6 | 251 | (SCM s1, SCM s2), |
942e5b91 MG |
252 | "Case insensitive lexicographic ordering predicate;\n" |
253 | "returns @code{#t} if @var{s1} is lexicographically less than\n" | |
5ffe9968 | 254 | "or equal to @var{s2} regardless of case. (r5rs)") |
6e8d25a6 | 255 | #define FUNC_NAME s_scm_string_ci_leq_p |
0f2d19dd | 256 | { |
3ba5a6c2 DH |
257 | SCM_VALIDATE_STRING (1, s1); |
258 | SCM_VALIDATE_STRING (2, s2); | |
259 | ||
260 | return SCM_BOOL_NOT (string_ci_less_p (s2, s1)); | |
0f2d19dd | 261 | } |
6e8d25a6 | 262 | #undef FUNC_NAME |
0f2d19dd | 263 | |
e9bfab50 | 264 | |
c3ee7520 | 265 | SCM_DEFINE1 (scm_string_ci_gr_p, "string-ci>?", scm_tc7_rpsubr, |
6e8d25a6 | 266 | (SCM s1, SCM s2), |
942e5b91 MG |
267 | "Case insensitive lexicographic ordering predicate;\n" |
268 | "returns @code{#t} if @var{s1} is lexicographically greater\n" | |
269 | "than @var{s2} regardless of case. (r5rs)") | |
6e8d25a6 | 270 | #define FUNC_NAME s_scm_string_ci_gr_p |
0f2d19dd | 271 | { |
3ba5a6c2 DH |
272 | SCM_VALIDATE_STRING (1, s1); |
273 | SCM_VALIDATE_STRING (2, s2); | |
274 | ||
275 | return string_ci_less_p (s2, s1); | |
0f2d19dd | 276 | } |
6e8d25a6 | 277 | #undef FUNC_NAME |
0f2d19dd | 278 | |
e9bfab50 | 279 | |
c3ee7520 | 280 | SCM_DEFINE1 (scm_string_ci_geq_p, "string-ci>=?", scm_tc7_rpsubr, |
6e8d25a6 | 281 | (SCM s1, SCM s2), |
942e5b91 MG |
282 | "Case insensitive lexicographic ordering predicate;\n" |
283 | "returns @code{#t} if @var{s1} is lexicographically greater\n" | |
284 | "than or equal to @var{s2} regardless of case. (r5rs)") | |
6e8d25a6 | 285 | #define FUNC_NAME s_scm_string_ci_geq_p |
0f2d19dd | 286 | { |
3ba5a6c2 DH |
287 | SCM_VALIDATE_STRING (1, s1); |
288 | SCM_VALIDATE_STRING (2, s2); | |
289 | ||
290 | return SCM_BOOL_NOT (string_ci_less_p (s1, s2)); | |
0f2d19dd | 291 | } |
6e8d25a6 | 292 | #undef FUNC_NAME |
0f2d19dd JB |
293 | |
294 | \f | |
1cc91f1b | 295 | |
0f2d19dd JB |
296 | void |
297 | scm_init_strorder () | |
0f2d19dd | 298 | { |
8dc9439f | 299 | #ifndef SCM_MAGIC_SNARFER |
a0599745 | 300 | #include "libguile/strorder.x" |
8dc9439f | 301 | #endif |
0f2d19dd JB |
302 | } |
303 | ||
89e00824 ML |
304 | |
305 | /* | |
306 | Local Variables: | |
307 | c-file-style: "gnu" | |
308 | End: | |
309 | */ |