001: /*
002: * CharacterFunctions.java
003: *
004: * Copyright (C) 2003-2004 Peter Graves
005: * $Id: CharacterFunctions.java,v 1.8 2004/03/17 17:54:10 piso Exp $
006: *
007: * This program is free software; you can redistribute it and/or
008: * modify it under the terms of the GNU General Public License
009: * as published by the Free Software Foundation; either version 2
010: * of the License, or (at your option) any later version.
011: *
012: * This program is distributed in the hope that it will be useful,
013: * but WITHOUT ANY WARRANTY; without even the implied warranty of
014: * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
015: * GNU General Public License for more details.
016: *
017: * You should have received a copy of the GNU General Public License
018: * along with this program; if not, write to the Free Software
019: * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
020: */
021:
022: package org.armedbear.lisp;
023:
024: public final class CharacterFunctions extends Lisp {
025: // ### char=
026: private static final Primitive CHAR_EQUALS = new Primitive("char=",
027: "&rest characters") {
028: public LispObject execute(LispObject first, LispObject second)
029: throws ConditionThrowable {
030: return LispCharacter.getValue(first) == LispCharacter
031: .getValue(second) ? T : NIL;
032: }
033:
034: public LispObject execute(LispObject[] array)
035: throws ConditionThrowable {
036: final int length = array.length;
037: if (length == 0)
038: return signal(new WrongNumberOfArgumentsException(this ));
039: if (length > 1) {
040: final char c0 = LispCharacter.getValue(array[0]);
041: for (int i = 0; i < length; i++) {
042: if (c0 != LispCharacter.getValue(array[i]))
043: return NIL;
044: }
045: }
046: return T;
047: }
048: };
049:
050: // ### char-equal
051: private static final Primitive CHAR_EQUAL = new Primitive(
052: "char-equal", "&rest characters") {
053: public LispObject execute(LispObject first, LispObject second)
054: throws ConditionThrowable {
055: char c1 = LispCharacter.getValue(first);
056: char c2 = LispCharacter.getValue(second);
057: if (c1 == c2)
058: return T;
059: if (Utilities.toUpperCase(c1) == Utilities.toUpperCase(c2))
060: return T;
061: if (Utilities.toLowerCase(c1) == Utilities.toLowerCase(c2))
062: return T;
063: return NIL;
064: }
065:
066: public LispObject execute(LispObject[] array)
067: throws ConditionThrowable {
068: final int length = array.length;
069: if (length == 0)
070: return signal(new WrongNumberOfArgumentsException(this ));
071: if (length > 1) {
072: final char c0 = LispCharacter.getValue(array[0]);
073: for (int i = 1; i < length; i++) {
074: char c = LispCharacter.getValue(array[i]);
075: if (c0 == c)
076: continue;
077: if (Utilities.toUpperCase(c0) == Utilities
078: .toUpperCase(c))
079: continue;
080: if (Utilities.toLowerCase(c0) == Utilities
081: .toLowerCase(c))
082: continue;
083: return NIL;
084: }
085: }
086: return T;
087: }
088: };
089:
090: // ### char-greaterp
091: private static final Primitive CHAR_GREATERP = new Primitive(
092: "char-greaterp", "&rest characters") {
093: public LispObject execute(LispObject first, LispObject second)
094: throws ConditionThrowable {
095: char c1 = Utilities.toUpperCase(LispCharacter
096: .getValue(first));
097: char c2 = Utilities.toUpperCase(LispCharacter
098: .getValue(second));
099: return c1 > c2 ? T : NIL;
100: }
101:
102: public LispObject execute(LispObject[] array)
103: throws ConditionThrowable {
104: final int length = array.length;
105: if (length == 0)
106: return signal(new WrongNumberOfArgumentsException(this ));
107: if (length > 1) {
108: char[] chars = new char[length];
109: for (int i = 0; i < length; i++)
110: chars[i] = Utilities.toUpperCase(LispCharacter
111: .getValue(array[i]));
112: for (int i = 1; i < length; i++) {
113: if (chars[i - 1] <= chars[i])
114: return NIL;
115: }
116: }
117: return T;
118: }
119: };
120:
121: // ### char-not-greaterp
122: private static final Primitive CHAR_NOT_GREATERP = new Primitive(
123: "char-not-greaterp", "&rest characters") {
124: public LispObject execute(LispObject first, LispObject second)
125: throws ConditionThrowable {
126: char c1 = Utilities.toUpperCase(LispCharacter
127: .getValue(first));
128: char c2 = Utilities.toUpperCase(LispCharacter
129: .getValue(second));
130: return c1 <= c2 ? T : NIL;
131: }
132:
133: public LispObject execute(LispObject[] array)
134: throws ConditionThrowable {
135: final int length = array.length;
136: if (length == 0)
137: return signal(new WrongNumberOfArgumentsException(this ));
138: if (length > 1) {
139: char[] chars = new char[length];
140: for (int i = 0; i < length; i++)
141: chars[i] = Utilities.toUpperCase(LispCharacter
142: .getValue(array[i]));
143: for (int i = 1; i < length; i++) {
144: if (chars[i] < chars[i - 1])
145: return NIL;
146: }
147: }
148: return T;
149: }
150: };
151:
152: // ### char<=
153: private static final Primitive CHAR_LE = new Primitive("char<=",
154: "&rest characters") {
155: public LispObject execute() throws ConditionThrowable {
156: return signal(new WrongNumberOfArgumentsException(this ));
157: }
158:
159: public LispObject execute(LispObject arg)
160: throws ConditionThrowable {
161: if (arg instanceof LispCharacter)
162: return T;
163: return signal(new TypeError(arg, Symbol.CHARACTER));
164: }
165:
166: public LispObject execute(LispObject first, LispObject second)
167: throws ConditionThrowable {
168: try {
169: return ((LispCharacter) first).value <= ((LispCharacter) second).value ? T
170: : NIL;
171: } catch (ClassCastException e) {
172: LispObject datum;
173: if (first instanceof LispCharacter)
174: datum = second;
175: else
176: datum = first;
177: return signal(new TypeError(datum, Symbol.CHARACTER));
178: }
179: }
180:
181: public LispObject execute(LispObject[] args)
182: throws ConditionThrowable {
183: final int length = args.length;
184: char[] chars = new char[length];
185: for (int i = 0; i < length; i++) {
186: try {
187: chars[i] = ((LispCharacter) args[i]).value;
188: } catch (ClassCastException e) {
189: return signal(new TypeError(args[i],
190: Symbol.CHARACTER));
191: }
192: }
193: for (int i = 1; i < length; i++) {
194: if (chars[i - 1] > chars[i])
195: return NIL;
196: }
197: return T;
198: }
199: };
200:
201: // ### char-lessp
202: private static final Primitive CHAR_LESSP = new Primitive(
203: "char-lessp", "&rest characters") {
204: public LispObject execute(LispObject first, LispObject second)
205: throws ConditionThrowable {
206: char c1 = Utilities.toUpperCase(LispCharacter
207: .getValue(first));
208: char c2 = Utilities.toUpperCase(LispCharacter
209: .getValue(second));
210: return c1 < c2 ? T : NIL;
211: }
212:
213: public LispObject execute(LispObject[] array)
214: throws ConditionThrowable {
215: final int length = array.length;
216: if (length == 0)
217: return signal(new WrongNumberOfArgumentsException(this ));
218: if (length > 1) {
219: char[] chars = new char[length];
220: for (int i = 0; i < length; i++)
221: chars[i] = Utilities.toUpperCase(LispCharacter
222: .getValue(array[i]));
223: for (int i = 1; i < length; i++) {
224: if (chars[i - 1] >= chars[i])
225: return NIL;
226: }
227: }
228: return T;
229: }
230: };
231:
232: // ### char-not-lessp
233: private static final Primitive CHAR_NOT_LESSP = new Primitive(
234: "char-not-lessp", "&rest characters") {
235: public LispObject execute(LispObject first, LispObject second)
236: throws ConditionThrowable {
237: char c1 = Utilities.toUpperCase(LispCharacter
238: .getValue(first));
239: char c2 = Utilities.toUpperCase(LispCharacter
240: .getValue(second));
241: return c1 >= c2 ? T : NIL;
242: }
243:
244: public LispObject execute(LispObject[] array)
245: throws ConditionThrowable {
246: final int length = array.length;
247: if (length == 0)
248: return signal(new WrongNumberOfArgumentsException(this ));
249: if (length > 1) {
250: char[] chars = new char[length];
251: for (int i = 0; i < length; i++)
252: chars[i] = Utilities.toUpperCase(LispCharacter
253: .getValue(array[i]));
254: for (int i = 1; i < length; i++) {
255: if (chars[i] > chars[i - 1])
256: return NIL;
257: }
258: }
259: return T;
260: }
261: };
262: }
|