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

Last change on this file was 13440, checked in by ehuelsmann, 14 years ago

Rename writeToString() to printObject() since that's what it's being used for.
Additionally, create princToString() for use in error messages, making the

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