Commit | Line | Data |
---|---|---|
78a0461a | 1 | /* Copyright (C) 1995, 1996, 1999 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 | ||
46 | #include <stdio.h> | |
47 | #include "_scm.h" | |
20e6290e | 48 | #include "chars.h" |
0f2d19dd | 49 | |
b6791b2e | 50 | #include "validate.h" |
20e6290e | 51 | #include "strorder.h" |
0f2d19dd JB |
52 | \f |
53 | ||
c3ee7520 | 54 | SCM_DEFINE1 (scm_string_equal_p, "string=?", scm_tc7_rpsubr, |
6e8d25a6 | 55 | (SCM s1, SCM s2), |
5ffe9968 GB |
56 | "Lexicographic equality predicate; \n" |
57 | "Returns @t{#t} if the two strings are the same length and contain the same\n" | |
58 | "characters in the same positions, otherwise returns @t{#f}. (r5rs)\n\n" | |
59 | "@samp{String-ci=?} treats\n" | |
60 | "upper and lower case letters as though they were the same character, but\n" | |
61 | "@samp{string=?} treats upper and lower case as distinct characters.") | |
6e8d25a6 | 62 | #define FUNC_NAME s_scm_string_equal_p |
0f2d19dd JB |
63 | { |
64 | register scm_sizet i; | |
dbe26481 | 65 | register unsigned char *c1, *c2; |
3b3b36dd GB |
66 | SCM_VALIDATE_ROSTRING (1,s1); |
67 | SCM_VALIDATE_ROSTRING (2,s2); | |
0f2d19dd JB |
68 | |
69 | i = SCM_ROLENGTH (s2); | |
70 | if (SCM_ROLENGTH (s1) != i) | |
71 | { | |
72 | return SCM_BOOL_F; | |
73 | } | |
dbe26481 MD |
74 | c1 = SCM_ROUCHARS (s1); |
75 | c2 = SCM_ROUCHARS (s2); | |
0f2d19dd JB |
76 | while (0 != i--) |
77 | if (*c1++ != *c2++) | |
78 | return SCM_BOOL_F; | |
79 | return SCM_BOOL_T; | |
80 | } | |
6e8d25a6 | 81 | #undef FUNC_NAME |
0f2d19dd | 82 | |
c3ee7520 | 83 | SCM_DEFINE1 (scm_string_ci_equal_p, "string-ci=?", scm_tc7_rpsubr, |
6e8d25a6 | 84 | (SCM s1, SCM s2), |
5ffe9968 GB |
85 | "Case-insensitive string equality predicate; returns @t{#t} if\n" |
86 | "the two strings are the same length and their component characters\n" | |
87 | "match (ignoring case) at each position; otherwise returns @t{#f}. (r5rs)") | |
6e8d25a6 | 88 | #define FUNC_NAME s_scm_string_ci_equal_p |
0f2d19dd JB |
89 | { |
90 | register scm_sizet i; | |
91 | register unsigned char *c1, *c2; | |
3b3b36dd GB |
92 | SCM_VALIDATE_ROSTRING (1,s1); |
93 | SCM_VALIDATE_ROSTRING (2,s2); | |
6e8d25a6 | 94 | |
0f2d19dd JB |
95 | i = SCM_ROLENGTH (s2); |
96 | if (SCM_ROLENGTH (s1) != i) | |
97 | { | |
98 | return SCM_BOOL_F; | |
99 | } | |
100 | c1 = SCM_ROUCHARS (s1); | |
101 | c2 = SCM_ROUCHARS (s2); | |
102 | while (0 != i--) | |
103 | if (scm_upcase(*c1++) != scm_upcase(*c2++)) | |
104 | return SCM_BOOL_F; | |
105 | return SCM_BOOL_T; | |
106 | } | |
6e8d25a6 | 107 | #undef FUNC_NAME |
0f2d19dd | 108 | |
c3ee7520 | 109 | SCM_DEFINE1 (scm_string_less_p, "string<?", scm_tc7_rpsubr, |
6e8d25a6 | 110 | (SCM s1, SCM s2), |
5ffe9968 GB |
111 | "Lexicographic ordering predicate; returns @t{#t} if @var{s1}\n" |
112 | "is lexicographically less than @var{s2}. (r5rs)") | |
6e8d25a6 | 113 | #define FUNC_NAME s_scm_string_less_p |
0f2d19dd JB |
114 | { |
115 | register scm_sizet i, len, s2len; | |
116 | register unsigned char *c1, *c2; | |
117 | register int c; | |
118 | ||
3b3b36dd GB |
119 | SCM_VALIDATE_ROSTRING (1,s1); |
120 | SCM_VALIDATE_ROSTRING (2,s2); | |
0f2d19dd | 121 | len = SCM_ROLENGTH (s1); |
dd054d41 MD |
122 | s2len = SCM_ROLENGTH (s2); |
123 | if (len>s2len) len = s2len; | |
0f2d19dd JB |
124 | c1 = SCM_ROUCHARS (s1); |
125 | c2 = SCM_ROUCHARS (s2); | |
126 | ||
127 | for (i = 0;i<len;i++) { | |
128 | c = (*c1++ - *c2++); | |
129 | if (c>0) | |
130 | return SCM_BOOL_F; | |
131 | if (c<0) | |
132 | return SCM_BOOL_T; | |
133 | } | |
134 | { | |
135 | SCM answer; | |
156dcb09 | 136 | answer = SCM_BOOL(s2len != len); |
0f2d19dd JB |
137 | return answer; |
138 | } | |
139 | } | |
6e8d25a6 | 140 | #undef FUNC_NAME |
0f2d19dd | 141 | |
c3ee7520 | 142 | SCM_DEFINE1 (scm_string_leq_p, "string<=?", scm_tc7_rpsubr, |
6e8d25a6 | 143 | (SCM s1, SCM s2), |
5ffe9968 GB |
144 | "Lexicographic ordering predicate; returns @t{#t} if @var{s1}\n" |
145 | "is lexicographically less than or equal to @var{s2}. (r5rs)") | |
6e8d25a6 | 146 | #define FUNC_NAME s_scm_string_leq_p |
0f2d19dd JB |
147 | { |
148 | return SCM_BOOL_NOT (scm_string_less_p (s2, s1)); | |
149 | } | |
6e8d25a6 | 150 | #undef FUNC_NAME |
0f2d19dd | 151 | |
c3ee7520 | 152 | SCM_DEFINE1 (scm_string_gr_p, "string>?", scm_tc7_rpsubr, |
6e8d25a6 | 153 | (SCM s1, SCM s2), |
5ffe9968 GB |
154 | "Lexicographic ordering predicate; returns @t{#t} if @var{s1}\n" |
155 | "is lexicographically greater than @var{s2}. (r5rs)") | |
6e8d25a6 | 156 | #define FUNC_NAME s_scm_string_gr_p |
0f2d19dd JB |
157 | { |
158 | return scm_string_less_p (s2, s1); | |
159 | } | |
6e8d25a6 | 160 | #undef FUNC_NAME |
0f2d19dd | 161 | |
c3ee7520 | 162 | SCM_DEFINE1 (scm_string_geq_p, "string>=?", scm_tc7_rpsubr, |
6e8d25a6 | 163 | (SCM s1, SCM s2), |
5ffe9968 GB |
164 | "Lexicographic ordering predicate; returns @t{#t} if @var{s1}\n" |
165 | "is lexicographically greater than or equal to @var{s2}. (r5rs)") | |
6e8d25a6 | 166 | #define FUNC_NAME s_scm_string_geq_p |
0f2d19dd JB |
167 | { |
168 | return SCM_BOOL_NOT (scm_string_less_p (s1, s2)); | |
169 | } | |
6e8d25a6 | 170 | #undef FUNC_NAME |
0f2d19dd | 171 | |
c3ee7520 | 172 | SCM_DEFINE1 (scm_string_ci_less_p, "string-ci<?", scm_tc7_rpsubr, |
6e8d25a6 | 173 | (SCM s1, SCM s2), |
5ffe9968 GB |
174 | "Case insensitive lexicographic ordering predicate; \n" |
175 | "returns @t{#t} if @var{s1} is lexicographically less than\n" | |
176 | "@var{s2} regardless of case. (r5rs)") | |
6e8d25a6 | 177 | #define FUNC_NAME s_scm_string_ci_less_p |
0f2d19dd JB |
178 | { |
179 | register scm_sizet i, len, s2len; | |
180 | register unsigned char *c1, *c2; | |
181 | register int c; | |
3b3b36dd GB |
182 | SCM_VALIDATE_ROSTRING (1,s1); |
183 | SCM_VALIDATE_ROSTRING (2,s2); | |
0f2d19dd | 184 | len = SCM_ROLENGTH (s1); |
dd054d41 MD |
185 | s2len = SCM_ROLENGTH (s2); |
186 | if (len>s2len) len = s2len; | |
0f2d19dd JB |
187 | c1 = SCM_ROUCHARS (s1); |
188 | c2 = SCM_ROUCHARS (s2); | |
189 | for (i = 0;i<len;i++) { | |
190 | c = (scm_upcase(*c1++) - scm_upcase(*c2++)); | |
191 | if (c>0) return SCM_BOOL_F; | |
192 | if (c<0) return SCM_BOOL_T; | |
193 | } | |
156dcb09 | 194 | return SCM_BOOL(s2len != len); |
0f2d19dd | 195 | } |
6e8d25a6 | 196 | #undef FUNC_NAME |
0f2d19dd | 197 | |
c3ee7520 | 198 | SCM_DEFINE1 (scm_string_ci_leq_p, "string-ci<=?", scm_tc7_rpsubr, |
6e8d25a6 | 199 | (SCM s1, SCM s2), |
5ffe9968 GB |
200 | "Case insensitive lexicographic ordering predicate; \n" |
201 | "returns @t{#t} if @var{s1} is lexicographically less than\n" | |
202 | "or equal to @var{s2} regardless of case. (r5rs)") | |
6e8d25a6 | 203 | #define FUNC_NAME s_scm_string_ci_leq_p |
0f2d19dd JB |
204 | { |
205 | return SCM_BOOL_NOT (scm_string_ci_less_p (s2, s1)); | |
206 | } | |
6e8d25a6 | 207 | #undef FUNC_NAME |
0f2d19dd | 208 | |
c3ee7520 | 209 | SCM_DEFINE1 (scm_string_ci_gr_p, "string-ci>?", scm_tc7_rpsubr, |
6e8d25a6 | 210 | (SCM s1, SCM s2), |
5ffe9968 GB |
211 | "Case insensitive lexicographic ordering predicate; \n" |
212 | "returns @t{#t} if @var{s1} is lexicographically greater than\n" | |
213 | "@var{s2} regardless of case. (r5rs)") | |
6e8d25a6 | 214 | #define FUNC_NAME s_scm_string_ci_gr_p |
0f2d19dd JB |
215 | { |
216 | return scm_string_ci_less_p (s2, s1); | |
217 | } | |
6e8d25a6 | 218 | #undef FUNC_NAME |
0f2d19dd | 219 | |
c3ee7520 | 220 | SCM_DEFINE1 (scm_string_ci_geq_p, "string-ci>=?", scm_tc7_rpsubr, |
6e8d25a6 | 221 | (SCM s1, SCM s2), |
5ffe9968 GB |
222 | "Case insensitive lexicographic ordering predicate; \n" |
223 | "returns @t{#t} if @var{s1} is lexicographically greater than\n" | |
224 | "or equal to @var{s2} regardless of case. (r5rs)") | |
6e8d25a6 | 225 | #define FUNC_NAME s_scm_string_ci_geq_p |
0f2d19dd JB |
226 | { |
227 | return SCM_BOOL_NOT (scm_string_ci_less_p (s1, s2)); | |
228 | } | |
6e8d25a6 | 229 | #undef FUNC_NAME |
0f2d19dd JB |
230 | |
231 | \f | |
1cc91f1b | 232 | |
0f2d19dd JB |
233 | void |
234 | scm_init_strorder () | |
0f2d19dd JB |
235 | { |
236 | #include "strorder.x" | |
237 | } | |
238 |