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

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

Remove 'throws ConditionThrowable?' method annotations:

it's an unchecked exception now, so no need to declare it thrown.
  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 18.0 KB
Line 
1/*
2 * LispCharacter.java
3 *
4 * Copyright (C) 2002-2007 Peter Graves
5 * $Id: LispCharacter.java 12254 2009-11-06 20:07:54Z ehuelsmann $
6 *
7 * This program is free software; you can redistribute it and/or
8 * modify it under the terms of the GNU General Public License
9 * as published by the Free Software Foundation; either version 2
10 * of the License, or (at your option) any later version.
11 *
12 * This program is distributed in the hope that it will be useful,
13 * but WITHOUT ANY WARRANTY; without even the implied warranty of
14 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15 * GNU General Public License for more details.
16 *
17 * You should have received a copy of the GNU General Public License
18 * along with this program; if not, write to the Free Software
19 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
20 *
21 * As a special exception, the copyright holders of this library give you
22 * permission to link this library with independent modules to produce an
23 * executable, regardless of the license terms of these independent
24 * modules, and to copy and distribute the resulting executable under
25 * terms of your choice, provided that you also meet, for each linked
26 * independent module, the terms and conditions of the license of that
27 * module.  An independent module is a module which is not derived from
28 * or based on this library.  If you modify this library, you may extend
29 * this exception to your version of the library, but you are not
30 * obligated to do so.  If you do not wish to do so, delete this
31 * exception statement from your version.
32 */
33
34package org.armedbear.lisp;
35import java.util.HashMap;
36import java.util.Map;
37
38public final class LispCharacter extends LispObject
39{
40  public static final LispCharacter[] constants;
41  public static final CharHashMap<LispCharacter> lispChars;
42
43  static
44  {
45    lispChars = new CharHashMap<LispCharacter>(LispCharacter.class,null){
46      public LispCharacter get(char c) {
47        LispCharacter lc = super.get(c);
48        if (lc==null) {
49          lc = new LispCharacter(c);
50          put(c, lc);
51        }
52        return lc;
53      }
54    };
55    constants = lispChars.constants;
56    for (int i = constants.length; i-- > 0;)
57      constants[i] = new LispCharacter((char)i);
58  }
59
60  public final char value;
61  private String name;
62  public static LispCharacter getInstance(char c)
63  {
64    try
65      {
66        return lispChars.get(c);
67      }
68    catch (ArrayIndexOutOfBoundsException e)
69      {
70        return new LispCharacter(c);
71      }
72  }
73
74  // This needs to be public for the compiler.
75  public LispCharacter(char c)
76  {
77    this.value = c;
78  }
79
80  @Override
81  public LispObject typeOf()
82  {
83    if (isStandardChar())
84      return Symbol.STANDARD_CHAR;
85    return Symbol.CHARACTER;
86  }
87
88  @Override
89  public LispObject classOf()
90  {
91    return BuiltInClass.CHARACTER;
92  }
93
94  @Override
95  public LispObject getDescription()
96  {
97    FastStringBuffer sb = new FastStringBuffer("character #\\");
98    sb.append(value);
99    sb.append(" char-code #x");
100    sb.append(Integer.toHexString(value));
101    return new SimpleString(sb);
102  }
103
104  @Override
105  public LispObject typep(LispObject type)
106  {
107    if (type == Symbol.CHARACTER)
108      return T;
109    if (type == BuiltInClass.CHARACTER)
110      return T;
111    if (type == Symbol.BASE_CHAR)
112      return T;
113    if (type == Symbol.STANDARD_CHAR)
114      return isStandardChar() ? T : NIL;
115    return super.typep(type);
116  }
117
118  @Override
119  public LispObject CHARACTERP()
120  {
121    return T;
122  }
123
124  @Override
125  public boolean characterp()
126  {
127    return true;
128  }
129
130  @Override
131  public LispObject STRING()
132  {
133    return new SimpleString(value);
134  }
135
136  private boolean isStandardChar()
137  {
138    if (value >= ' ' && value < 127)
139      return true;
140    if (value == '\n')
141      return true;
142    return false;
143  }
144
145  @Override
146  public boolean eql(char c)
147  {
148    return value == c;
149  }
150
151  @Override
152  public boolean eql(LispObject obj)
153  {
154    if (this == obj)
155      return true;
156    if (obj instanceof LispCharacter)
157      {
158        if (value == ((LispCharacter)obj).value)
159          return true;
160      }
161    return false;
162  }
163
164  @Override
165  public boolean equal(LispObject obj)
166  {
167    if (this == obj)
168      return true;
169    if (obj instanceof LispCharacter)
170      {
171        if (value == ((LispCharacter)obj).value)
172          return true;
173      }
174    return false;
175  }
176
177  @Override
178  public boolean equalp(LispObject obj)
179  {
180    if (this == obj)
181      return true;
182    if (obj instanceof LispCharacter)
183      {
184        if (value == ((LispCharacter)obj).value)
185          return true;
186        return LispCharacter.toLowerCase(value) == LispCharacter.toLowerCase(((LispCharacter)obj).value);
187      }
188    return false;
189  }
190
191  public static char getValue(LispObject obj)
192  {       
193          if (obj instanceof LispCharacter)
194        return ((LispCharacter)obj).value;
195      type_error(obj, Symbol.CHARACTER);
196        // Not reached.
197      return 0;
198  }
199
200  public final char getValue()
201  {
202    return value;
203  }
204
205  @Override
206  public Object javaInstance()
207  {
208    return Character.valueOf(value);
209  }
210
211  @Override
212  public Object javaInstance(Class c)
213  {
214    return javaInstance();
215  }
216
217  @Override
218  public int sxhash()
219  {
220    return value;
221  }
222
223  @Override
224  public int psxhash()
225  {
226    return Character.toUpperCase(value);
227  }
228
229  /** See LispObject.getStringValue() */
230  @Override
231  public String getStringValue()
232  {
233    return String.valueOf(value);
234  }
235
236  @Override
237  public final String writeToString()
238  {
239    final LispThread thread = LispThread.currentThread();
240    boolean printReadably = (Symbol.PRINT_READABLY.symbolValue(thread) != NIL);
241    // "Specifically, if *PRINT-READABLY* is true, printing proceeds as if
242    // *PRINT-ESCAPE*, *PRINT-ARRAY*, and *PRINT-GENSYM* were also true,
243    // and as if *PRINT-LENGTH*, *PRINT-LEVEL*, and *PRINT-LINES* were
244    // false."
245    boolean printEscape =
246      printReadably || (Symbol.PRINT_ESCAPE.symbolValue(thread) != NIL);
247    FastStringBuffer sb = new FastStringBuffer();
248    if (printEscape)
249      {
250        sb.append("#\\");
251        switch (value)
252          {
253          case 0:
254            sb.append("Null");
255            break;
256          case 7:
257            sb.append("Bell");
258            break;
259          case '\b':
260            sb.append("Backspace");
261            break;
262          case '\t':
263            sb.append("Tab");
264            break;
265          case '\n':
266            sb.append("Newline");
267            break;
268          case '\f':
269            sb.append("Page");
270            break;
271          case '\r':
272            sb.append("Return");
273            break;
274          case 27:
275            sb.append("Escape");
276            break;
277          case 127:
278            sb.append("Rubout");
279            break;
280    default:
281      if (name!=null)
282              sb.append(name);
283      else
284              sb.append(value);
285            break;
286          }
287      }
288    else
289      {
290        sb.append(value);
291      }
292    return sb.toString();
293  }
294
295  // ### character
296  private static final Primitive CHARACTER =
297    new Primitive(Symbol.CHARACTER, "character")
298    {
299      @Override
300      public LispObject execute(LispObject arg)
301      {
302        if (arg instanceof LispCharacter)
303          return arg;
304        if (arg instanceof AbstractString)
305          {
306            if (arg.length() == 1)
307              return ((AbstractString)arg).AREF(0);
308          }
309        else if (arg instanceof Symbol)
310          {
311            String name = ((Symbol)arg).getName();
312            if (name.length() == 1)
313              return LispCharacter.getInstance(name.charAt(0));
314          }
315        return type_error(arg, Symbol.CHARACTER_DESIGNATOR);
316      }
317    };
318
319  // ### whitespacep
320  private static final Primitive WHITESPACEP =
321    new Primitive("whitespacep", PACKAGE_SYS, true)
322    {
323      @Override
324      public LispObject execute(LispObject arg)
325      {
326          return Character.isWhitespace(LispCharacter.getValue(arg)) ? T : NIL;
327      }
328    };
329
330  // ### char-code
331  private static final Primitive CHAR_CODE =
332    new Primitive(Symbol.CHAR_CODE, "character")
333    {
334      @Override
335      public LispObject execute(LispObject arg)
336      {
337          int n = LispCharacter.getValue(arg);
338          return Fixnum.getInstance(n);
339      }
340    };
341
342  // ### char-int
343  private static final Primitive CHAR_INT =
344    new Primitive(Symbol.CHAR_INT, "character")
345    {
346      @Override
347      public LispObject execute(LispObject arg)
348      {
349          int n = LispCharacter.getValue(arg);
350          return Fixnum.getInstance(n);
351      }
352    };
353
354  // ### code-char
355  private static final Primitive CODE_CHAR =
356    new Primitive(Symbol.CODE_CHAR, "code")
357    {
358      @Override
359      public LispObject execute(LispObject arg)
360      {
361          int n = Fixnum.getValue(arg);
362          if (n < CHAR_MAX)
363            return lispChars.get((char)n);
364          else if (n <= Character.MAX_VALUE)
365            return new LispCharacter((char)n);
366              // SBCL signals a type-error here: "not of type (UNSIGNED-BYTE 8)"
367        return NIL;
368      }
369    };
370
371  // ### characterp
372  private static final Primitive CHARACTERP =
373    new Primitive(Symbol.CHARACTERP, "object")
374    {
375      @Override
376      public LispObject execute(LispObject arg)
377      {
378        return arg instanceof LispCharacter ? T : NIL;
379      }
380    };
381
382  // ### both-case-p
383  private static final Primitive BOTH_CASE_P =
384    new Primitive(Symbol.BOTH_CASE_P, "character")
385    {
386      @Override
387      public LispObject execute(LispObject arg)
388      {
389        char c = getValue(arg);
390        if (Character.isLowerCase(c) || Character.isUpperCase(c))
391          return T;
392        return NIL;
393      }
394    };
395
396  // ### lower-case-p
397  private static final Primitive LOWER_CASE_P =
398    new Primitive(Symbol.LOWER_CASE_P, "character")
399    {
400      @Override
401      public LispObject execute(LispObject arg)
402      {
403        return Character.isLowerCase(getValue(arg)) ? T : NIL;
404      }
405    };
406
407  // ### upper-case-p
408  private static final Primitive UPPER_CASE_P =
409    new Primitive(Symbol.UPPER_CASE_P, "character")
410    {
411      @Override
412      public LispObject execute(LispObject arg)
413      {
414        return Character.isUpperCase(getValue(arg)) ? T : NIL;
415      }
416    };
417
418  // ### char-downcase
419  private static final Primitive CHAR_DOWNCASE =
420    new Primitive(Symbol.CHAR_DOWNCASE, "character")
421    {
422      @Override
423      public LispObject execute(LispObject arg)
424      {
425          final char c = LispCharacter.getValue(arg);
426          if (c < 128)
427           return constants[LOWER_CASE_CHARS[c]];
428        return LispCharacter.getInstance(toLowerCase(c));
429      }
430    };
431
432  // ### char-upcase
433  private static final Primitive CHAR_UPCASE =
434    new Primitive(Symbol.CHAR_UPCASE, "character")
435    {
436      @Override
437      public LispObject execute(LispObject arg)
438      {
439        final char c;
440        c = LispCharacter.getValue(arg);
441        if (c < 128)
442          return constants[UPPER_CASE_CHARS[c]];
443        return LispCharacter.getInstance(toUpperCase(c));
444      }
445    };
446
447  // ### digit-char
448  private static final Primitive DIGIT_CHAR =
449    new Primitive(Symbol.DIGIT_CHAR, "weight &optional radix")
450    {
451      @Override
452      public LispObject execute(LispObject arg)
453      {
454          if (arg instanceof Bignum)
455              return NIL;
456
457          int weight = Fixnum.getValue(arg);
458        if (weight < 10)
459          return constants['0'+weight];
460        return NIL;
461      }
462      @Override
463      public LispObject execute(LispObject first, LispObject second)
464
465      {
466        int radix;
467        if (second instanceof Fixnum)
468            radix = ((Fixnum)second).value;
469        else
470            radix = -1;
471       
472        if (radix < 2 || radix > 36)
473          return type_error(second,
474                                 list(Symbol.INTEGER, Fixnum.TWO,
475                                       Fixnum.constants[36]));
476        if (first instanceof Bignum)
477            return NIL;
478        int weight = Fixnum.getValue(first);
479        if (weight >= radix)
480          return NIL;
481        if (weight < 10)
482          return constants['0' + weight];
483        return constants['A' + weight - 10];
484      }
485    };
486
487  // ### digit-char-p char &optional radix => weight
488  private static final Primitive DIGIT_CHAR_P =
489    new Primitive(Symbol.DIGIT_CHAR_P, "char &optional radix")
490    {
491      @Override
492      public LispObject execute(LispObject arg)
493      {
494          final int n = Character.digit(LispCharacter.getValue(arg), 10);
495          return n < 0 ? NIL : Fixnum.getInstance(n);
496      }
497      @Override
498      public LispObject execute(LispObject first, LispObject second)
499
500      {
501        char c;
502            c = LispCharacter.getValue(first);
503        if (second instanceof Fixnum)
504          {
505            int radix = ((Fixnum)second).value;
506            if (radix >= 2 && radix <= 36)
507              {
508                int n = Character.digit(c, radix);
509                return n < 0 ? NIL : Fixnum.constants[n];
510              }
511          }
512        return type_error(second,
513                               list(Symbol.INTEGER, Fixnum.TWO,
514                                     Fixnum.constants[36]));
515      }
516    };
517
518  // ### standard-char-p
519  private static final Primitive STANDARD_CHAR_P =
520    new Primitive(Symbol.STANDARD_CHAR_P, "character")
521    {
522      @Override
523      public LispObject execute(LispObject arg)
524      {
525          return checkCharacter(arg).isStandardChar() ? T : NIL;
526      }
527    };
528
529  // ### graphic-char-p
530  private static final Primitive GRAPHIC_CHAR_P =
531    new Primitive(Symbol.GRAPHIC_CHAR_P, "char")
532    {
533      @Override
534      public LispObject execute(LispObject arg)
535      {
536          char c = LispCharacter.getValue(arg);
537          if (c >= ' ' && c < 127)
538            return T;
539          return Character.isISOControl(c) ? NIL : T;
540      }
541    };
542
543  // ### alpha-char-p
544  private static final Primitive ALPHA_CHAR_P =
545    new Primitive(Symbol.ALPHA_CHAR_P, "character")
546    {
547      @Override
548      public LispObject execute(LispObject arg)
549      {
550          return Character.isLetter(LispCharacter.getValue(arg)) ? T : NIL;
551      }
552    };
553
554  // ### alphanumericp
555  private static final Primitive ALPHANUMERICP =
556    new Primitive(Symbol.ALPHANUMERICP, "character")
557    {
558      @Override
559      public LispObject execute(LispObject arg)
560      {
561          return Character.isLetterOrDigit(LispCharacter.getValue(arg)) ? T : NIL;
562      }
563    };
564
565  public static final int nameToChar(String s)
566  {
567    String lower = s.toLowerCase();
568    LispCharacter lc = namedToChar.get(lower);
569    if (lc!=null) return lc.value;
570    if (lower.equals("null"))
571      return 0;
572    if (lower.equals("bell"))
573      return 7;
574    if (lower.equals("backspace"))
575      return '\b';
576    if (lower.equals("tab"))
577      return '\t';
578    if (lower.equals("linefeed"))
579      return '\n';
580    if (lower.equals("newline"))
581      return '\n';
582    if (lower.equals("page"))
583      return '\f';
584    if (lower.equals("return"))
585      return '\r';
586    if (lower.equals("escape"))
587        return 27;
588    if (lower.equals("space"))
589      return ' ';
590    if (lower.equals("rubout"))
591      return 127;
592    // Unknown.
593    return -1;
594  }
595
596  // ### name-char
597  private static final Primitive NAME_CHAR =
598    new Primitive(Symbol.NAME_CHAR, "name")
599    {
600      @Override
601      public LispObject execute(LispObject arg)
602      {
603        String s = arg.STRING().getStringValue();
604        int n = nameToChar(s);
605        return n >= 0 ? LispCharacter.getInstance((char)n) : NIL;
606      }
607    };
608
609  public static final String charToName(char c)
610  {
611    switch (c)
612      {
613      case 0:
614        return "Null";
615      case 7:
616        return "Bell";
617      case '\b':
618        return "Backspace";
619      case '\t':
620        return "Tab";
621      case '\n':
622        return "Newline";
623      case '\f':
624        return "Page";
625      case '\r':
626        return "Return";
627      case 27:
628        return "Escape";
629      case ' ':
630        return "Space";
631      case 127:
632        return "Rubout";
633      }
634    if (c<0 || c>255) return null;
635    return lispChars.get(c).name;
636  }
637
638  // ### char-name
639  private static final Primitive CHAR_NAME =
640    new Primitive(Symbol.CHAR_NAME, "character")
641    {
642      @Override
643      public LispObject execute(LispObject arg)
644      {
645        String name = charToName(LispCharacter.getValue(arg));
646        return name != null ? new SimpleString(name) : NIL;
647      }
648    };
649
650  public static final char toUpperCase(char c)
651  {
652    if (c < 128)
653      return UPPER_CASE_CHARS[c];
654    return Character.toUpperCase(c);
655  }
656
657  static int maxNamedChar = 0; 
658  static Map<String, LispCharacter> namedToChar = new HashMap<String, LispCharacter>(); 
659 
660  static void setCharNames(int i, String[] string) { 
661    int settingChar = i; 
662    int index = 0; 
663    int stringLen = string.length; 
664    while(stringLen-->0) { 
665      setCharName(settingChar,string[index]); 
666      index++; 
667      settingChar++; 
668    } 
669    if (maxNamedChar<settingChar) maxNamedChar = settingChar; 
670  } 
671 
672  static void setCharName(int settingChar, String string) { 
673    LispCharacter c = lispChars.get((char)settingChar); 
674    c.name = string; 
675    namedToChar.put(string.toLowerCase(), c); 
676  } 
677   
678  static { 
679   new CharNameMaker0(); 
680  } 
681   
682  static class CharNameMaker0{ 
683    { 
684      setCharNames(0,new String[]{"Null", "Soh", "Stx", "Etx", "Eot", "Enq", "Ack", "Bell", "Backspace", "Tab", "Newline", "Vt", "Page", "Return", "So", "Si", "Dle", "Dc1", "Dc2", "Dc3", "Dc4", "Nak", "Syn", "Etb", "Can", "Em", "Sub", "Escape", "Fs", "Gs", "Rs", "Us"}); 
685      setCharNames(128,new String[]{"U0080", "U0081", "U0082", "U0083", "U0084", "U0085", "U0086", "U0087", "U0088", "U0089", "U008a", "U008b", "U008c", "U008d", "U008e", "U008f", "U0090", "U0091", "U0092", "U0093", "U0094", "U0095", "U0096", "U0097", "U0098", "U0099", "U009a", "U009b", "U009c", "U009d", "U009e", "U009f"}); 
686    } 
687  } 
688
689  private static final char[] UPPER_CASE_CHARS = new char[128];
690
691  static
692  {
693    for (int i = UPPER_CASE_CHARS.length; i-- > 0;)
694      UPPER_CASE_CHARS[i] = Character.toUpperCase((char)i);
695  }
696
697  public static final char toLowerCase(char c)
698  {
699    if (c < 128)
700      return LOWER_CASE_CHARS[c];
701    return Character.toLowerCase(c);
702  }
703
704  private static final char[] LOWER_CASE_CHARS = new char[128];
705
706  static
707  {
708    for (int i = LOWER_CASE_CHARS.length; i-- > 0;)
709      LOWER_CASE_CHARS[i] = Character.toLowerCase((char)i);
710  }
711}
Note: See TracBrowser for help on using the repository browser.