source: branches/0.17.x/abcl/src/org/armedbear/lisp/CharacterFunctions.java

Last change on this file was 12254, checked in by ehuelsmann, 16 years ago

Remove 'throws ConditionThrowable?' method annotations:

it's an unchecked exception now, so no need to declare it thrown.
  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 12.0 KB
Line 
1/*
2 * CharacterFunctions.java
3 *
4 * Copyright (C) 2003-2006 Peter Graves
5 * $Id: CharacterFunctions.java 12254 2009-11-06 20:07:54Z ehuelsmann $
6 *
7 * This program is free software; you can redistribute it and/or
8 * modify it under the terms of the GNU General Public License
9 * as published by the Free Software Foundation; either version 2
10 * of the License, or (at your option) any later version.
11 *
12 * This program is distributed in the hope that it will be useful,
13 * but WITHOUT ANY WARRANTY; without even the implied warranty of
14 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15 * GNU General Public License for more details.
16 *
17 * You should have received a copy of the GNU General Public License
18 * along with this program; if not, write to the Free Software
19 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
20 *
21 * As a special exception, the copyright holders of this library give you
22 * permission to link this library with independent modules to produce an
23 * executable, regardless of the license terms of these independent
24 * modules, and to copy and distribute the resulting executable under
25 * terms of your choice, provided that you also meet, for each linked
26 * independent module, the terms and conditions of the license of that
27 * module.  An independent module is a module which is not derived from
28 * or based on this library.  If you modify this library, you may extend
29 * this exception to your version of the library, but you are not
30 * obligated to do so.  If you do not wish to do so, delete this
31 * exception statement from your version.
32 */
33
34package org.armedbear.lisp;
35
36public final class CharacterFunctions extends Lisp
37{
38    // ### char=
39    private static final Primitive CHAR_EQUALS =
40        new Primitive("char=", "&rest characters")
41    {
42        @Override
43        public LispObject execute()
44        {
45            return error(new WrongNumberOfArgumentsException(this));
46        }
47        @Override
48        public LispObject execute(LispObject arg)
49        {
50            if (arg instanceof LispCharacter)
51                return T;
52            return type_error(arg, Symbol.CHARACTER);
53        }
54        @Override
55        public LispObject execute(LispObject first, LispObject second)
56
57        {
58            return LispCharacter.getValue(first) == LispCharacter.getValue(second) ? T : NIL;
59        }
60        @Override
61        public LispObject execute(LispObject[] array)
62        {
63            final int length = array.length;
64            final char c0 = LispCharacter.getValue(array[0]);
65            for (int i = 1; i < length; i++) {
66                if (c0 != LispCharacter.getValue(array[i]))
67                    return NIL;
68            }
69            return T;
70        }
71    };
72
73    // ### char-equal
74    private static final Primitive CHAR_EQUAL =
75        new Primitive("char-equal", "&rest characters")
76    {
77        @Override
78        public LispObject execute()
79        {
80            return error(new WrongNumberOfArgumentsException(this));
81        }
82        @Override
83        public LispObject execute(LispObject arg)
84        {
85            if (arg instanceof LispCharacter)
86                return T;
87            return type_error(arg, Symbol.CHARACTER);
88        }
89        @Override
90        public LispObject execute(LispObject first, LispObject second)
91
92        {
93            final char c1, c2;
94            c1 = LispCharacter.getValue(first);
95            c2 = LispCharacter.getValue(second);
96            if (c1 == c2)
97                return T;
98            if (LispCharacter.toUpperCase(c1) == LispCharacter.toUpperCase(c2))
99                return T;
100            if (LispCharacter.toLowerCase(c1) == LispCharacter.toLowerCase(c2))
101                return T;
102            return NIL;
103        }
104        @Override
105        public LispObject execute(LispObject[] array)
106        {
107            final int length = array.length;
108            final char c0 = LispCharacter.getValue(array[0]);
109            for (int i = 1; i < length; i++) {
110                char c = LispCharacter.getValue(array[i]);
111                if (c0 == c)
112                    continue;
113                if (LispCharacter.toUpperCase(c0) == LispCharacter.toUpperCase(c))
114                    continue;
115                if (LispCharacter.toLowerCase(c0) == LispCharacter.toLowerCase(c))
116                    continue;
117                return NIL;
118            }
119            return T;
120        }
121    };
122
123    // ### char-greaterp
124    private static final Primitive CHAR_GREATERP =
125        new Primitive("char-greaterp", "&rest characters")
126    {
127        @Override
128        public LispObject execute()
129        {
130            return error(new WrongNumberOfArgumentsException(this));
131        }
132        @Override
133        public LispObject execute(LispObject arg)
134        {
135            if (arg instanceof LispCharacter)
136                return T;
137            return type_error(arg, Symbol.CHARACTER);
138        }
139        @Override
140        public LispObject execute(LispObject first, LispObject second)
141
142        {
143            char c1 = LispCharacter.toUpperCase(LispCharacter.getValue(first));
144            char c2 = LispCharacter.toUpperCase(LispCharacter.getValue(second));
145            return c1 > c2 ? T : NIL;
146        }
147        @Override
148        public LispObject execute(LispObject[] array)
149        {
150            final int length = array.length;
151            char[] chars = new char[length];
152            for (int i = 0; i < length; i++)
153                chars[i] = LispCharacter.toUpperCase(LispCharacter.getValue(array[i]));
154            for (int i = 1; i < length; i++) {
155                if (chars[i-1] <= chars[i])
156                    return NIL;
157            }
158            return T;
159        }
160    };
161
162    // ### char-not-greaterp
163    private static final Primitive CHAR_NOT_GREATERP =
164        new Primitive("char-not-greaterp", "&rest characters")
165    {
166        @Override
167        public LispObject execute()
168        {
169            return error(new WrongNumberOfArgumentsException(this));
170        }
171        @Override
172        public LispObject execute(LispObject arg)
173        {
174            if (arg instanceof LispCharacter)
175                return T;
176            return type_error(arg, Symbol.CHARACTER);
177        }
178        @Override
179        public LispObject execute(LispObject first, LispObject second)
180
181        {
182            char c1 = LispCharacter.toUpperCase(LispCharacter.getValue(first));
183            char c2 = LispCharacter.toUpperCase(LispCharacter.getValue(second));
184            return c1 <= c2 ? T : NIL;
185        }
186        @Override
187        public LispObject execute(LispObject[] array)
188        {
189            final int length = array.length;
190            char[] chars = new char[length];
191            for (int i = 0; i < length; i++)
192                chars[i] = LispCharacter.toUpperCase(LispCharacter.getValue(array[i]));
193            for (int i = 1; i < length; i++) {
194                if (chars[i] < chars[i-1])
195                    return NIL;
196            }
197            return T;
198        }
199    };
200
201    // ### char<
202    private static final Primitive CHAR_LESS_THAN =
203        new Primitive("char<", "&rest characters")
204    {
205        @Override
206        public LispObject execute()
207        {
208            return error(new WrongNumberOfArgumentsException(this));
209        }
210        @Override
211        public LispObject execute(LispObject arg)
212        {
213            if (arg instanceof LispCharacter)
214                return T;
215            return type_error(arg, Symbol.CHARACTER);
216        }
217        @Override
218        public LispObject execute(LispObject first, LispObject second)
219
220        {
221            return LispCharacter.getValue(first) < LispCharacter.getValue(second) ? T : NIL;
222       }
223        @Override
224        public LispObject execute(LispObject[] args)
225        {
226            final int length = args.length;
227            char[] chars = new char[length];
228            for (int i = 0; i < length; i++) {
229                chars[i] = LispCharacter.getValue(args[i]);
230            }
231            for (int i = 1; i < length; i++) {
232                if (chars[i-1] >= chars[i])
233                    return NIL;
234            }
235            return T;
236        }
237    };
238
239    // ### char<=
240    private static final Primitive CHAR_LE =
241        new Primitive("char<=", "&rest characters")
242    {
243        @Override
244        public LispObject execute()
245        {
246            return error(new WrongNumberOfArgumentsException(this));
247        }
248        @Override
249        public LispObject execute(LispObject arg)
250        {
251            if (arg instanceof LispCharacter)
252                return T;
253            return type_error(arg, Symbol.CHARACTER);
254        }
255        @Override
256        public LispObject execute(LispObject first, LispObject second)
257
258        {
259            return LispCharacter.getValue(first) <= LispCharacter.getValue(second) ? T : NIL;
260        }
261        @Override
262        public LispObject execute(LispObject first, LispObject second,
263                                  LispObject third)
264
265        {
266            if (LispCharacter.getValue(first) > LispCharacter.getValue(second))
267                return NIL;
268            if (LispCharacter.getValue(second) > LispCharacter.getValue(third))
269                return NIL;
270            return T;
271        }
272        @Override
273        public LispObject execute(LispObject[] args)
274        {
275            final int length = args.length;
276            char[] chars = new char[length];
277            for (int i = 0; i < length; i++) {
278                chars[i] = LispCharacter.getValue(args[i]);
279            }
280            for (int i = 1; i < length; i++) {
281                if (chars[i-1] > chars[i])
282                    return NIL;
283            }
284            return T;
285        }
286    };
287
288    // ### char-lessp
289    private static final Primitive CHAR_LESSP =
290        new Primitive("char-lessp", "&rest characters")
291    {
292        @Override
293        public LispObject execute()
294        {
295            return error(new WrongNumberOfArgumentsException(this));
296        }
297        @Override
298        public LispObject execute(LispObject arg)
299        {
300            if (arg instanceof LispCharacter)
301                return T;
302            return type_error(arg, Symbol.CHARACTER);
303        }
304        @Override
305        public LispObject execute(LispObject first, LispObject second)
306
307        {
308            char c1 = LispCharacter.toUpperCase(LispCharacter.getValue(first));
309            char c2 = LispCharacter.toUpperCase(LispCharacter.getValue(second));
310            return c1 < c2 ? T : NIL;
311        }
312        @Override
313        public LispObject execute(LispObject[] array)
314        {
315            final int length = array.length;
316            char[] chars = new char[length];
317            for (int i = 0; i < length; i++)
318                chars[i] = LispCharacter.toUpperCase(LispCharacter.getValue(array[i]));
319            for (int i = 1; i < length; i++) {
320                if (chars[i-1] >= chars[i])
321                    return NIL;
322            }
323            return T;
324        }
325    };
326
327    // ### char-not-lessp
328    private static final Primitive CHAR_NOT_LESSP =
329        new Primitive("char-not-lessp", "&rest characters")
330    {
331        @Override
332        public LispObject execute()
333        {
334            return error(new WrongNumberOfArgumentsException(this));
335        }
336        @Override
337        public LispObject execute(LispObject arg)
338        {
339            if (arg instanceof LispCharacter)
340                return T;
341            return type_error(arg, Symbol.CHARACTER);
342        }
343        @Override
344        public LispObject execute(LispObject first, LispObject second)
345
346        {
347            char c1 = LispCharacter.toUpperCase(LispCharacter.getValue(first));
348            char c2 = LispCharacter.toUpperCase(LispCharacter.getValue(second));
349            return c1 >= c2 ? T : NIL;
350        }
351        @Override
352        public LispObject execute(LispObject[] array)
353        {
354            final int length = array.length;
355            char[] chars = new char[length];
356            for (int i = 0; i < length; i++)
357                chars[i] = LispCharacter.toUpperCase(LispCharacter.getValue(array[i]));
358            for (int i = 1; i < length; i++) {
359                if (chars[i] > chars[i-1])
360                    return NIL;
361            }
362            return T;
363        }
364    };
365}
Note: See TracBrowser for help on using the repository browser.