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

Last change on this file was 11754, checked in by vvoutilainen, 16 years ago

Convert using ClassCastException? to checking instanceof.
Performance tests show this approach to be faster.
Patch by Douglas R. Miles. I modified the patch to
remove tabs, so indentation may be slightly off in places.
That's something that we need to handle separately, abcl
doesn't have a clear indentation policy.
  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 12.9 KB
Line 
1/*
2 * CharacterFunctions.java
3 *
4 * Copyright (C) 2003-2006 Peter Graves
5 * $Id: CharacterFunctions.java 11754 2009-04-12 10:53:39Z vvoutilainen $
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() throws ConditionThrowable
44        {
45            return error(new WrongNumberOfArgumentsException(this));
46        }
47        @Override
48        public LispObject execute(LispObject arg) throws ConditionThrowable
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            throws ConditionThrowable
57        {
58            return LispCharacter.getValue(first) == LispCharacter.getValue(second) ? T : NIL;
59        }
60        @Override
61        public LispObject execute(LispObject[] array) throws ConditionThrowable
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() throws ConditionThrowable
79        {
80            return error(new WrongNumberOfArgumentsException(this));
81        }
82        @Override
83        public LispObject execute(LispObject arg) throws ConditionThrowable
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            throws ConditionThrowable
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) throws ConditionThrowable
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() throws ConditionThrowable
129        {
130            return error(new WrongNumberOfArgumentsException(this));
131        }
132        @Override
133        public LispObject execute(LispObject arg) throws ConditionThrowable
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            throws ConditionThrowable
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) throws ConditionThrowable
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() throws ConditionThrowable
168        {
169            return error(new WrongNumberOfArgumentsException(this));
170        }
171        @Override
172        public LispObject execute(LispObject arg) throws ConditionThrowable
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            throws ConditionThrowable
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) throws ConditionThrowable
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() throws ConditionThrowable
207        {
208            return error(new WrongNumberOfArgumentsException(this));
209        }
210        @Override
211        public LispObject execute(LispObject arg) throws ConditionThrowable
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            throws ConditionThrowable
220        {
221            return LispCharacter.getValue(first) < LispCharacter.getValue(second) ? T : NIL;
222       }
223        @Override
224        public LispObject execute(LispObject[] args) throws ConditionThrowable
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() throws ConditionThrowable
245        {
246            return error(new WrongNumberOfArgumentsException(this));
247        }
248        @Override
249        public LispObject execute(LispObject arg) throws ConditionThrowable
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            throws ConditionThrowable
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            throws ConditionThrowable
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) throws ConditionThrowable
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() throws ConditionThrowable
294        {
295            return error(new WrongNumberOfArgumentsException(this));
296        }
297        @Override
298        public LispObject execute(LispObject arg) throws ConditionThrowable
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            throws ConditionThrowable
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) throws ConditionThrowable
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() throws ConditionThrowable
333        {
334            return error(new WrongNumberOfArgumentsException(this));
335        }
336        @Override
337        public LispObject execute(LispObject arg) throws ConditionThrowable
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            throws ConditionThrowable
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) throws ConditionThrowable
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.