Commit | Line | Data |
---|---|---|
f1d19308 | 1 | /* Copyright (C) 1995, 1996, 1999, 2000, 2004, 2006, 2008, 2009, 2010 Free Software Foundation, Inc. |
0f2d19dd | 2 | * |
73be1d9e | 3 | * This library is free software; you can redistribute it and/or |
53befeb7 NJ |
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. | |
0f2d19dd | 7 | * |
53befeb7 NJ |
8 | * This library is distributed in the hope that it will be useful, but |
9 | * WITHOUT ANY WARRANTY; without even the implied warranty of | |
73be1d9e MV |
10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
11 | * Lesser General Public License for more details. | |
0f2d19dd | 12 | * |
73be1d9e MV |
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 | |
53befeb7 NJ |
15 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
16 | * 02110-1301 USA | |
73be1d9e | 17 | */ |
6e8d25a6 | 18 | |
0f2d19dd | 19 | \f |
dbb605f5 LC |
20 | #ifdef HAVE_CONFIG_H |
21 | # include <config.h> | |
22 | #endif | |
0f2d19dd | 23 | |
a0599745 MD |
24 | #include "libguile/_scm.h" |
25 | #include "libguile/chars.h" | |
a002f1a2 DH |
26 | #include "libguile/strings.h" |
27 | #include "libguile/symbols.h" | |
0f2d19dd | 28 | |
a0599745 MD |
29 | #include "libguile/validate.h" |
30 | #include "libguile/strorder.h" | |
2c0b7c1f | 31 | #include "libguile/srfi-13.h" |
0f2d19dd JB |
32 | \f |
33 | ||
2c0b7c1f MV |
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 | ||
f1d19308 | 45 | static SCM scm_i_string_equal_p (SCM s1, SCM s2, SCM rest); |
8a1f4f98 AW |
46 | SCM_DEFINE (scm_i_string_equal_p, "string=?", 0, 2, 1, |
47 | (SCM s1, SCM s2, SCM rest), | |
1e6808ea MG |
48 | "Lexicographic equality predicate; return @code{#t} if the two\n" |
49 | "strings are the same length and contain the same characters in\n" | |
50 | "the same positions, otherwise return @code{#f}.\n" | |
51 | "\n" | |
52 | "The procedure @code{string-ci=?} treats upper and lower case\n" | |
53 | "letters as though they were the same character, but\n" | |
54 | "@code{string=?} treats upper and lower case as distinct\n" | |
55 | "characters.") | |
8a1f4f98 AW |
56 | #define FUNC_NAME s_scm_i_string_equal_p |
57 | { | |
58 | if (SCM_UNBNDP (s1) || SCM_UNBNDP (s2)) | |
59 | return SCM_BOOL_T; | |
60 | while (!scm_is_null (rest)) | |
61 | { | |
62 | if (scm_is_false (srfi13_cmp (s1, s2, scm_string_eq))) | |
63 | return SCM_BOOL_F; | |
64 | s1 = s2; | |
65 | s2 = scm_car (rest); | |
66 | rest = scm_cdr (rest); | |
67 | } | |
68 | return srfi13_cmp (s1, s2, scm_string_eq); | |
69 | } | |
70 | #undef FUNC_NAME | |
71 | ||
72 | SCM scm_string_equal_p (SCM s1, SCM s2) | |
73 | #define FUNC_NAME s_scm_i_string_equal_p | |
0f2d19dd | 74 | { |
2c0b7c1f | 75 | return srfi13_cmp (s1, s2, scm_string_eq); |
0f2d19dd | 76 | } |
6e8d25a6 | 77 | #undef FUNC_NAME |
0f2d19dd | 78 | |
f1d19308 | 79 | static SCM scm_i_string_ci_equal_p (SCM s1, SCM s2, SCM rest); |
8a1f4f98 AW |
80 | SCM_DEFINE (scm_i_string_ci_equal_p, "string-ci=?", 0, 2, 1, |
81 | (SCM s1, SCM s2, SCM rest), | |
1e6808ea MG |
82 | "Case-insensitive string equality predicate; return @code{#t} if\n" |
83 | "the two strings are the same length and their component\n" | |
84 | "characters match (ignoring case) at each position; otherwise\n" | |
85 | "return @code{#f}.") | |
8a1f4f98 | 86 | #define FUNC_NAME s_scm_i_string_ci_equal_p |
0f2d19dd | 87 | { |
8a1f4f98 AW |
88 | if (SCM_UNBNDP (s1) || SCM_UNBNDP (s2)) |
89 | return SCM_BOOL_T; | |
90 | while (!scm_is_null (rest)) | |
91 | { | |
92 | if (scm_is_false (srfi13_cmp (s1, s2, scm_string_ci_eq))) | |
93 | return SCM_BOOL_F; | |
94 | s1 = s2; | |
95 | s2 = scm_car (rest); | |
96 | rest = scm_cdr (rest); | |
97 | } | |
2c0b7c1f | 98 | return srfi13_cmp (s1, s2, scm_string_ci_eq); |
0f2d19dd | 99 | } |
6e8d25a6 | 100 | #undef FUNC_NAME |
0f2d19dd | 101 | |
8a1f4f98 AW |
102 | SCM scm_string_ci_equal_p (SCM s1, SCM s2) |
103 | #define FUNC_NAME s_scm_i_string_ci_equal_p | |
104 | { | |
105 | return srfi13_cmp (s1, s2, scm_string_ci_eq); | |
106 | } | |
107 | #undef FUNC_NAME | |
108 | ||
f1d19308 | 109 | static SCM scm_i_string_less_p (SCM s1, SCM s2, SCM rest); |
8a1f4f98 AW |
110 | SCM_DEFINE (scm_i_string_less_p, "string<?", 0, 2, 1, |
111 | (SCM s1, SCM s2, SCM rest), | |
1e6808ea MG |
112 | "Lexicographic ordering predicate; return @code{#t} if @var{s1}\n" |
113 | "is lexicographically less than @var{s2}.") | |
8a1f4f98 AW |
114 | #define FUNC_NAME s_scm_i_string_less_p |
115 | { | |
116 | if (SCM_UNBNDP (s1) || SCM_UNBNDP (s2)) | |
117 | return SCM_BOOL_T; | |
118 | while (!scm_is_null (rest)) | |
119 | { | |
120 | if (scm_is_false (srfi13_cmp (s1, s2, scm_string_lt))) | |
121 | return SCM_BOOL_F; | |
122 | s1 = s2; | |
123 | s2 = scm_car (rest); | |
124 | rest = scm_cdr (rest); | |
125 | } | |
126 | return srfi13_cmp (s1, s2, scm_string_lt); | |
127 | } | |
128 | #undef FUNC_NAME | |
129 | ||
130 | SCM scm_string_less_p (SCM s1, SCM s2) | |
131 | #define FUNC_NAME s_scm_i_string_less_p | |
3ba5a6c2 | 132 | { |
2c0b7c1f | 133 | return srfi13_cmp (s1, s2, scm_string_lt); |
3ba5a6c2 | 134 | } |
6e8d25a6 | 135 | #undef FUNC_NAME |
0f2d19dd | 136 | |
f1d19308 | 137 | static SCM scm_i_string_leq_p (SCM s1, SCM s2, SCM rest); |
8a1f4f98 AW |
138 | SCM_DEFINE (scm_i_string_leq_p, "string<=?", 0, 2, 1, |
139 | (SCM s1, SCM s2, SCM rest), | |
1e6808ea MG |
140 | "Lexicographic ordering predicate; return @code{#t} if @var{s1}\n" |
141 | "is lexicographically less than or equal to @var{s2}.") | |
8a1f4f98 | 142 | #define FUNC_NAME s_scm_i_string_leq_p |
0f2d19dd | 143 | { |
8a1f4f98 AW |
144 | if (SCM_UNBNDP (s1) || SCM_UNBNDP (s2)) |
145 | return SCM_BOOL_T; | |
146 | while (!scm_is_null (rest)) | |
147 | { | |
148 | if (scm_is_false (srfi13_cmp (s1, s2, scm_string_le))) | |
149 | return SCM_BOOL_F; | |
150 | s1 = s2; | |
151 | s2 = scm_car (rest); | |
152 | rest = scm_cdr (rest); | |
153 | } | |
2c0b7c1f | 154 | return srfi13_cmp (s1, s2, scm_string_le); |
0f2d19dd | 155 | } |
6e8d25a6 | 156 | #undef FUNC_NAME |
0f2d19dd | 157 | |
8a1f4f98 AW |
158 | SCM scm_string_leq_p (SCM s1, SCM s2) |
159 | #define FUNC_NAME s_scm_i_string_leq_p | |
160 | { | |
161 | return srfi13_cmp (s1, s2, scm_string_le); | |
162 | } | |
163 | #undef FUNC_NAME | |
164 | ||
f1d19308 | 165 | static SCM scm_i_string_gr_p (SCM s1, SCM s2, SCM rest); |
8a1f4f98 AW |
166 | SCM_DEFINE (scm_i_string_gr_p, "string>?", 0, 2, 1, |
167 | (SCM s1, SCM s2, SCM rest), | |
1e6808ea MG |
168 | "Lexicographic ordering predicate; return @code{#t} if @var{s1}\n" |
169 | "is lexicographically greater than @var{s2}.") | |
8a1f4f98 AW |
170 | #define FUNC_NAME s_scm_i_string_gr_p |
171 | { | |
172 | if (SCM_UNBNDP (s1) || SCM_UNBNDP (s2)) | |
173 | return SCM_BOOL_T; | |
174 | while (!scm_is_null (rest)) | |
175 | { | |
176 | if (scm_is_false (srfi13_cmp (s1, s2, scm_string_gt))) | |
177 | return SCM_BOOL_F; | |
178 | s1 = s2; | |
179 | s2 = scm_car (rest); | |
180 | rest = scm_cdr (rest); | |
181 | } | |
182 | return srfi13_cmp (s1, s2, scm_string_gt); | |
183 | } | |
184 | #undef FUNC_NAME | |
185 | ||
186 | SCM scm_string_gr_p (SCM s1, SCM s2) | |
187 | #define FUNC_NAME s_scm_i_string_gr_p | |
0f2d19dd | 188 | { |
2c0b7c1f | 189 | return srfi13_cmp (s1, s2, scm_string_gt); |
0f2d19dd | 190 | } |
6e8d25a6 | 191 | #undef FUNC_NAME |
0f2d19dd | 192 | |
f1d19308 | 193 | static SCM scm_i_string_geq_p (SCM s1, SCM s2, SCM rest); |
8a1f4f98 AW |
194 | SCM_DEFINE (scm_i_string_geq_p, "string>=?", 0, 2, 1, |
195 | (SCM s1, SCM s2, SCM rest), | |
1e6808ea MG |
196 | "Lexicographic ordering predicate; return @code{#t} if @var{s1}\n" |
197 | "is lexicographically greater than or equal to @var{s2}.") | |
8a1f4f98 AW |
198 | #define FUNC_NAME s_scm_i_string_geq_p |
199 | { | |
200 | if (SCM_UNBNDP (s1) || SCM_UNBNDP (s2)) | |
201 | return SCM_BOOL_T; | |
202 | while (!scm_is_null (rest)) | |
203 | { | |
204 | if (scm_is_false (srfi13_cmp (s1, s2, scm_string_ge))) | |
205 | return SCM_BOOL_F; | |
206 | s1 = s2; | |
207 | s2 = scm_car (rest); | |
208 | rest = scm_cdr (rest); | |
209 | } | |
210 | return srfi13_cmp (s1, s2, scm_string_ge); | |
211 | } | |
212 | #undef FUNC_NAME | |
213 | ||
214 | SCM scm_string_geq_p (SCM s1, SCM s2) | |
215 | #define FUNC_NAME s_scm_i_string_geq_p | |
0f2d19dd | 216 | { |
2c0b7c1f | 217 | return srfi13_cmp (s1, s2, scm_string_ge); |
0f2d19dd | 218 | } |
6e8d25a6 | 219 | #undef FUNC_NAME |
0f2d19dd | 220 | |
f1d19308 | 221 | static SCM scm_i_string_ci_less_p (SCM s1, SCM s2, SCM rest); |
8a1f4f98 AW |
222 | SCM_DEFINE (scm_i_string_ci_less_p, "string-ci<?", 0, 2, 1, |
223 | (SCM s1, SCM s2, SCM rest), | |
1e6808ea MG |
224 | "Case insensitive lexicographic ordering predicate; return\n" |
225 | "@code{#t} if @var{s1} is lexicographically less than @var{s2}\n" | |
226 | "regardless of case.") | |
8a1f4f98 | 227 | #define FUNC_NAME s_scm_i_string_ci_less_p |
3ba5a6c2 | 228 | { |
8a1f4f98 AW |
229 | if (SCM_UNBNDP (s1) || SCM_UNBNDP (s2)) |
230 | return SCM_BOOL_T; | |
231 | while (!scm_is_null (rest)) | |
232 | { | |
233 | if (scm_is_false (srfi13_cmp (s1, s2, scm_string_ci_lt))) | |
234 | return SCM_BOOL_F; | |
235 | s1 = s2; | |
236 | s2 = scm_car (rest); | |
237 | rest = scm_cdr (rest); | |
238 | } | |
2c0b7c1f | 239 | return srfi13_cmp (s1, s2, scm_string_ci_lt); |
3ba5a6c2 | 240 | } |
6e8d25a6 | 241 | #undef FUNC_NAME |
0f2d19dd | 242 | |
8a1f4f98 AW |
243 | SCM scm_string_ci_less_p (SCM s1, SCM s2) |
244 | #define FUNC_NAME s_scm_i_string_ci_less_p | |
245 | { | |
246 | return srfi13_cmp (s1, s2, scm_string_ci_lt); | |
247 | } | |
248 | #undef FUNC_NAME | |
249 | ||
f1d19308 | 250 | static SCM scm_i_string_ci_leq_p (SCM s1, SCM s2, SCM rest); |
8a1f4f98 AW |
251 | SCM_DEFINE (scm_i_string_ci_leq_p, "string-ci<=?", 0, 2, 1, |
252 | (SCM s1, SCM s2, SCM rest), | |
1e6808ea MG |
253 | "Case insensitive lexicographic ordering predicate; return\n" |
254 | "@code{#t} if @var{s1} is lexicographically less than or equal\n" | |
255 | "to @var{s2} regardless of case.") | |
8a1f4f98 AW |
256 | #define FUNC_NAME s_scm_i_string_ci_leq_p |
257 | { | |
258 | if (SCM_UNBNDP (s1) || SCM_UNBNDP (s2)) | |
259 | return SCM_BOOL_T; | |
260 | while (!scm_is_null (rest)) | |
261 | { | |
262 | if (scm_is_false (srfi13_cmp (s1, s2, scm_string_ci_le))) | |
263 | return SCM_BOOL_F; | |
264 | s1 = s2; | |
265 | s2 = scm_car (rest); | |
266 | rest = scm_cdr (rest); | |
267 | } | |
268 | return srfi13_cmp (s1, s2, scm_string_ci_le); | |
269 | } | |
270 | #undef FUNC_NAME | |
271 | ||
272 | SCM scm_string_ci_leq_p (SCM s1, SCM s2) | |
273 | #define FUNC_NAME s_scm_i_string_ci_leq_p | |
0f2d19dd | 274 | { |
2c0b7c1f | 275 | return srfi13_cmp (s1, s2, scm_string_ci_le); |
0f2d19dd | 276 | } |
6e8d25a6 | 277 | #undef FUNC_NAME |
0f2d19dd | 278 | |
f1d19308 | 279 | static SCM scm_i_string_ci_gr_p (SCM s1, SCM s2, SCM rest); |
8a1f4f98 AW |
280 | SCM_DEFINE (scm_i_string_ci_gr_p, "string-ci>?", 0, 2, 1, |
281 | (SCM s1, SCM s2, SCM rest), | |
1e6808ea MG |
282 | "Case insensitive lexicographic ordering predicate; return\n" |
283 | "@code{#t} if @var{s1} is lexicographically greater than\n" | |
284 | "@var{s2} regardless of case.") | |
8a1f4f98 | 285 | #define FUNC_NAME s_scm_i_string_ci_gr_p |
0f2d19dd | 286 | { |
8a1f4f98 AW |
287 | if (SCM_UNBNDP (s1) || SCM_UNBNDP (s2)) |
288 | return SCM_BOOL_T; | |
289 | while (!scm_is_null (rest)) | |
290 | { | |
291 | if (scm_is_false (srfi13_cmp (s1, s2, scm_string_ci_gt))) | |
292 | return SCM_BOOL_F; | |
293 | s1 = s2; | |
294 | s2 = scm_car (rest); | |
295 | rest = scm_cdr (rest); | |
296 | } | |
2c0b7c1f | 297 | return srfi13_cmp (s1, s2, scm_string_ci_gt); |
0f2d19dd | 298 | } |
6e8d25a6 | 299 | #undef FUNC_NAME |
0f2d19dd | 300 | |
8a1f4f98 AW |
301 | SCM scm_string_ci_gr_p (SCM s1, SCM s2) |
302 | #define FUNC_NAME s_scm_i_string_ci_gr_p | |
303 | { | |
304 | return srfi13_cmp (s1, s2, scm_string_ci_gt); | |
305 | } | |
306 | #undef FUNC_NAME | |
307 | ||
f1d19308 | 308 | static SCM scm_i_string_ci_geq_p (SCM s1, SCM s2, SCM rest); |
8a1f4f98 AW |
309 | SCM_DEFINE (scm_i_string_ci_geq_p, "string-ci>=?", 0, 2, 1, |
310 | (SCM s1, SCM s2, SCM rest), | |
1e6808ea MG |
311 | "Case insensitive lexicographic ordering predicate; return\n" |
312 | "@code{#t} if @var{s1} is lexicographically greater than or\n" | |
313 | "equal to @var{s2} regardless of case.") | |
8a1f4f98 AW |
314 | #define FUNC_NAME s_scm_i_string_ci_geq_p |
315 | { | |
316 | if (SCM_UNBNDP (s1) || SCM_UNBNDP (s2)) | |
317 | return SCM_BOOL_T; | |
318 | while (!scm_is_null (rest)) | |
319 | { | |
320 | if (scm_is_false (srfi13_cmp (s1, s2, scm_string_ci_ge))) | |
321 | return SCM_BOOL_F; | |
322 | s1 = s2; | |
323 | s2 = scm_car (rest); | |
324 | rest = scm_cdr (rest); | |
325 | } | |
326 | return srfi13_cmp (s1, s2, scm_string_ci_ge); | |
327 | } | |
328 | #undef FUNC_NAME | |
329 | ||
330 | SCM scm_string_ci_geq_p (SCM s1, SCM s2) | |
331 | #define FUNC_NAME s_scm_i_string_ci_geq_p | |
0f2d19dd | 332 | { |
2c0b7c1f | 333 | return srfi13_cmp (s1, s2, scm_string_ci_ge); |
0f2d19dd | 334 | } |
6e8d25a6 | 335 | #undef FUNC_NAME |
0f2d19dd JB |
336 | |
337 | \f | |
1cc91f1b | 338 | |
0f2d19dd JB |
339 | void |
340 | scm_init_strorder () | |
0f2d19dd | 341 | { |
a0599745 | 342 | #include "libguile/strorder.x" |
0f2d19dd JB |
343 | } |
344 | ||
89e00824 ML |
345 | |
346 | /* | |
347 | Local Variables: | |
348 | c-file-style: "gnu" | |
349 | End: | |
350 | */ |