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

Last change on this file was 13461, checked in by ehuelsmann, 13 years ago

Print expected minimum and maximum argument list lengths in
WrongNumberOfArguments? program errors.
  • 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 13461 2011-08-11 17:01:41Z 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
36import static org.armedbear.lisp.Lisp.*;
37
38public final class CharacterFunctions
39{
40    // ### char=
41    private static final Primitive CHAR_EQUALS =
42        new Primitive("char=", "&rest characters")
43    {
44        @Override
45        public LispObject execute()
46        {
47            return error(new WrongNumberOfArgumentsException(this, 1, -1));
48        }
49        @Override
50        public LispObject execute(LispObject arg)
51        {
52            if (arg instanceof LispCharacter)
53                return T;
54            return type_error(arg, Symbol.CHARACTER);
55        }
56        @Override
57        public LispObject execute(LispObject first, LispObject second)
58
59        {
60            return LispCharacter.getValue(first) == LispCharacter.getValue(second) ? T : NIL;
61        }
62        @Override
63        public LispObject execute(LispObject[] array)
64        {
65            final int length = array.length;
66            final char c0 = LispCharacter.getValue(array[0]);
67            for (int i = 1; i < length; i++) {
68                if (c0 != LispCharacter.getValue(array[i]))
69                    return NIL;
70            }
71            return T;
72        }
73    };
74
75    // ### char-equal
76    private static final Primitive CHAR_EQUAL =
77        new Primitive("char-equal", "&rest characters")
78    {
79        @Override
80        public LispObject execute()
81        {
82            return error(new WrongNumberOfArgumentsException(this, 1, -1));
83        }
84        @Override
85        public LispObject execute(LispObject arg)
86        {
87            if (arg instanceof LispCharacter)
88                return T;
89            return type_error(arg, Symbol.CHARACTER);
90        }
91        @Override
92        public LispObject execute(LispObject first, LispObject second)
93
94        {
95            final char c1, c2;
96            c1 = LispCharacter.getValue(first);
97            c2 = LispCharacter.getValue(second);
98            if (c1 == c2)
99                return T;
100            if (LispCharacter.toUpperCase(c1) == LispCharacter.toUpperCase(c2))
101                return T;
102            if (LispCharacter.toLowerCase(c1) == LispCharacter.toLowerCase(c2))
103                return T;
104            return NIL;
105        }
106        @Override
107        public LispObject execute(LispObject[] array)
108        {
109            final int length = array.length;
110            final char c0 = LispCharacter.getValue(array[0]);
111            for (int i = 1; i < length; i++) {
112                char c = LispCharacter.getValue(array[i]);
113                if (c0 == c)
114                    continue;
115                if (LispCharacter.toUpperCase(c0) == LispCharacter.toUpperCase(c))
116                    continue;
117                if (LispCharacter.toLowerCase(c0) == LispCharacter.toLowerCase(c))
118                    continue;
119                return NIL;
120            }
121            return T;
122        }
123    };
124
125    // ### char-greaterp
126    private static final Primitive CHAR_GREATERP =
127        new Primitive("char-greaterp", "&rest characters")
128    {
129        @Override
130        public LispObject execute()
131        {
132            return error(new WrongNumberOfArgumentsException(this, 1, -1));
133        }
134        @Override
135        public LispObject execute(LispObject arg)
136        {
137            if (arg instanceof LispCharacter)
138                return T;
139            return type_error(arg, Symbol.CHARACTER);
140        }
141        @Override
142        public LispObject execute(LispObject first, LispObject second)
143
144        {
145            char c1 = LispCharacter.toUpperCase(LispCharacter.getValue(first));
146            char c2 = LispCharacter.toUpperCase(LispCharacter.getValue(second));
147            return c1 > c2 ? T : NIL;
148        }
149        @Override
150        public LispObject execute(LispObject[] array)
151        {
152            final int length = array.length;
153            char[] chars = new char[length];
154            for (int i = 0; i < length; i++)
155                chars[i] = LispCharacter.toUpperCase(LispCharacter.getValue(array[i]));
156            for (int i = 1; i < length; i++) {
157                if (chars[i-1] <= chars[i])
158                    return NIL;
159            }
160            return T;
161        }
162    };
163
164    // ### char-not-greaterp
165    private static final Primitive CHAR_NOT_GREATERP =
166        new Primitive("char-not-greaterp", "&rest characters")
167    {
168        @Override
169        public LispObject execute()
170        {
171            return error(new WrongNumberOfArgumentsException(this, 1, -1));
172        }
173        @Override
174        public LispObject execute(LispObject arg)
175        {
176            if (arg instanceof LispCharacter)
177                return T;
178            return type_error(arg, Symbol.CHARACTER);
179        }
180        @Override
181        public LispObject execute(LispObject first, LispObject second)
182
183        {
184            char c1 = LispCharacter.toUpperCase(LispCharacter.getValue(first));
185            char c2 = LispCharacter.toUpperCase(LispCharacter.getValue(second));
186            return c1 <= c2 ? T : NIL;
187        }
188        @Override
189        public LispObject execute(LispObject[] array)
190        {
191            final int length = array.length;
192            char[] chars = new char[length];
193            for (int i = 0; i < length; i++)
194                chars[i] = LispCharacter.toUpperCase(LispCharacter.getValue(array[i]));
195            for (int i = 1; i < length; i++) {
196                if (chars[i] < chars[i-1])
197                    return NIL;
198            }
199            return T;
200        }
201    };
202
203    // ### char<
204    private static final Primitive CHAR_LESS_THAN =
205        new Primitive("char<", "&rest characters")
206    {
207        @Override
208        public LispObject execute()
209        {
210            return error(new WrongNumberOfArgumentsException(this, 1, -1));
211        }
212        @Override
213        public LispObject execute(LispObject arg)
214        {
215            if (arg instanceof LispCharacter)
216                return T;
217            return type_error(arg, Symbol.CHARACTER);
218        }
219        @Override
220        public LispObject execute(LispObject first, LispObject second)
221
222        {
223            return LispCharacter.getValue(first) < LispCharacter.getValue(second) ? T : NIL;
224       }
225        @Override
226        public LispObject execute(LispObject[] args)
227        {
228            final int length = args.length;
229            char[] chars = new char[length];
230            for (int i = 0; i < length; i++) {
231                chars[i] = LispCharacter.getValue(args[i]);
232            }
233            for (int i = 1; i < length; i++) {
234                if (chars[i-1] >= chars[i])
235                    return NIL;
236            }
237            return T;
238        }
239    };
240
241    // ### char<=
242    private static final Primitive CHAR_LE =
243        new Primitive("char<=", "&rest characters")
244    {
245        @Override
246        public LispObject execute()
247        {
248            return error(new WrongNumberOfArgumentsException(this, 1, -1));
249        }
250        @Override
251        public LispObject execute(LispObject arg)
252        {
253            if (arg instanceof LispCharacter)
254                return T;
255            return type_error(arg, Symbol.CHARACTER);
256        }
257        @Override
258        public LispObject execute(LispObject first, LispObject second)
259
260        {
261            return LispCharacter.getValue(first) <= LispCharacter.getValue(second) ? T : NIL;
262        }
263        @Override
264        public LispObject execute(LispObject first, LispObject second,
265                                  LispObject third)
266
267        {
268            if (LispCharacter.getValue(first) > LispCharacter.getValue(second))
269                return NIL;
270            if (LispCharacter.getValue(second) > LispCharacter.getValue(third))
271                return NIL;
272            return T;
273        }
274        @Override
275        public LispObject execute(LispObject[] args)
276        {
277            final int length = args.length;
278            char[] chars = new char[length];
279            for (int i = 0; i < length; i++) {
280                chars[i] = LispCharacter.getValue(args[i]);
281            }
282            for (int i = 1; i < length; i++) {
283                if (chars[i-1] > chars[i])
284                    return NIL;
285            }
286            return T;
287        }
288    };
289
290    // ### char-lessp
291    private static final Primitive CHAR_LESSP =
292        new Primitive("char-lessp", "&rest characters")
293    {
294        @Override
295        public LispObject execute()
296        {
297            return error(new WrongNumberOfArgumentsException(this, 1, -1));
298        }
299        @Override
300        public LispObject execute(LispObject arg)
301        {
302            if (arg instanceof LispCharacter)
303                return T;
304            return type_error(arg, Symbol.CHARACTER);
305        }
306        @Override
307        public LispObject execute(LispObject first, LispObject second)
308
309        {
310            char c1 = LispCharacter.toUpperCase(LispCharacter.getValue(first));
311            char c2 = LispCharacter.toUpperCase(LispCharacter.getValue(second));
312            return c1 < c2 ? T : NIL;
313        }
314        @Override
315        public LispObject execute(LispObject[] array)
316        {
317            final int length = array.length;
318            char[] chars = new char[length];
319            for (int i = 0; i < length; i++)
320                chars[i] = LispCharacter.toUpperCase(LispCharacter.getValue(array[i]));
321            for (int i = 1; i < length; i++) {
322                if (chars[i-1] >= chars[i])
323                    return NIL;
324            }
325            return T;
326        }
327    };
328
329    // ### char-not-lessp
330    private static final Primitive CHAR_NOT_LESSP =
331        new Primitive("char-not-lessp", "&rest characters")
332    {
333        @Override
334        public LispObject execute()
335        {
336            return error(new WrongNumberOfArgumentsException(this, 1, -1));
337        }
338        @Override
339        public LispObject execute(LispObject arg)
340        {
341            if (arg instanceof LispCharacter)
342                return T;
343            return type_error(arg, Symbol.CHARACTER);
344        }
345        @Override
346        public LispObject execute(LispObject first, LispObject second)
347
348        {
349            char c1 = LispCharacter.toUpperCase(LispCharacter.getValue(first));
350            char c2 = LispCharacter.toUpperCase(LispCharacter.getValue(second));
351            return c1 >= c2 ? T : NIL;
352        }
353        @Override
354        public LispObject execute(LispObject[] array)
355        {
356            final int length = array.length;
357            char[] chars = new char[length];
358            for (int i = 0; i < length; i++)
359                chars[i] = LispCharacter.toUpperCase(LispCharacter.getValue(array[i]));
360            for (int i = 1; i < length; i++) {
361                if (chars[i] > chars[i-1])
362                    return NIL;
363            }
364            return T;
365        }
366    };
367}
Note: See TracBrowser for help on using the repository browser.