Context Navigation

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

Visit:

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: 35.1 KB

Line
1	/*
2	* StringFunctions.java
3	*
4	* Copyright (C) 2003-2005 Peter Graves
5	* $Id: StringFunctions.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
34	package org.armedbear.lisp;
35
36	public final class StringFunctions extends Lisp
37	{
38	// ### %string=
39	// Case sensitive.
40	private static final Primitive _STRING_EQUAL =
41	new Primitive("%string=", PACKAGE_SYS, false)
42	{
43	@Override
44	public LispObject execute(LispObject first, LispObject second,
45	LispObject third, LispObject fourth,
46	LispObject fifth, LispObject sixth)
47	throws ConditionThrowable
48	{
49	char[] array1 = first.STRING().getStringChars();
50	char[] array2 = second.STRING().getStringChars();
51	int start1, end1, start2, end2;
52	start1 = Fixnum.getValue(third);
53	if (fourth == NIL) {
54	end1 = array1.length;
55	} else {
56	end1 = Fixnum.getValue(fourth);
57	}
58	start2 = Fixnum.getValue(fifth);
59	if (sixth == NIL) {
60	end2 = array2.length;
61	} else {
62	end2 = Fixnum.getValue(sixth);
63	}
64	if ((end1 - start1) != (end2 - start2))
65	return NIL;
66	try {
67	for (int i = start1, j = start2; i < end1; i++, j++) {
68	if (array1[i] != array2[j])
69	return NIL;
70	}
71	}
72	catch (ArrayIndexOutOfBoundsException e) {
73	// Shouldn't happen.
74	Debug.trace(e);
75	return NIL;
76	}
77	return T;
78	}
79	};
80
81	// ### %%string=
82	// Case sensitive.
83	private static final Primitive __STRING_EQUAL =
84	new Primitive("%%string=", PACKAGE_SYS, false)
85	{
86	@Override
87	public LispObject execute(LispObject first, LispObject second)
88	throws ConditionThrowable
89	{
90	char[] array1 = first.STRING().getStringChars();
91	char[] array2 = second.STRING().getStringChars();
92	if (array1.length != array2.length)
93	return NIL;
94	for (int i = array1.length; i-- > 0;) {
95	if (array1[i] != array2[i])
96	return NIL;
97	}
98	return T;
99	}
100	};
101
102	// ### %string/=
103	// Case sensitive.
104	private static final Primitive _STRING_NOT_EQUAL =
105	new Primitive("%string/=", PACKAGE_SYS, true)
106	{
107	@Override
108	public LispObject execute(LispObject[] args) throws ConditionThrowable
109	{
110	if (args.length != 6)
111	return error(new WrongNumberOfArgumentsException(this));
112	char[] array1 = args[0].STRING().getStringChars();
113	char[] array2 = args[1].STRING().getStringChars();
114	int start1 = Fixnum.getValue(args[2]);
115	int end1 = Fixnum.getValue(args[3]);
116	int start2 = Fixnum.getValue(args[4]);
117	int end2 = Fixnum.getValue(args[5]);
118	int i = start1;
119	int j = start2;
120	while (true) {
121	if (i == end1) {
122	// Reached end of string1.
123	if (j == end2)
124	return NIL; // Strings are identical.
125	return Fixnum.getInstance(i);
126	}
127	if (j == end2) {
128	// Reached end of string2 before end of string1.
129	return Fixnum.getInstance(i);
130	}
131	if (array1[i] != array2[j])
132	return Fixnum.getInstance(i);
133	++i;
134	++j;
135	}
136	}
137	};
138
139	// ### %string-equal
140	// Case insensitive.
141	private static final Primitive _STRING_EQUAL_IGNORE_CASE =
142	new Primitive("%string-equal", PACKAGE_SYS, true)
143	{
144	@Override
145	public LispObject execute(LispObject first, LispObject second,
146	LispObject third, LispObject fourth,
147	LispObject fifth, LispObject sixth)
148	throws ConditionThrowable
149	{
150	char[] array1 = first.STRING().getStringChars();
151	char[] array2 = second.STRING().getStringChars();
152	int start1 = Fixnum.getValue(third);
153	int end1 = Fixnum.getValue(fourth);
154	int start2 = Fixnum.getValue(fifth);
155	int end2 = Fixnum.getValue(sixth);
156	if ((end1 - start1) != (end2 - start2))
157	return NIL;
158	int i, j;
159	for (i = start1, j = start2; i < end1; i++, j++) {
160	char c1 = array1[i];
161	char c2 = array2[j];
162	if (c1 == c2)
163	continue;
164	if (LispCharacter.toUpperCase(c1) == LispCharacter.toUpperCase(c2))
165	continue;
166	if (LispCharacter.toLowerCase(c1) == LispCharacter.toLowerCase(c2))
167	continue;
168	return NIL;
169	}
170	return T;
171	}
172	};
173
174	// ### %string-not-equal
175	// Case sensitive.
176	private static final Primitive _STRING_NOT_EQUAL_IGNORE_CASE =
177	new Primitive("%string-not-equal", PACKAGE_SYS, true)
178	{
179	@Override
180	public LispObject execute(LispObject[] args) throws ConditionThrowable
181	{
182	if (args.length != 6)
183	return error(new WrongNumberOfArgumentsException(this));
184	char[] array1 = args[0].STRING().getStringChars();
185	char[] array2 = args[1].STRING().getStringChars();
186	int start1 = Fixnum.getValue(args[2]);
187	int end1 = Fixnum.getValue(args[3]);
188	int start2 = Fixnum.getValue(args[4]);
189	int end2 = Fixnum.getValue(args[5]);
190	int i = start1;
191	int j = start2;
192	while (true) {
193	if (i == end1) {
194	// Reached end of string1.
195	if (j == end2)
196	return NIL; // Strings are identical.
197	return Fixnum.getInstance(i);
198	}
199	if (j == end2) {
200	// Reached end of string2.
201	return Fixnum.getInstance(i);
202	}
203	char c1 = array1[i];
204	char c2 = array2[j];
205	if (c1 == c2 \|\|
206	LispCharacter.toUpperCase(c1) == LispCharacter.toUpperCase(c2) \|\|
207	LispCharacter.toLowerCase(c1) == LispCharacter.toLowerCase(c2))
208	{
209	++i;
210	++j;
211	continue;
212	}
213	return Fixnum.getInstance(i);
214	}
215	}
216	};
217
218	// ### %string<
219	// Case sensitive.
220	private static final Primitive _STRING_LESS_THAN =
221	new Primitive("%string<", PACKAGE_SYS, true)
222	{
223	@Override
224	public LispObject execute(LispObject[] args) throws ConditionThrowable
225	{
226	if (args.length != 6)
227	return error(new WrongNumberOfArgumentsException(this));
228	char[] array1 = args[0].STRING().getStringChars();
229	char[] array2 = args[1].STRING().getStringChars();
230	int start1 = Fixnum.getValue(args[2]);
231	int end1 = Fixnum.getValue(args[3]);
232	int start2 = Fixnum.getValue(args[4]);
233	int end2 = Fixnum.getValue(args[5]);
234	int i = start1;
235	int j = start2;
236	while (true) {
237	if (i == end1) {
238	// Reached end of string1.
239	if (j == end2)
240	return NIL; // Strings are identical.
241	return Fixnum.getInstance(i);
242	}
243	if (j == end2) {
244	// Reached end of string2.
245	return NIL;
246	}
247	char c1 = array1[i];
248	char c2 = array2[j];
249	if (c1 == c2) {
250	++i;
251	++j;
252	continue;
253	}
254	if (c1 < c2)
255	return Fixnum.getInstance(i);
256	// c1 > c2
257	return NIL;
258	}
259	}
260	};
261
262	// ### %string<=
263	// Case sensitive.
264	private static final Primitive _STRING_GREATER_THAN =
265	new Primitive("%string>", PACKAGE_SYS, true)
266	{
267	@Override
268	public LispObject execute(LispObject[] args) throws ConditionThrowable
269	{
270	if (args.length != 6)
271	return error(new WrongNumberOfArgumentsException(this));
272	char[] array1 = args[0].STRING().getStringChars();
273	char[] array2 = args[1].STRING().getStringChars();
274	int start1 = Fixnum.getValue(args[2]);
275	int end1 = Fixnum.getValue(args[3]);
276	int start2 = Fixnum.getValue(args[4]);
277	int end2 = Fixnum.getValue(args[5]);
278	int i = start1;
279	int j = start2;
280	while (true) {
281	if (i == end1) {
282	// Reached end of string1.
283	return NIL;
284	}
285	if (j == end2) {
286	// Reached end of string2.
287	return Fixnum.getInstance(i);
288	}
289	char c1 = array1[i];
290	char c2 = array2[j];
291	if (c1 == c2) {
292	++i;
293	++j;
294	continue;
295	}
296	if (c1 < c2)
297	return NIL;
298	// c1 > c2
299	return Fixnum.getInstance(i);
300	}
301	}
302	};
303
304	// ### %string<=
305	// Case sensitive.
306	private static final Primitive _STRING_LE =
307	new Primitive("%string<=", PACKAGE_SYS, true)
308	{
309	@Override
310	public LispObject execute(LispObject[] args) throws ConditionThrowable
311	{
312	if (args.length != 6)
313	return error(new WrongNumberOfArgumentsException(this));
314	char[] array1 = args[0].STRING().getStringChars();
315	char[] array2 = args[1].STRING().getStringChars();
316	int start1 = Fixnum.getValue(args[2]);
317	int end1 = Fixnum.getValue(args[3]);
318	int start2 = Fixnum.getValue(args[4]);
319	int end2 = Fixnum.getValue(args[5]);
320	int i = start1;
321	int j = start2;
322	while (true) {
323	if (i == end1) {
324	// Reached end of string1.
325	return Fixnum.getInstance(i);
326	}
327	if (j == end2) {
328	// Reached end of string2.
329	return NIL;
330	}
331	char c1 = array1[i];
332	char c2 = array2[j];
333	if (c1 == c2) {
334	++i;
335	++j;
336	continue;
337	}
338	if (c1 > c2)
339	return NIL;
340	// c1 < c2
341	return Fixnum.getInstance(i);
342	}
343	}
344	};
345
346	// ### %string<=
347	// Case sensitive.
348	private static final Primitive _STRING_GE =
349	new Primitive("%string>=", PACKAGE_SYS, true)
350	{
351	@Override
352	public LispObject execute(LispObject[] args) throws ConditionThrowable
353	{
354	if (args.length != 6)
355	return error(new WrongNumberOfArgumentsException(this));
356	char[] array1 = args[0].STRING().getStringChars();
357	char[] array2 = args[1].STRING().getStringChars();
358	int start1 = Fixnum.getValue(args[2]);
359	int end1 = Fixnum.getValue(args[3]);
360	int start2 = Fixnum.getValue(args[4]);
361	int end2 = Fixnum.getValue(args[5]);
362	int i = start1;
363	int j = start2;
364	while (true) {
365	if (i == end1) {
366	// Reached end of string1.
367	if (j == end2)
368	return Fixnum.getInstance(i); // Strings are identical.
369	return NIL;
370	}
371	if (j == end2) {
372	// Reached end of string2.
373	return Fixnum.getInstance(i);
374	}
375	char c1 = array1[i];
376	char c2 = array2[j];
377	if (c1 == c2) {
378	++i;
379	++j;
380	continue;
381	}
382	if (c1 < c2)
383	return NIL;
384	// c1 > c2
385	return Fixnum.getInstance(i);
386	}
387	}
388	};
389
390	// ### %string-lessp
391	// Case insensitive.
392	private static final Primitive _STRING_LESSP =
393	new Primitive("%string-lessp", PACKAGE_SYS, true)
394	{
395	@Override
396	public LispObject execute(LispObject[] args) throws ConditionThrowable
397	{
398	if (args.length != 6)
399	return error(new WrongNumberOfArgumentsException(this));
400	char[] array1 = args[0].STRING().getStringChars();
401	char[] array2 = args[1].STRING().getStringChars();
402	int start1 = Fixnum.getValue(args[2]);
403	int end1 = Fixnum.getValue(args[3]);
404	int start2 = Fixnum.getValue(args[4]);
405	int end2 = Fixnum.getValue(args[5]);
406	int i = start1;
407	int j = start2;
408	while (true) {
409	if (i == end1) {
410	// Reached end of string1.
411	if (j == end2)
412	return NIL; // Strings are identical.
413	return Fixnum.getInstance(i);
414	}
415	if (j == end2) {
416	// Reached end of string2.
417	return NIL;
418	}
419	char c1 = LispCharacter.toUpperCase(array1[i]);
420	char c2 = LispCharacter.toUpperCase(array2[j]);
421	if (c1 == c2) {
422	++i;
423	++j;
424	continue;
425	}
426	if (c1 > c2)
427	return NIL;
428	// c1 < c2
429	return Fixnum.getInstance(i);
430	}
431	}
432	};
433
434	// ### %string-greaterp
435	// Case insensitive.
436	private static final Primitive _STRING_GREATERP =
437	new Primitive("%string-greaterp", PACKAGE_SYS, true)
438	{
439	@Override
440	public LispObject execute(LispObject[] args) throws ConditionThrowable
441	{
442	if (args.length != 6)
443	return error(new WrongNumberOfArgumentsException(this));
444	char[] array1 = args[0].STRING().getStringChars();
445	char[] array2 = args[1].STRING().getStringChars();
446	int start1 = Fixnum.getValue(args[2]);
447	int end1 = Fixnum.getValue(args[3]);
448	int start2 = Fixnum.getValue(args[4]);
449	int end2 = Fixnum.getValue(args[5]);
450	int i = start1;
451	int j = start2;
452	while (true) {
453	if (i == end1) {
454	// Reached end of string1.
455	return NIL;
456	}
457	if (j == end2) {
458	// Reached end of string2.
459	return Fixnum.getInstance(i);
460	}
461	char c1 = LispCharacter.toUpperCase(array1[i]);
462	char c2 = LispCharacter.toUpperCase(array2[j]);
463	if (c1 == c2) {
464	++i;
465	++j;
466	continue;
467	}
468	if (c1 < c2)
469	return NIL;
470	// c1 > c2
471	return Fixnum.getInstance(i);
472	}
473	}
474	};
475
476	// ### %string-not-lessp
477	// Case insensitive.
478	private static final Primitive _STRING_NOT_LESSP =
479	new Primitive("%string-not-lessp", PACKAGE_SYS, true)
480	{
481	@Override
482	public LispObject execute(LispObject[] args) throws ConditionThrowable
483	{
484	if (args.length != 6)
485	return error(new WrongNumberOfArgumentsException(this));
486	char[] array1 = args[0].STRING().getStringChars();
487	char[] array2 = args[1].STRING().getStringChars();
488	int start1 = Fixnum.getValue(args[2]);
489	int end1 = Fixnum.getValue(args[3]);
490	int start2 = Fixnum.getValue(args[4]);
491	int end2 = Fixnum.getValue(args[5]);
492	int i = start1;
493	int j = start2;
494	while (true) {
495	if (i == end1) {
496	// Reached end of string1.
497	if (j == end2)
498	return Fixnum.getInstance(i); // Strings are identical.
499	return NIL;
500	}
501	if (j == end2) {
502	// Reached end of string2.
503	return Fixnum.getInstance(i);
504	}
505	char c1 = LispCharacter.toUpperCase(array1[i]);
506	char c2 = LispCharacter.toUpperCase(array2[j]);
507	if (c1 == c2) {
508	++i;
509	++j;
510	continue;
511	}
512	if (c1 > c2)
513	return Fixnum.getInstance(i);
514	// c1 < c2
515	return NIL;
516	}
517	}
518	};
519
520	// ### %string-not-greaterp
521	// Case insensitive.
522	private static final Primitive _STRING_NOT_GREATERP =
523	new Primitive("%string-not-greaterp", PACKAGE_SYS, true)
524	{
525	@Override
526	public LispObject execute(LispObject[] args) throws ConditionThrowable
527	{
528	if (args.length != 6)
529	return error(new WrongNumberOfArgumentsException(this));
530	char[] array1 = args[0].STRING().getStringChars();
531	char[] array2 = args[1].STRING().getStringChars();
532	int start1 = Fixnum.getValue(args[2]);
533	int end1 = Fixnum.getValue(args[3]);
534	int start2 = Fixnum.getValue(args[4]);
535	int end2 = Fixnum.getValue(args[5]);
536	int i = start1;
537	int j = start2;
538	while (true) {
539	if (i == end1) {
540	// Reached end of string1.
541	return Fixnum.getInstance(i);
542	}
543	if (j == end2) {
544	// Reached end of string2.
545	return NIL;
546	}
547	char c1 = LispCharacter.toUpperCase(array1[i]);
548	char c2 = LispCharacter.toUpperCase(array2[j]);
549	if (c1 == c2) {
550	++i;
551	++j;
552	continue;
553	}
554	if (c1 > c2)
555	return NIL;
556	// c1 < c2
557	return Fixnum.getInstance(i);
558	}
559	}
560	};
561
562	// ### %string-upcase
563	private static final Primitive _STRING_UPCASE =
564	new Primitive("%string-upcase", PACKAGE_SYS, true)
565	{
566	@Override
567	public LispObject execute(LispObject first, LispObject second,
568	LispObject third)
569	throws ConditionThrowable
570	{
571	LispObject s = first.STRING();
572	final int length = s.length();
573	int start = (int) Fixnum.getValue(second);
574	if (start < 0 \|\| start > length)
575	return error(new TypeError("Invalid start position " + start + "."));
576	int end;
577	if (third == NIL)
578	end = length;
579	else
580	end = (int) Fixnum.getValue(third);
581	if (end < 0 \|\| end > length)
582	return error(new TypeError("Invalid end position " + start + "."));
583	if (start > end)
584	return error(new TypeError("Start (" + start + ") is greater than end (" + end + ")."));
585	FastStringBuffer sb = new FastStringBuffer(length);
586	char[] array = s.getStringChars();
587	int i;
588	for (i = 0; i < start; i++)
589	sb.append(array[i]);
590	for (i = start; i < end; i++)
591	sb.append(LispCharacter.toUpperCase(array[i]));
592	for (i = end; i < length; i++)
593	sb.append(array[i]);
594	return new SimpleString(sb);
595	}
596	};
597
598	// ### %string-downcase
599	private static final Primitive _STRING_DOWNCASE =
600	new Primitive("%string-downcase", PACKAGE_SYS, true)
601	{
602	@Override
603	public LispObject execute(LispObject first, LispObject second,
604	LispObject third) throws
605	ConditionThrowable
606	{
607	LispObject s = first.STRING();
608	final int length = s.length();
609	int start = (int) Fixnum.getValue(second);
610	if (start < 0 \|\| start > length)
611	return error(new TypeError("Invalid start position " + start + "."));
612	int end;
613	if (third == NIL)
614	end = length;
615	else
616	end = (int) Fixnum.getValue(third);
617	if (end < 0 \|\| end > length)
618	return error(new TypeError("Invalid end position " + start + "."));
619	if (start > end)
620	return error(new TypeError("Start (" + start + ") is greater than end (" + end + ")."));
621	FastStringBuffer sb = new FastStringBuffer(length);
622	char[] array = s.getStringChars();
623	int i;
624	for (i = 0; i < start; i++)
625	sb.append(array[i]);
626	for (i = start; i < end; i++)
627	sb.append(LispCharacter.toLowerCase(array[i]));
628	for (i = end; i < length; i++)
629	sb.append(array[i]);
630	return new SimpleString(sb);
631	}
632	};
633
634	// ### %string-capitalize
635	private static final Primitive _STRING_CAPITALIZE=
636	new Primitive("%string-capitalize", PACKAGE_SYS, true)
637	{
638	@Override
639	public LispObject execute(LispObject first, LispObject second,
640	LispObject third)
641	throws ConditionThrowable
642	{
643	LispObject s = first.STRING();
644	final int length = s.length();
645	int start = (int) Fixnum.getValue(second);
646	if (start < 0 \|\| start > length)
647	return error(new TypeError("Invalid start position " + start + "."));
648	int end;
649	if (third == NIL)
650	end = length;
651	else
652	end = (int) Fixnum.getValue(third);
653	if (end < 0 \|\| end > length)
654	return error(new TypeError("Invalid end position " + start + "."));
655	if (start > end)
656	return error(new TypeError("Start (" + start + ") is greater than end (" + end + ")."));
657	FastStringBuffer sb = new FastStringBuffer(length);
658	char[] array = s.getStringChars();
659	boolean lastCharWasAlphanumeric = false;
660	int i;
661	for (i = 0; i < start; i++)
662	sb.append(array[i]);
663	for (i = start; i < end; i++) {
664	char c = array[i];
665	if (Character.isLowerCase(c)) {
666	sb.append(lastCharWasAlphanumeric ? c : LispCharacter.toUpperCase(c));
667	lastCharWasAlphanumeric = true;
668	} else if (Character.isUpperCase(c)) {
669	sb.append(lastCharWasAlphanumeric ? LispCharacter.toLowerCase(c) : c);
670	lastCharWasAlphanumeric = true;
671	} else {
672	sb.append(c);
673	lastCharWasAlphanumeric = Character.isDigit(c);
674	}
675	}
676	for (i = end; i < length; i++)
677	sb.append(array[i]);
678	return new SimpleString(sb);
679	}
680	};
681
682	// ### %nstring-upcase
683	private static final Primitive _NSTRING_UPCASE =
684	new Primitive("%nstring-upcase", PACKAGE_SYS, true)
685	{
686	@Override
687	public LispObject execute(LispObject first, LispObject second,
688	LispObject third)
689	throws ConditionThrowable
690	{
691	final AbstractString string = checkString(first);
692	final int length = string.length();
693	int start = (int) Fixnum.getValue(second);
694	if (start < 0 \|\| start > length)
695	return error(new TypeError("Invalid start position " + start + "."));
696	int end;
697	if (third == NIL)
698	end = length;
699	else
700	end = (int) Fixnum.getValue(third);
701	if (end < 0 \|\| end > length)
702	return error(new TypeError("Invalid end position " + start + "."));
703	if (start > end)
704	return error(new TypeError("Start (" + start + ") is greater than end (" + end + ")."));
705	for (int i = start; i < end; i++)
706	string.setCharAt(i, LispCharacter.toUpperCase(string.charAt(i)));
707	return string;
708	}
709	};
710
711	// ### %nstring-downcase
712	private static final Primitive _NSTRING_DOWNCASE =
713	new Primitive("%nstring-downcase", PACKAGE_SYS, true)
714	{
715	@Override
716	public LispObject execute(LispObject first, LispObject second,
717	LispObject third)
718	throws ConditionThrowable
719	{
720	final AbstractString string = checkString(first);
721	final int length = string.length();
722	int start = (int) Fixnum.getValue(second);
723	if (start < 0 \|\| start > length)
724	return error(new TypeError("Invalid start position " + start + "."));
725	int end;
726	if (third == NIL)
727	end = length;
728	else
729	end = (int) Fixnum.getValue(third);
730	if (end < 0 \|\| end > length)
731	return error(new TypeError("Invalid end position " + start + "."));
732	if (start > end)
733	return error(new TypeError("Start (" + start + ") is greater than end (" + end + ")."));
734	for (int i = start; i < end; i++)
735	string.setCharAt(i, LispCharacter.toLowerCase(string.charAt(i)));
736	return string;
737	}
738	};
739
740	// ### %nstring-capitalize
741	private static final Primitive _NSTRING_CAPITALIZE =
742	new Primitive("%nstring-capitalize", PACKAGE_SYS, true)
743	{
744	@Override
745	public LispObject execute(LispObject first, LispObject second,
746	LispObject third)
747	throws ConditionThrowable
748	{
749	AbstractString string = checkString(first);
750	final int length = string.length();
751	int start = (int) Fixnum.getValue(second);
752	if (start < 0 \|\| start > length)
753	return error(new TypeError("Invalid start position " + start + "."));
754	int end;
755	if (third == NIL)
756	end = length;
757	else
758	end = (int) Fixnum.getValue(third);
759	if (end < 0 \|\| end > length)
760	return error(new TypeError("Invalid end position " + start + "."));
761	if (start > end)
762	return error(new TypeError("Start (" + start + ") is greater than end (" + end + ")."));
763	boolean lastCharWasAlphanumeric = false;
764	for (int i = start; i < end; i++) {
765	char c = string.charAt(i);
766	if (Character.isLowerCase(c)) {
767	if (!lastCharWasAlphanumeric)
768	string.setCharAt(i, LispCharacter.toUpperCase(c));
769	lastCharWasAlphanumeric = true;
770	} else if (Character.isUpperCase(c)) {
771	if (lastCharWasAlphanumeric)
772	string.setCharAt(i, LispCharacter.toLowerCase(c));
773	lastCharWasAlphanumeric = true;
774	} else
775	lastCharWasAlphanumeric = Character.isDigit(c);
776	}
777	return string;
778	}
779	};
780
781	// ### stringp
782	public static final Primitive STRINGP = new Primitive("stringp", "object")
783	{
784	@Override
785	public LispObject execute(LispObject arg) throws ConditionThrowable
786	{
787	return arg.STRINGP();
788	}
789	};
790
791	// ### simple-string-p
792	public static final Primitive SIMPLE_STRING_P =
793	new Primitive("simple-string-p", "object")
794	{
795	@Override
796	public LispObject execute(LispObject arg) throws ConditionThrowable
797	{
798	return arg.SIMPLE_STRING_P();
799	}
800	};
801
802	// ### %make-string
803	// %make-string size initial-element element-type => string
804	// Returns a simple string.
805	private static final Primitive _MAKE_STRING =
806	new Primitive("%make-string", PACKAGE_SYS, false)
807	{
808	@Override
809	public LispObject execute(LispObject size, LispObject initialElement,
810	LispObject elementType)
811	throws ConditionThrowable
812	{
813	final int n = Fixnum.getValue(size);
814	if (n < 0 \|\| n >= ARRAY_DIMENSION_MAX) {
815	FastStringBuffer sb = new FastStringBuffer();
816	sb.append("The size specified for this string (");
817	sb.append(n);
818	sb.append(')');
819	if (n >= ARRAY_DIMENSION_MAX) {
820	sb.append(" is >= ARRAY-DIMENSION-LIMIT (");
821	sb.append(ARRAY_DIMENSION_MAX);
822	sb.append(").");
823	} else
824	sb.append(" is negative.");
825	return error(new LispError(sb.toString()));
826	}
827	// Ignore elementType.
828	SimpleString string = new SimpleString(n);
829	if (initialElement != NIL) {
830	// Initial element was specified.
831	char c = checkCharacter(initialElement).getValue();
832	string.fill(c);
833	}
834	return string;
835	}
836	};
837
838	// ### char
839	private static final Primitive CHAR =
840	new Primitive(Symbol.CHAR, "string index")
841	{
842	@Override
843	public LispObject execute(LispObject first, LispObject second)
844	throws ConditionThrowable
845	{
846	return first.CHAR(Fixnum.getValue(second));
847	}
848	};
849
850	// ### schar
851	private static final Primitive SCHAR =
852	new Primitive(Symbol.SCHAR, "string index")
853	{
854	@Override
855	public LispObject execute(LispObject first, LispObject second)
856	throws ConditionThrowable
857	{
858	return first.SCHAR(Fixnum.getValue(second));
859	}
860	};
861
862	// ### set-char
863	private static final Primitive SET_CHAR =
864	new Primitive(Symbol.SET_CHAR, "string index character")
865	{
866	@Override
867	public LispObject execute(LispObject first, LispObject second,
868	LispObject third)
869	throws ConditionThrowable
870	{
871	checkString(first).setCharAt(Fixnum.getValue(second),
872	LispCharacter.getValue(third));
873	return third;
874	}
875	};
876
877	// ### set-schar
878	private static final Primitive SET_SCHAR =
879	new Primitive(Symbol.SET_SCHAR, "string index character")
880	{
881	@Override
882	public LispObject execute(LispObject first, LispObject second,
883	LispObject third)
884	throws ConditionThrowable
885	{
886	if (first instanceof SimpleString) {
887	((SimpleString)first).setCharAt(Fixnum.getValue(second),
888	LispCharacter.getValue(third));
889	return third;
890	}
891	return type_error(first, Symbol.SIMPLE_STRING);
892	}
893	};
894
895	// ### string-position
896	private static final Primitive STRING_POSITION =
897	new Primitive("string-position", PACKAGE_EXT, true)
898	{
899	@Override
900	public LispObject execute(LispObject first, LispObject second,
901	LispObject third)
902	throws ConditionThrowable
903	{
904	char c = LispCharacter.getValue(first);
905	AbstractString string = checkString(second);
906	int start = Fixnum.getValue(third);
907	for (int i = start, limit = string.length(); i < limit; i++) {
908	if (string.charAt(i) == c)
909	return number(i);
910	}
911	return NIL;
912	}
913	};
914
915	// ### string-find
916	private static final Primitive STRING_FIND =
917	new Primitive("string-find", PACKAGE_EXT, true, "char string")
918	{
919	@Override
920	public LispObject execute(LispObject first, LispObject second)
921	throws ConditionThrowable
922	{
923	if (first instanceof LispCharacter) {
924	final char c = ((LispCharacter)first).value;
925	AbstractString string = Lisp.checkString(second);
926	final int limit = string.length();
927	for (int i = 0; i < limit; i++) {
928	if (string.charAt(i) == c)
929	return first;
930	}
931	}
932	return NIL;
933	}
934	};
935
936	// ### simple-string-search pattern string => position
937	// Searches string for a substring that matches pattern.
938	private static final Primitive SIMPLE_STRING_SEARCH =
939	new Primitive("simple-string-search", PACKAGE_EXT, true)
940	{
941	@Override
942	public LispObject execute(LispObject first, LispObject second)
943	throws ConditionThrowable
944	{
945	// FIXME Don't call getStringValue() here! (Just look at the chars.)
946	int index = second.getStringValue().indexOf(first.getStringValue());
947	return index >= 0 ? Fixnum.getInstance(index) : NIL;
948	}
949	};
950
951	// ### simple-string-fill string character => string
952	private static final Primitive STRING_FILL =
953	new Primitive("simple-string-fill", PACKAGE_EXT, true)
954	{
955	@Override
956	public LispObject execute(LispObject first, LispObject second)
957	throws ConditionThrowable
958	{
959	if(first instanceof AbstractString) {
960	AbstractString s = (AbstractString) first;
961	s.fill(LispCharacter.getValue(second));
962	return first;
963	}
964	return type_error(first, Symbol.SIMPLE_STRING);
965	}
966	};
967
968	}

Note: See TracBrowser for help on using the repository browser.

Download in other formats: