Context Navigation

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

Visit:

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

Rename ConditionThrowable? to ControlTransfer? and remove

try/catch blocks which don't have anything to do with
non-local transfer of control.

Property svn:eol-style set to native
Property svn:keywords set to Id

File size: 34.2 KB

Line
1	/*
2	* StringFunctions.java
3	*
4	* Copyright (C) 2003-2005 Peter Graves
5	* $Id: StringFunctions.java 12255 2009-11-06 22:36:32Z 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
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
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
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)
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
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)
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)
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)
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)
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)
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)
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)
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)
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)
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
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)
605	{
606	LispObject s = first.STRING();
607	final int length = s.length();
608	int start = (int) Fixnum.getValue(second);
609	if (start < 0 \|\| start > length)
610	return error(new TypeError("Invalid start position " + start + "."));
611	int end;
612	if (third == NIL)
613	end = length;
614	else
615	end = (int) Fixnum.getValue(third);
616	if (end < 0 \|\| end > length)
617	return error(new TypeError("Invalid end position " + start + "."));
618	if (start > end)
619	return error(new TypeError("Start (" + start + ") is greater than end (" + end + ")."));
620	FastStringBuffer sb = new FastStringBuffer(length);
621	char[] array = s.getStringChars();
622	int i;
623	for (i = 0; i < start; i++)
624	sb.append(array[i]);
625	for (i = start; i < end; i++)
626	sb.append(LispCharacter.toLowerCase(array[i]));
627	for (i = end; i < length; i++)
628	sb.append(array[i]);
629	return new SimpleString(sb);
630	}
631	};
632
633	// ### %string-capitalize
634	private static final Primitive _STRING_CAPITALIZE=
635	new Primitive("%string-capitalize", PACKAGE_SYS, true)
636	{
637	@Override
638	public LispObject execute(LispObject first, LispObject second,
639	LispObject third)
640
641	{
642	LispObject s = first.STRING();
643	final int length = s.length();
644	int start = (int) Fixnum.getValue(second);
645	if (start < 0 \|\| start > length)
646	return error(new TypeError("Invalid start position " + start + "."));
647	int end;
648	if (third == NIL)
649	end = length;
650	else
651	end = (int) Fixnum.getValue(third);
652	if (end < 0 \|\| end > length)
653	return error(new TypeError("Invalid end position " + start + "."));
654	if (start > end)
655	return error(new TypeError("Start (" + start + ") is greater than end (" + end + ")."));
656	FastStringBuffer sb = new FastStringBuffer(length);
657	char[] array = s.getStringChars();
658	boolean lastCharWasAlphanumeric = false;
659	int i;
660	for (i = 0; i < start; i++)
661	sb.append(array[i]);
662	for (i = start; i < end; i++) {
663	char c = array[i];
664	if (Character.isLowerCase(c)) {
665	sb.append(lastCharWasAlphanumeric ? c : LispCharacter.toUpperCase(c));
666	lastCharWasAlphanumeric = true;
667	} else if (Character.isUpperCase(c)) {
668	sb.append(lastCharWasAlphanumeric ? LispCharacter.toLowerCase(c) : c);
669	lastCharWasAlphanumeric = true;
670	} else {
671	sb.append(c);
672	lastCharWasAlphanumeric = Character.isDigit(c);
673	}
674	}
675	for (i = end; i < length; i++)
676	sb.append(array[i]);
677	return new SimpleString(sb);
678	}
679	};
680
681	// ### %nstring-upcase
682	private static final Primitive _NSTRING_UPCASE =
683	new Primitive("%nstring-upcase", PACKAGE_SYS, true)
684	{
685	@Override
686	public LispObject execute(LispObject first, LispObject second,
687	LispObject third)
688
689	{
690	final AbstractString string = checkString(first);
691	final int length = string.length();
692	int start = (int) Fixnum.getValue(second);
693	if (start < 0 \|\| start > length)
694	return error(new TypeError("Invalid start position " + start + "."));
695	int end;
696	if (third == NIL)
697	end = length;
698	else
699	end = (int) Fixnum.getValue(third);
700	if (end < 0 \|\| end > length)
701	return error(new TypeError("Invalid end position " + start + "."));
702	if (start > end)
703	return error(new TypeError("Start (" + start + ") is greater than end (" + end + ")."));
704	for (int i = start; i < end; i++)
705	string.setCharAt(i, LispCharacter.toUpperCase(string.charAt(i)));
706	return string;
707	}
708	};
709
710	// ### %nstring-downcase
711	private static final Primitive _NSTRING_DOWNCASE =
712	new Primitive("%nstring-downcase", PACKAGE_SYS, true)
713	{
714	@Override
715	public LispObject execute(LispObject first, LispObject second,
716	LispObject third)
717
718	{
719	final AbstractString string = checkString(first);
720	final int length = string.length();
721	int start = (int) Fixnum.getValue(second);
722	if (start < 0 \|\| start > length)
723	return error(new TypeError("Invalid start position " + start + "."));
724	int end;
725	if (third == NIL)
726	end = length;
727	else
728	end = (int) Fixnum.getValue(third);
729	if (end < 0 \|\| end > length)
730	return error(new TypeError("Invalid end position " + start + "."));
731	if (start > end)
732	return error(new TypeError("Start (" + start + ") is greater than end (" + end + ")."));
733	for (int i = start; i < end; i++)
734	string.setCharAt(i, LispCharacter.toLowerCase(string.charAt(i)));
735	return string;
736	}
737	};
738
739	// ### %nstring-capitalize
740	private static final Primitive _NSTRING_CAPITALIZE =
741	new Primitive("%nstring-capitalize", PACKAGE_SYS, true)
742	{
743	@Override
744	public LispObject execute(LispObject first, LispObject second,
745	LispObject third)
746
747	{
748	AbstractString string = checkString(first);
749	final int length = string.length();
750	int start = (int) Fixnum.getValue(second);
751	if (start < 0 \|\| start > length)
752	return error(new TypeError("Invalid start position " + start + "."));
753	int end;
754	if (third == NIL)
755	end = length;
756	else
757	end = (int) Fixnum.getValue(third);
758	if (end < 0 \|\| end > length)
759	return error(new TypeError("Invalid end position " + start + "."));
760	if (start > end)
761	return error(new TypeError("Start (" + start + ") is greater than end (" + end + ")."));
762	boolean lastCharWasAlphanumeric = false;
763	for (int i = start; i < end; i++) {
764	char c = string.charAt(i);
765	if (Character.isLowerCase(c)) {
766	if (!lastCharWasAlphanumeric)
767	string.setCharAt(i, LispCharacter.toUpperCase(c));
768	lastCharWasAlphanumeric = true;
769	} else if (Character.isUpperCase(c)) {
770	if (lastCharWasAlphanumeric)
771	string.setCharAt(i, LispCharacter.toLowerCase(c));
772	lastCharWasAlphanumeric = true;
773	} else
774	lastCharWasAlphanumeric = Character.isDigit(c);
775	}
776	return string;
777	}
778	};
779
780	// ### stringp
781	public static final Primitive STRINGP = new Primitive("stringp", "object")
782	{
783	@Override
784	public LispObject execute(LispObject arg)
785	{
786	return arg.STRINGP();
787	}
788	};
789
790	// ### simple-string-p
791	public static final Primitive SIMPLE_STRING_P =
792	new Primitive("simple-string-p", "object")
793	{
794	@Override
795	public LispObject execute(LispObject arg)
796	{
797	return arg.SIMPLE_STRING_P();
798	}
799	};
800
801	// ### %make-string
802	// %make-string size initial-element element-type => string
803	// Returns a simple string.
804	private static final Primitive _MAKE_STRING =
805	new Primitive("%make-string", PACKAGE_SYS, false)
806	{
807	@Override
808	public LispObject execute(LispObject size, LispObject initialElement,
809	LispObject elementType)
810
811	{
812	final int n = Fixnum.getValue(size);
813	if (n < 0 \|\| n >= ARRAY_DIMENSION_MAX) {
814	FastStringBuffer sb = new FastStringBuffer();
815	sb.append("The size specified for this string (");
816	sb.append(n);
817	sb.append(')');
818	if (n >= ARRAY_DIMENSION_MAX) {
819	sb.append(" is >= ARRAY-DIMENSION-LIMIT (");
820	sb.append(ARRAY_DIMENSION_MAX);
821	sb.append(").");
822	} else
823	sb.append(" is negative.");
824	return error(new LispError(sb.toString()));
825	}
826	// Ignore elementType.
827	SimpleString string = new SimpleString(n);
828	if (initialElement != NIL) {
829	// Initial element was specified.
830	char c = checkCharacter(initialElement).getValue();
831	string.fill(c);
832	}
833	return string;
834	}
835	};
836
837	// ### char
838	private static final Primitive CHAR =
839	new Primitive(Symbol.CHAR, "string index")
840	{
841	@Override
842	public LispObject execute(LispObject first, LispObject second)
843
844	{
845	return first.CHAR(Fixnum.getValue(second));
846	}
847	};
848
849	// ### schar
850	private static final Primitive SCHAR =
851	new Primitive(Symbol.SCHAR, "string index")
852	{
853	@Override
854	public LispObject execute(LispObject first, LispObject second)
855
856	{
857	return first.SCHAR(Fixnum.getValue(second));
858	}
859	};
860
861	// ### set-char
862	private static final Primitive SET_CHAR =
863	new Primitive(Symbol.SET_CHAR, "string index character")
864	{
865	@Override
866	public LispObject execute(LispObject first, LispObject second,
867	LispObject third)
868
869	{
870	checkString(first).setCharAt(Fixnum.getValue(second),
871	LispCharacter.getValue(third));
872	return third;
873	}
874	};
875
876	// ### set-schar
877	private static final Primitive SET_SCHAR =
878	new Primitive(Symbol.SET_SCHAR, "string index character")
879	{
880	@Override
881	public LispObject execute(LispObject first, LispObject second,
882	LispObject third)
883
884	{
885	if (first instanceof SimpleString) {
886	((SimpleString)first).setCharAt(Fixnum.getValue(second),
887	LispCharacter.getValue(third));
888	return third;
889	}
890	return type_error(first, Symbol.SIMPLE_STRING);
891	}
892	};
893
894	// ### string-position
895	private static final Primitive STRING_POSITION =
896	new Primitive("string-position", PACKAGE_EXT, true)
897	{
898	@Override
899	public LispObject execute(LispObject first, LispObject second,
900	LispObject third)
901
902	{
903	char c = LispCharacter.getValue(first);
904	AbstractString string = checkString(second);
905	int start = Fixnum.getValue(third);
906	for (int i = start, limit = string.length(); i < limit; i++) {
907	if (string.charAt(i) == c)
908	return number(i);
909	}
910	return NIL;
911	}
912	};
913
914	// ### string-find
915	private static final Primitive STRING_FIND =
916	new Primitive("string-find", PACKAGE_EXT, true, "char string")
917	{
918	@Override
919	public LispObject execute(LispObject first, LispObject second)
920
921	{
922	if (first instanceof LispCharacter) {
923	final char c = ((LispCharacter)first).value;
924	AbstractString string = Lisp.checkString(second);
925	final int limit = string.length();
926	for (int i = 0; i < limit; i++) {
927	if (string.charAt(i) == c)
928	return first;
929	}
930	}
931	return NIL;
932	}
933	};
934
935	// ### simple-string-search pattern string => position
936	// Searches string for a substring that matches pattern.
937	private static final Primitive SIMPLE_STRING_SEARCH =
938	new Primitive("simple-string-search", PACKAGE_EXT, true)
939	{
940	@Override
941	public LispObject execute(LispObject first, LispObject second)
942
943	{
944	// FIXME Don't call getStringValue() here! (Just look at the chars.)
945	int index = second.getStringValue().indexOf(first.getStringValue());
946	return index >= 0 ? Fixnum.getInstance(index) : NIL;
947	}
948	};
949
950	// ### simple-string-fill string character => string
951	private static final Primitive STRING_FILL =
952	new Primitive("simple-string-fill", PACKAGE_EXT, true)
953	{
954	@Override
955	public LispObject execute(LispObject first, LispObject second)
956
957	{
958	if(first instanceof AbstractString) {
959	AbstractString s = (AbstractString) first;
960	s.fill(LispCharacter.getValue(second));
961	return first;
962	}
963	return type_error(first, Symbol.SIMPLE_STRING);
964	}
965	};
966
967	}

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

Download in other formats: