StringFunctions.java 33.9 KB
Newer Older
1 2 3 4
/*
 * StringFunctions.java
 *
 * Copyright (C) 2003-2005 Peter Graves
5
 * Copyright (C) 2010 Ville Voutilainen
6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36
 * $Id$
 *
 * This program is free software; you can redistribute it and/or
 * modify it under the terms of the GNU General Public License
 * as published by the Free Software Foundation; either version 2
 * of the License, or (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
 *
 * As a special exception, the copyright holders of this library give you
 * permission to link this library with independent modules to produce an
 * executable, regardless of the license terms of these independent
 * modules, and to copy and distribute the resulting executable under
 * terms of your choice, provided that you also meet, for each linked
 * independent module, the terms and conditions of the license of that
 * module.  An independent module is a module which is not derived from
 * or based on this library.  If you modify this library, you may extend
 * this exception to your version of the library, but you are not
 * obligated to do so.  If you do not wish to do so, delete this
 * exception statement from your version.
 */

package org.armedbear.lisp;

37
import static org.armedbear.lisp.Lisp.*;
38
import java.util.Arrays;
39
public final class StringFunctions {
40
    final static class StringIndicesAndChars {
41 42
        public AbstractString string1;
        public boolean convertCase = false;
43 44 45
        public char[] array1;
        public char[] array2;
        public int start1 = 0;
46
        public int end1 = 0;
47
        public int start2 = 0;
48
        public int end2 = 0;
49
    };
50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82
    private final static void 
        checkParams(StringIndicesAndChars indicesAndChars) {
        if (indicesAndChars.start1 < 0 
            || indicesAndChars.start1 > indicesAndChars.array1.length)
            error(new TypeError("Invalid start position " 
                                + indicesAndChars.start1 + "."));
        if (indicesAndChars.end1 < 0 
            || indicesAndChars.end1 > indicesAndChars.array1.length)
            error(new TypeError("Invalid end position " 
                                + indicesAndChars.end1 + "."));
        
        if (indicesAndChars.start1 > indicesAndChars.end1) 
            error(new TypeError("Start (" 
                                + indicesAndChars.start1 
                                + ") is greater than end (" 
                                + indicesAndChars.end1 + ")."));
        if (indicesAndChars.array2 != null) {
            if (indicesAndChars.start2 < 0 
                || indicesAndChars.start2 > indicesAndChars.array2.length)
                error(new TypeError("Invalid start2 position " 
                                    + indicesAndChars.start2 + "."));
            if (indicesAndChars.end2 < 0 
                || indicesAndChars.end2 > indicesAndChars.array2.length)
                error(new TypeError("Invalid end2 position " 
                                    + indicesAndChars.end2 + "."));
            if (indicesAndChars.start2 > indicesAndChars.end2)
                error(new TypeError("Start2 (" 
                                    + indicesAndChars.start2 
                                    + ") is greater than end2 (" 
                                    + indicesAndChars.end2 + ")."));
        }

    }
83 84 85 86
    
    private final static char upcaseIfNeeded(char c, boolean convert) {
        return convert ? LispCharacter.toUpperCase(c) : c;
    }
87

88
    final static StringIndicesAndChars
89 90
        stringIndicesAndChars(LispObject... params) {
        StringIndicesAndChars retVal = new StringIndicesAndChars();
91 92
        retVal.string1 = checkString(params[0].STRING());
        retVal.array1 = retVal.string1.getStringChars();
93
        retVal.end1 = retVal.array1.length;
94 95 96
        if (params.length == 3) {
            if (params[1] != NIL) {
                retVal.start1 = Fixnum.getValue(params[1]);
97
            }
98 99
            if (params[2] != NIL) {
                retVal.end1 = Fixnum.getValue(params[2]);
100
            }
101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116
        } else {
            retVal.array2 = params[1].STRING().getStringChars();
            retVal.end2 = retVal.array2.length;
            if (params.length > 2) {
                if (params[2] != NIL) {
                    retVal.start1 = Fixnum.getValue(params[2]);
                }
                if (params[3] != NIL) {
                    retVal.end1 = Fixnum.getValue(params[3]);
                }
                if (params[4] != NIL) {
                    retVal.start2 = Fixnum.getValue(params[4]);
                }
                if (params[5] != NIL) {
                    retVal.end2 = Fixnum.getValue(params[5]);
                }
117 118
            }
        }
119
        checkParams(retVal);
120 121 122
        return retVal;
    }

123 124 125 126 127 128 129 130 131
    // ### %%string=
    // Case sensitive.
    private static final Primitive __STRING_EQUAL = new pf___string_equal();
    private static final class pf___string_equal extends Primitive {
        pf___string_equal() {
            super("%%string=", PACKAGE_SYS, false);
        }

        @Override
132
        public LispObject execute(LispObject string1, LispObject string2)
133 134

        {
135 136
            StringIndicesAndChars chars = 
                stringIndicesAndChars(string1, string2);
137 138 139 140 141
            return Arrays.equals(chars.array1, chars.array2) ?
                T : NIL;
        };
    }

142 143
    // ### %string=
    // Case sensitive.
144
    private static final Primitive _STRING_EQUAL = new pf__string_equal();
145 146 147 148 149
    private static final class pf__string_equal extends Primitive {
        pf__string_equal() {
            super("%string=", PACKAGE_SYS, false);
        }

150
        @Override
151 152 153
        public LispObject execute(LispObject string1, LispObject string2,
                                  LispObject start1, LispObject end1,
                                  LispObject start2, LispObject end2)
154

155
        {
156
            return 
157 158 159
                (_STRING_NOT_EQUAL.execute(string1, string2, 
                                           start1, end1, 
                                           start2, end2)
160
                 == NIL) ? T : NIL;
161 162 163 164
        }
    };


165
    static final int notEqual(StringIndicesAndChars indicesAndChars) {
166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187
        int i = indicesAndChars.start1;
        int j = indicesAndChars.start2;
        while (true) {
            if (i == indicesAndChars.end1) {
                // Reached end of string1.
                if (j == indicesAndChars.end2)
                    return -1; // Strings are identical.
                return i;
            }
            if (j == indicesAndChars.end2) {
                // Reached end of string2 before end of string1.
                return i;
            }
            if (upcaseIfNeeded(indicesAndChars.array1[i],
                               indicesAndChars.convertCase)
                != upcaseIfNeeded(indicesAndChars.array2[j],
                                  indicesAndChars.convertCase))
                return i;
            ++i;
            ++j;
        }
    }
188 189
    // ### %string/=
    // Case sensitive.
190
    static final Primitive _STRING_NOT_EQUAL = new pf__string_not_equal();
191 192 193 194 195
    private static final class pf__string_not_equal extends Primitive {
        pf__string_not_equal() {
            super("%string/=", PACKAGE_SYS, true);
        }

196
        @Override
197 198 199
        public LispObject execute(LispObject string1, LispObject string2,
                                  LispObject start1, LispObject end1,
                                  LispObject start2, LispObject end2) {
200
            StringIndicesAndChars indicesAndChars = 
201 202
                stringIndicesAndChars(string1, string2, start1, end1,
                                      start2, end2);
203 204
            int tmp = notEqual(indicesAndChars);
            return (tmp >= 0) ? Fixnum.getInstance(tmp) : NIL;
205 206 207 208 209
        }
    };

    // ### %string-equal
    // Case insensitive.
210
    private static final Primitive _STRING_EQUAL_IGNORE_CASE = new pf__string_equal_ignore_case();
211 212 213 214 215
    private static final class pf__string_equal_ignore_case extends Primitive {
        pf__string_equal_ignore_case() {
            super("%string-equal", PACKAGE_SYS, true);
        }

216
        @Override
217 218 219
        public LispObject execute(LispObject string1, LispObject string2,
                                  LispObject start1, LispObject end1,
                                  LispObject start2, LispObject end2)
220

221
        {
222 223 224
            return (_STRING_NOT_EQUAL_IGNORE_CASE.execute(string1, string2, 
                                                          start1, end1, 
                                                          start2, end2) 
225
                    == NIL) ? T : NIL;
226 227 228 229
        }
    };

    // ### %string-not-equal
230
    // Case insensitive.
231
    static final Primitive _STRING_NOT_EQUAL_IGNORE_CASE = new pf__string_not_equal_ignore_case();
232 233 234 235 236
    private static final class pf__string_not_equal_ignore_case extends Primitive {
        pf__string_not_equal_ignore_case() {
            super("%string-not-equal", PACKAGE_SYS, true);
        }

237
        @Override
238 239 240
        public LispObject execute(LispObject string1, LispObject string2,
                                  LispObject start1, LispObject end1,
                                  LispObject start2, LispObject end2) {
241
            StringIndicesAndChars indicesAndChars = 
242 243
                stringIndicesAndChars(string1, string2, start1, end1,
                                      start2, end2);
244 245 246
            indicesAndChars.convertCase = true;
            int tmp = notEqual(indicesAndChars);
            return (tmp >= 0) ? Fixnum.getInstance(tmp) : NIL;
247 248 249
        }
    };

250
    static final int lessThan(StringIndicesAndChars indicesAndChars) {
251 252 253 254 255 256 257 258 259 260 261 262 263
        int i = indicesAndChars.start1;
        int j = indicesAndChars.start2;
        while (true) {
            if (i == indicesAndChars.end1) {
                // Reached end of string1.
                if (j == indicesAndChars.end2)
                    return -1; // Strings are identical.
                return i;
            }
            if (j == indicesAndChars.end2) {
                // Reached end of string2.
                return -1;
            }
264 265 266 267
            char c1 = upcaseIfNeeded(indicesAndChars.array1[i], 
                                     indicesAndChars.convertCase);
            char c2 = upcaseIfNeeded(indicesAndChars.array2[j],
                                     indicesAndChars.convertCase);
268 269 270 271 272 273 274 275 276 277 278
            if (c1 == c2) {
                ++i;
                ++j;
                continue;
            }
            if (c1 < c2)
                return (i);
            // c1 > c2
            return -1;
        }
    }
279 280 281

    // ### %string<
    // Case sensitive.
282
    private static final Primitive _STRING_LESS_THAN = new pf__string_less_than();
283 284 285 286 287
    private static final class pf__string_less_than extends Primitive {
        pf__string_less_than() {
            super("%string<", PACKAGE_SYS, true);
        }

288
        @Override
289 290 291
        public LispObject execute(LispObject string1, LispObject string2,
                                  LispObject start1, LispObject end1,
                                  LispObject start2, LispObject end2) {
292
            StringIndicesAndChars indicesAndChars = 
293 294
                stringIndicesAndChars(string1, string2, 
                                      start1, end1, start2, end2);
295 296
            int retVal = lessThan(indicesAndChars);
            return (retVal >= 0) ? Fixnum.getInstance(retVal) : NIL;
297 298 299
        }
    };

300
    static LispObject 
301 302 303 304 305 306 307 308 309 310
        swapReturnValue(int original,
                        StringIndicesAndChars indicesAndChars) {
        if (original < 0) {
            return NIL;
        }
        int delta = original - indicesAndChars.start1;
        int retVal = indicesAndChars.start2 + delta;
        return Fixnum.getInstance(retVal);
    }

311
    // ### %string>
312
    // Case sensitive.
313
    private static final Primitive _STRING_GREATER_THAN = new pf__string_greater_than();
314 315 316 317 318
    private static final class pf__string_greater_than extends Primitive {
        pf__string_greater_than() {
            super("%string>", PACKAGE_SYS, true);
        }

319
        @Override
320 321 322
        public LispObject execute(LispObject string1, LispObject string2,
                                  LispObject start1, LispObject end1,
                                  LispObject start2, LispObject end2) {
323 324
            // note the swap of the strings and lengths here..
            StringIndicesAndChars indicesAndChars = 
325 326 327
                stringIndicesAndChars(string2, string1, 
                                      start2, end2,
                                      start1, end1);
328
            int tmp = lessThan(indicesAndChars);
329
            return swapReturnValue(tmp, indicesAndChars);
330 331
        }
    };
332

333
    static final int lessThanOrEqual(StringIndicesAndChars indicesAndChars) {
334 335 336 337 338 339 340 341 342 343 344
        int i = indicesAndChars.start1;
        int j = indicesAndChars.start2;
        while (true) {
            if (i == indicesAndChars.end1) {
                // Reached end of string1.
                return i;
            }
            if (j == indicesAndChars.end2) {
                // Reached end of string2.
                return -1;
            }
345 346 347 348
            char c1 = upcaseIfNeeded(indicesAndChars.array1[i], 
                                     indicesAndChars.convertCase);
            char c2 = upcaseIfNeeded(indicesAndChars.array2[j],
                                     indicesAndChars.convertCase);
349 350 351 352 353 354 355 356 357 358 359
            if (c1 == c2) {
                ++i;
                ++j;
                continue;
            }
            if (c1 > c2)
                return -1;
            // c1 < c2
            return (i);
        }
    }
360 361
    // ### %string<=
    // Case sensitive.
362
    private static final Primitive _STRING_LE = new pf__string_le();
363 364 365 366 367
    private static final class pf__string_le extends Primitive {
        pf__string_le() {
            super("%string<=", PACKAGE_SYS, true);
        }

368
        @Override
369 370 371
        public LispObject execute(LispObject string1, LispObject string2,
                                  LispObject start1, LispObject end1,
                                  LispObject start2, LispObject end2) {
372 373

            StringIndicesAndChars indicesAndChars = 
374 375
                stringIndicesAndChars(string1, string2, 
                                      start1, end1, start2, end2);
376 377
            int retVal = lessThanOrEqual(indicesAndChars);
            return (retVal >= 0) ? Fixnum.getInstance(retVal) : NIL;
378 379 380
        }
    };

381
    // ### %string>=
382
    // Case sensitive.
383
    private static final Primitive _STRING_GE = new pf__string_ge();
384 385 386 387 388
    private static final class pf__string_ge extends Primitive {
        pf__string_ge() {
            super("%string>=", PACKAGE_SYS, true);
        }

389
        @Override
390 391 392
        public LispObject execute(LispObject string1, LispObject string2,
                                  LispObject start1, LispObject end1,
                                  LispObject start2, LispObject end2) {
393 394
            // note the swap of the strings and lengths here..
            StringIndicesAndChars indicesAndChars = 
395 396 397
                stringIndicesAndChars(string2, string1,
                                      start2, end2,
                                      start1, end1);
398
            int tmp = lessThanOrEqual(indicesAndChars);
399
            return swapReturnValue(tmp, indicesAndChars);
400 401 402
        }
    };

403

404 405
    // ### %string-lessp
    // Case insensitive.
406
    private static final Primitive _STRING_LESSP = new pf__string_lessp();
407 408 409 410 411
    private static final class pf__string_lessp extends Primitive {
        pf__string_lessp() {
            super("%string-lessp", PACKAGE_SYS, true);
        }

412
        @Override
413 414 415
        public LispObject execute(LispObject string1, LispObject string2,
                                  LispObject start1, LispObject end1,
                                  LispObject start2, LispObject end2) {
416
            StringIndicesAndChars indicesAndChars = 
417 418
                stringIndicesAndChars(string1, string2, 
                                      start1, end1, start2, end2);
419 420
            indicesAndChars.convertCase = true;
            int retVal = lessThan(indicesAndChars);
421
            return (retVal >= 0) ? Fixnum.getInstance(retVal) : NIL;
422 423 424 425 426
        }
    };

    // ### %string-greaterp
    // Case insensitive.
427
    private static final Primitive _STRING_GREATERP = new pf__string_greaterp();
428 429 430 431 432
    private static final class pf__string_greaterp extends Primitive {
        pf__string_greaterp() {
            super("%string-greaterp", PACKAGE_SYS, true);
        }

433
        @Override
434 435 436
        public LispObject execute(LispObject string1, LispObject string2,
                                  LispObject start1, LispObject end1,
                                  LispObject start2, LispObject end2) {
437 438
            // note the swap of the strings and lengths here..
            StringIndicesAndChars indicesAndChars = 
439 440 441
                stringIndicesAndChars(string2, string1,
                                      start2, end2,
                                      start1, end1);
442 443
            indicesAndChars.convertCase = true;
            int tmp = lessThan(indicesAndChars);
444
            return swapReturnValue(tmp, indicesAndChars);
445 446 447 448
        }
    };
    // ### %string-not-lessp
    // Case insensitive.
449
    private static final Primitive _STRING_NOT_LESSP = new pf__string_not_lessp();
450 451 452 453 454
    private static final class pf__string_not_lessp extends Primitive {
        pf__string_not_lessp() {
            super("%string-not-lessp", PACKAGE_SYS, true);
        }

455
        @Override
456 457 458
        public LispObject execute(LispObject string1, LispObject string2,
                                  LispObject start1, LispObject end1,
                                  LispObject start2, LispObject end2) {
459
            // note the swap of the strings and lengths here..
460
            StringIndicesAndChars indicesAndChars = 
461 462 463 464 465 466
                stringIndicesAndChars(string2, string1,
                                      start2, end2,
                                      start1, end1);
            indicesAndChars.convertCase = true;
            int tmp = lessThanOrEqual(indicesAndChars);
            return swapReturnValue(tmp, indicesAndChars);
467 468 469 470 471
        }
    };

    // ### %string-not-greaterp
    // Case insensitive.
472
    private static final Primitive _STRING_NOT_GREATERP = new pf__string_not_greaterp();
473 474 475 476 477
    private static final class pf__string_not_greaterp extends Primitive {
        pf__string_not_greaterp() {
            super("%string-not-greaterp", PACKAGE_SYS, true);
        }

478
        @Override
479 480 481
        public LispObject execute(LispObject string1, LispObject string2,
                                  LispObject start1, LispObject end1,
                                  LispObject start2, LispObject end2) {
482
            StringIndicesAndChars indicesAndChars = 
483 484 485 486 487 488
                stringIndicesAndChars(string1, string2,
                                      start1, end1,
                                      start2, end2);
            indicesAndChars.convertCase = true;
            int tmp = lessThanOrEqual(indicesAndChars);
            return (tmp >= 0) ? Fixnum.getInstance(tmp) : NIL;
489 490 491 492
        }
    };

    // ### %string-upcase
493
    private static final Primitive _STRING_UPCASE = new pf__string_upcase();
494 495 496 497 498
    private static final class pf__string_upcase extends Primitive {
        pf__string_upcase() {
            super("%string-upcase", PACKAGE_SYS, true);
        }

499
        @Override
500 501
        public LispObject execute(LispObject string, LispObject start,
                                  LispObject end)
502

503
        {
504
            StringIndicesAndChars indicesAndChars = 
505
                stringIndicesAndChars(string, start, end);
506 507 508 509 510 511 512 513 514 515 516
            char[] array = new char[indicesAndChars.array1.length];
            System.arraycopy(indicesAndChars.array1, 0,
                             array, 0,
                             indicesAndChars.start1);
            for (int i = indicesAndChars.start1; i < indicesAndChars.end1; i++)
                array[i] = LispCharacter.toUpperCase(indicesAndChars.array1[i]);
            System.arraycopy(indicesAndChars.array1, indicesAndChars.end1,
                      array, indicesAndChars.end1,
                             indicesAndChars.array1.length 
                             - indicesAndChars.end1);
            return new SimpleString(array);
517 518 519 520
        }
    };

    // ### %string-downcase
521
    private static final Primitive _STRING_DOWNCASE = new pf__string_downcase();
522 523 524 525 526
    private static final class pf__string_downcase extends Primitive {
        pf__string_downcase() {
            super("%string-downcase", PACKAGE_SYS, true);
        }

527
        @Override
528 529
        public LispObject execute(LispObject string, LispObject start,
                                  LispObject end) {
530
            StringIndicesAndChars indicesAndChars = 
531
                stringIndicesAndChars(string, start, end);
532 533 534 535 536 537 538 539 540 541 542
            char[] array = new char[indicesAndChars.array1.length];
            System.arraycopy(indicesAndChars.array1, 0,
                             array, 0,
                             indicesAndChars.start1);
            for (int i = indicesAndChars.start1; i < indicesAndChars.end1; i++)
                array[i] = LispCharacter.toLowerCase(indicesAndChars.array1[i]);
            System.arraycopy(indicesAndChars.array1, indicesAndChars.end1,
                      array, indicesAndChars.end1,
                             indicesAndChars.array1.length 
                             - indicesAndChars.end1);
            return new SimpleString(array);
543 544 545 546
        }
    };

    // ### %string-capitalize
547
    private static final Primitive _STRING_CAPITALIZE = new pf__string_capitalize();
548 549 550 551 552
    private static final class pf__string_capitalize extends Primitive {
        pf__string_capitalize() {
            super("%string-capitalize", PACKAGE_SYS, true);
        }

553
        @Override
554 555
        public LispObject execute(LispObject string, LispObject start,
                                  LispObject end)
556

557
        {
558
            StringIndicesAndChars indicesAndChars = 
559
                stringIndicesAndChars(string, start, end);
560
            char[] array = new char[indicesAndChars.array1.length];
561
            boolean lastCharWasAlphanumeric = false;
562 563 564 565 566
            System.arraycopy(indicesAndChars.array1, 0,
                             array, 0,
                             indicesAndChars.start1);
            for (int i = indicesAndChars.start1; 
                 i < indicesAndChars.end1; i++) {
567
                char c = indicesAndChars.array1[i];
568
                if (Character.isLowerCase(c)) {
569 570
                    array[i] = lastCharWasAlphanumeric ? 
                        c : LispCharacter.toUpperCase(c);
571 572
                    lastCharWasAlphanumeric = true;
                } else if (Character.isUpperCase(c)) {
573 574
                    array[i] = lastCharWasAlphanumeric ? 
                        LispCharacter.toLowerCase(c) : c;
575 576
                    lastCharWasAlphanumeric = true;
                } else {
577
                    array[i] = c;
578 579 580
                    lastCharWasAlphanumeric = Character.isDigit(c);
                }
            }
581 582 583 584 585
            System.arraycopy(indicesAndChars.array1, indicesAndChars.end1,
                      array, indicesAndChars.end1,
                             indicesAndChars.array1.length 
                             - indicesAndChars.end1);
            return new SimpleString(array);
586 587 588 589
        }
    };

    // ### %nstring-upcase
590
    private static final Primitive _NSTRING_UPCASE = new pf__nstring_upcase();
591 592 593 594 595
    private static final class pf__nstring_upcase extends Primitive {
        pf__nstring_upcase() {
            super("%nstring-upcase", PACKAGE_SYS, true);
        }

596
        @Override
597 598
        public LispObject execute(LispObject string, LispObject start,
                                  LispObject end)
599

600
        {
601
            StringIndicesAndChars indicesAndChars = 
602 603
                stringIndicesAndChars(string, start, end);
            AbstractString retString = indicesAndChars.string1; 
604
            for (int i = indicesAndChars.start1; i < indicesAndChars.end1; i++) 
605 606 607 608 609
                retString.setCharAt(i,
                                    LispCharacter.
                                    toUpperCase(
                                                retString.charAt(i)));
            return retString;
610 611 612 613
        }
    };

    // ### %nstring-downcase
614
    private static final Primitive _NSTRING_DOWNCASE = new pf__nstring_downcase();
615 616 617 618 619
    private static final class pf__nstring_downcase extends Primitive {
        pf__nstring_downcase() {
            super("%nstring-downcase", PACKAGE_SYS, true);
        }

620
        @Override
621 622
        public LispObject execute(LispObject string, LispObject start,
                                  LispObject end)
623

624
        {
625
            StringIndicesAndChars indicesAndChars = 
626 627
                stringIndicesAndChars(string, start, end);
            AbstractString retString = indicesAndChars.string1; 
628
            for (int i = indicesAndChars.start1; i < indicesAndChars.end1; i++)
629 630 631 632
                retString.setCharAt(i,
                                    LispCharacter.
                                    toLowerCase(retString.charAt(i)));
            return retString;
633 634 635 636
        }
    };

    // ### %nstring-capitalize
637
    private static final Primitive _NSTRING_CAPITALIZE = new pf__nstring_capitalize();
638 639 640 641 642
    private static final class pf__nstring_capitalize extends Primitive {
        pf__nstring_capitalize() {
            super("%nstring-capitalize", PACKAGE_SYS, true);
        }

643
        @Override
644 645
        public LispObject execute(LispObject string, LispObject start,
                                  LispObject end)
646

647
        {
648
            StringIndicesAndChars indicesAndChars = 
649
                stringIndicesAndChars(string, start, end);
650
            boolean lastCharWasAlphanumeric = false;
651
            AbstractString retString = indicesAndChars.string1; 
652 653
            for (int i = indicesAndChars.start1; 
                 i < indicesAndChars.end1; i++) {
654
                char c = retString.charAt(i);
655 656
                if (Character.isLowerCase(c)) {
                    if (!lastCharWasAlphanumeric)
657 658
                        retString.setCharAt(i,
                                            LispCharacter.toUpperCase(c));
659 660 661
                    lastCharWasAlphanumeric = true;
                } else if (Character.isUpperCase(c)) {
                    if (lastCharWasAlphanumeric)
662 663
                        retString.setCharAt(i,
                                            LispCharacter.toLowerCase(c));
664 665 666 667
                    lastCharWasAlphanumeric = true;
                } else
                    lastCharWasAlphanumeric = Character.isDigit(c);
            }
668
            return retString;
669 670 671 672
        }
    };

    // ### stringp
673
    public static final Primitive STRINGP = new pf_stringp();
674 675 676 677 678
    private static final class pf_stringp extends Primitive {
        pf_stringp() {
            super("stringp", "object");
        }

679
        @Override
680
        public LispObject execute(LispObject arg) {
681 682 683 684 685
            return arg.STRINGP();
        }
    };

    // ### simple-string-p
686
    public static final Primitive SIMPLE_STRING_P = new pf_simple_string_p();
687 688 689 690 691
    private static final class pf_simple_string_p extends Primitive {
        pf_simple_string_p() {
            super("simple-string-p", "object");
        }

692
        @Override
693
        public LispObject execute(LispObject arg) {
694 695 696 697 698 699 700
            return arg.SIMPLE_STRING_P();
        }
    };

    // ### %make-string
    // %make-string size initial-element element-type => string
    // Returns a simple string.
701
    private static final Primitive _MAKE_STRING = new pf__make_string();
702 703 704 705 706
    private static final class pf__make_string extends Primitive {
        pf__make_string() {
            super("%make-string", PACKAGE_SYS, false);
        }

707
        @Override
708 709
        public LispObject execute(LispObject size, LispObject initialElement,
                                  LispObject elementType)
710

711
        {
712
            final int n = Fixnum.getValue(size);
713
            if (n < 0 || n >= ARRAY_DIMENSION_MAX) {
714
                StringBuilder sb = new StringBuilder();
715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737
                sb.append("The size specified for this string (");
                sb.append(n);
                sb.append(')');
                if (n >= ARRAY_DIMENSION_MAX) {
                    sb.append(" is >= ARRAY-DIMENSION-LIMIT (");
                    sb.append(ARRAY_DIMENSION_MAX);
                    sb.append(").");
                } else
                    sb.append(" is negative.");
                return error(new LispError(sb.toString()));
            }
            // Ignore elementType.
            SimpleString string = new SimpleString(n);
            if (initialElement != NIL) {
                // Initial element was specified.
                char c = checkCharacter(initialElement).getValue();
                string.fill(c);
            }
            return string;
        }
    };

    // ### char
738
    private static final Primitive CHAR = new pf_char();
739 740 741 742 743
    private static final class pf_char extends Primitive {
        pf_char() {
            super(Symbol.CHAR, "string index");
        }

744
        @Override
745
        public LispObject execute(LispObject first, LispObject second)
746

747
        {
748
            return first.CHAR(Fixnum.getValue(second));
749 750 751 752
        }
    };

    // ### schar
753
    private static final Primitive SCHAR = new pf_schar();
754 755 756 757 758
    private static final class pf_schar extends Primitive {
        pf_schar() {
            super(Symbol.SCHAR, "string index");
        }

759
        @Override
760
        public LispObject execute(LispObject first, LispObject second)
761

762
        {
763
            return first.SCHAR(Fixnum.getValue(second));
764 765 766 767
        }
    };

    // ### set-char
768
    private static final Primitive SET_CHAR = new pf_set_char();
769 770 771 772 773
    private static final class pf_set_char extends Primitive {
        pf_set_char() {
            super(Symbol.SET_CHAR, "string index character");
        }

774
        @Override
775 776
        public LispObject execute(LispObject first, LispObject second,
                                  LispObject third)
777

778
        {
779
            checkString(first).setCharAt(Fixnum.getValue(second),
780
                                         LispCharacter.getValue(third));
781
            return third;
782 783 784 785
        }
    };

    // ### set-schar
786
    private static final Primitive SET_SCHAR = new pf_set_schar();
787 788 789 790 791
    private static final class pf_set_schar extends Primitive {
        pf_set_schar() {
            super(Symbol.SET_SCHAR, "string index character");
        }

792
        @Override
793 794
        public LispObject execute(LispObject first, LispObject second,
                                  LispObject third)
795

796
        {
797 798 799
            if (first instanceof SimpleString) {
                ((SimpleString)first).setCharAt(Fixnum.getValue(second),
                                                LispCharacter.getValue(third));
800 801
                return third;
            }
802
            return type_error(first, Symbol.SIMPLE_STRING);
803 804 805 806
        }
    };

    // ### string-position
807
    private static final Primitive STRING_POSITION = new pf_string_position();
808 809 810 811 812
    private static final class pf_string_position extends Primitive {
        pf_string_position() {
            super("string-position", PACKAGE_EXT, true);
        }

813
        @Override
814 815
        public LispObject execute(LispObject first, LispObject second,
                                  LispObject third)
816

817 818
        {
            char c = LispCharacter.getValue(first);
819
            AbstractString string = checkString(second);
820 821 822 823 824 825 826 827 828 829
            int start = Fixnum.getValue(third);
            for (int i = start, limit = string.length(); i < limit; i++) {
                if (string.charAt(i) == c)
                    return number(i);
            }
            return NIL;
        }
    };

    // ### string-find
830
    private static final Primitive STRING_FIND = new pf_string_find();
831 832 833 834 835
    private static final class pf_string_find extends Primitive {
        pf_string_find() {
            super("string-find", PACKAGE_EXT, true, "char string");
        }

836
        @Override
837
        public LispObject execute(LispObject first, LispObject second)
838

839 840 841
        {
            if (first instanceof LispCharacter) {
                final char c = ((LispCharacter)first).value;
842
                AbstractString string = Lisp.checkString(second);
843 844 845 846 847 848 849 850 851 852 853 854
                final int limit = string.length();
                for (int i = 0; i < limit; i++) {
                    if (string.charAt(i) == c)
                        return first;
                }
            }
            return NIL;
        }
    };

    // ### simple-string-search pattern string => position
    // Searches string for a substring that matches pattern.
855
    private static final Primitive SIMPLE_STRING_SEARCH = new pf_simple_string_search();
856 857 858 859 860
    private static final class pf_simple_string_search extends Primitive {
        pf_simple_string_search() {
            super("simple-string-search", PACKAGE_EXT, true);
        }

861
        @Override
862
        public LispObject execute(LispObject first, LispObject second)
863

864 865 866
        {
            // FIXME Don't call getStringValue() here! (Just look at the chars.)
            int index = second.getStringValue().indexOf(first.getStringValue());
867
            return index >= 0 ? Fixnum.getInstance(index) : NIL;
868 869 870 871
        }
    };

    // ### simple-string-fill string character => string
872
    private static final Primitive STRING_FILL = new pf_string_fill();
873 874 875 876 877
    private static final class pf_string_fill extends Primitive {
        pf_string_fill() {
            super("simple-string-fill", PACKAGE_EXT, true);
        }

878
        @Override
879
        public LispObject execute(LispObject first, LispObject second)
880

881
        {
882
            if (first instanceof AbstractString) {
883 884 885 886
                AbstractString s = (AbstractString) first;
                s.fill(LispCharacter.getValue(second));
                return first;
            }
887
            return type_error(first, Symbol.SIMPLE_STRING);
888 889
        }
    };
890

891
}