1 /* 2 * Readtable.java 3 * 4 * Copyright (C) 2003-2007 Peter Graves 5 * $Id$ 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 import static org.armedbear.lisp.Lisp.*; 37 import java.util.Iterator; 38 39 public class Readtable extends LispObject 40 { 41 public static final byte SYNTAX_TYPE_CONSTITUENT = 0; 42 public static final byte SYNTAX_TYPE_WHITESPACE = 1; 43 public static final byte SYNTAX_TYPE_TERMINATING_MACRO = 2; 44 public static final byte SYNTAX_TYPE_NON_TERMINATING_MACRO = 3; 45 public static final byte SYNTAX_TYPE_SINGLE_ESCAPE = 4; 46 public static final byte SYNTAX_TYPE_MULTIPLE_ESCAPE = 5; 47 48 protected final CharHashMap<Byte> syntax = new CharHashMap<Byte>(Byte.class,SYNTAX_TYPE_CONSTITUENT); 49 protected final CharHashMap<LispObject> readerMacroFunctions = new CharHashMap<LispObject>(LispObject.class,null); 50 protected final CharHashMap<DispatchTable> dispatchTables = new CharHashMap<DispatchTable>(DispatchTable.class,null); 51 52 protected LispObject readtableCase; 53 Readtable()54 public Readtable() 55 { 56 initialize(); 57 } 58 initialize()59 protected void initialize() 60 { 61 Byte[] syntax = this.syntax.constants; 62 syntax[9] = SYNTAX_TYPE_WHITESPACE; // tab 63 syntax[10] = SYNTAX_TYPE_WHITESPACE; // linefeed 64 syntax[12] = SYNTAX_TYPE_WHITESPACE; // form feed 65 syntax[13] = SYNTAX_TYPE_WHITESPACE; // return 66 syntax[' '] = SYNTAX_TYPE_WHITESPACE; 67 68 syntax['"'] = SYNTAX_TYPE_TERMINATING_MACRO; 69 syntax['\''] = SYNTAX_TYPE_TERMINATING_MACRO; 70 syntax['('] = SYNTAX_TYPE_TERMINATING_MACRO; 71 syntax[')'] = SYNTAX_TYPE_TERMINATING_MACRO; 72 syntax[','] = SYNTAX_TYPE_TERMINATING_MACRO; 73 syntax[';'] = SYNTAX_TYPE_TERMINATING_MACRO; 74 syntax['`'] = SYNTAX_TYPE_TERMINATING_MACRO; 75 76 syntax['#'] = SYNTAX_TYPE_NON_TERMINATING_MACRO; 77 78 syntax['\\'] = SYNTAX_TYPE_SINGLE_ESCAPE; 79 syntax['|'] = SYNTAX_TYPE_MULTIPLE_ESCAPE; 80 81 LispObject[] readerMacroFunctions = this.readerMacroFunctions.constants; 82 readerMacroFunctions[';'] = LispReader.READ_COMMENT; 83 readerMacroFunctions['"'] = LispReader.READ_STRING; 84 readerMacroFunctions['('] = LispReader.READ_LIST; 85 readerMacroFunctions[')'] = LispReader.READ_RIGHT_PAREN; 86 readerMacroFunctions['\''] = LispReader.READ_QUOTE; 87 readerMacroFunctions['#'] = LispReader.READ_DISPATCH_CHAR; 88 89 // BACKQUOTE-MACRO and COMMA-MACRO are defined in backquote.lisp. 90 readerMacroFunctions['`'] = Symbol.BACKQUOTE_MACRO; 91 readerMacroFunctions[','] = Symbol.COMMA_MACRO; 92 93 DispatchTable dt = new DispatchTable(); 94 LispObject[] dtfunctions = dt.functions.constants; 95 dtfunctions['('] = LispReader.SHARP_LEFT_PAREN; 96 dtfunctions['*'] = LispReader.SHARP_STAR; 97 dtfunctions['.'] = LispReader.SHARP_DOT; 98 dtfunctions[':'] = LispReader.SHARP_COLON; 99 dtfunctions['A'] = LispReader.SHARP_A; 100 dtfunctions['B'] = LispReader.SHARP_B; 101 dtfunctions['C'] = LispReader.SHARP_C; 102 dtfunctions['O'] = LispReader.SHARP_O; 103 dtfunctions['P'] = LispReader.SHARP_P; 104 dtfunctions['R'] = LispReader.SHARP_R; 105 dtfunctions['S'] = LispReader.SHARP_S; 106 dtfunctions['X'] = LispReader.SHARP_X; 107 dtfunctions['\''] = LispReader.SHARP_QUOTE; 108 dtfunctions['\\'] = LispReader.SHARP_BACKSLASH; 109 dtfunctions['|'] = LispReader.SHARP_VERTICAL_BAR; 110 dtfunctions[')'] = LispReader.SHARP_ILLEGAL; 111 dtfunctions['<'] = LispReader.SHARP_ILLEGAL; 112 dtfunctions[' '] = LispReader.SHARP_ILLEGAL; 113 dtfunctions[8] = LispReader.SHARP_ILLEGAL; // backspace 114 dtfunctions[9] = LispReader.SHARP_ILLEGAL; // tab 115 dtfunctions[10] = LispReader.SHARP_ILLEGAL; // newline, linefeed 116 dtfunctions[12] = LispReader.SHARP_ILLEGAL; // page 117 dtfunctions[13] = LispReader.SHARP_ILLEGAL; // return 118 119 dispatchTables.constants['#'] = dt; 120 121 readtableCase = Keyword.UPCASE; 122 } 123 Readtable(LispObject obj)124 public Readtable(LispObject obj) 125 { 126 Readtable rt; 127 if (obj == NIL) 128 rt = checkReadtable(STANDARD_READTABLE.symbolValue()); 129 else 130 rt = checkReadtable(obj); 131 synchronized (rt) 132 { 133 copyReadtable(rt, this); 134 } 135 } 136 137 // FIXME synchronization copyReadtable(Readtable from, Readtable to)138 static void copyReadtable(Readtable from, Readtable to) 139 { 140 Iterator<Character> charIterator = from.syntax.getCharIterator(); 141 while (charIterator.hasNext()) { 142 char c = charIterator.next(); 143 Byte dt = from.syntax.get(c); 144 if (dt!=null) { 145 to.syntax.put(c, dt); 146 } else { 147 to.syntax.put(c, null); 148 } 149 } 150 charIterator = from.readerMacroFunctions.getCharIterator(); 151 while (charIterator.hasNext()) { 152 char c = charIterator.next(); 153 LispObject dt = from.readerMacroFunctions.get(c); 154 if (dt!=null) { 155 to.readerMacroFunctions.put(c, dt); 156 } else { 157 to.readerMacroFunctions.put(c, null); 158 } 159 } 160 charIterator = from.dispatchTables.getCharIterator(); 161 while (charIterator.hasNext()) { 162 char c = charIterator.next(); 163 DispatchTable dt = from.dispatchTables.get(c); 164 if (dt!=null) { 165 to.dispatchTables.put(c, new DispatchTable(dt)); 166 } else { 167 to.dispatchTables.put(c, null); 168 } 169 } 170 to.readtableCase = from.readtableCase; 171 } 172 173 @Override typeOf()174 public final LispObject typeOf() 175 { 176 return Symbol.READTABLE; 177 } 178 179 @Override classOf()180 public final LispObject classOf() 181 { 182 return BuiltInClass.READTABLE; 183 } 184 185 @Override typep(LispObject type)186 public final LispObject typep(LispObject type) 187 { 188 if (type == Symbol.READTABLE) 189 return T; 190 if (type == BuiltInClass.READTABLE) 191 return T; 192 return super.typep(type); 193 } 194 getReadtableCase()195 public final LispObject getReadtableCase() 196 { 197 return readtableCase; 198 } 199 isWhitespace(char c)200 public final boolean isWhitespace(char c) 201 { 202 return getSyntaxType(c) == SYNTAX_TYPE_WHITESPACE; 203 } 204 getSyntaxType(char c)205 public final byte getSyntaxType(char c) 206 { 207 return syntax.get(c); 208 } 209 isInvalid(char c)210 public final boolean isInvalid(char c) 211 { 212 switch (c) 213 { 214 case 8: 215 case 9: 216 case 10: 217 case 12: 218 case 13: 219 case 32: 220 case 127: 221 return true; 222 default: 223 return false; 224 } 225 } 226 checkInvalid(char c, Stream stream)227 public final void checkInvalid(char c, Stream stream) 228 { 229 // "... no mechanism is provided for changing the constituent trait of a 230 // character." (2.1.4.2) 231 if (isInvalid(c)) 232 { 233 String name = LispCharacter.charToName(c); 234 StringBuilder sb = new StringBuilder("Invalid character"); 235 if (name != null) 236 { 237 sb.append(" #\\"); 238 sb.append(name); 239 } 240 error(new ReaderError(sb.toString(), stream)); 241 } 242 } 243 getReaderMacroFunction(char c)244 public final LispObject getReaderMacroFunction(char c) 245 { 246 return readerMacroFunctions.get(c); 247 } 248 getMacroCharacter(char c)249 final LispObject getMacroCharacter(char c) 250 { 251 LispObject function = getReaderMacroFunction(c); 252 LispObject non_terminating_p; 253 if (function != null) 254 { 255 if (syntax.get(c) == SYNTAX_TYPE_NON_TERMINATING_MACRO) 256 non_terminating_p = T; 257 else 258 non_terminating_p = NIL; 259 } 260 else 261 { 262 function = NIL; 263 non_terminating_p = NIL; 264 } 265 return LispThread.currentThread().setValues(function, non_terminating_p); 266 } 267 makeDispatchMacroCharacter(char dispChar, LispObject non_terminating_p)268 final void makeDispatchMacroCharacter(char dispChar, LispObject non_terminating_p) 269 { 270 byte syntaxType; 271 if (non_terminating_p != NIL) 272 syntaxType = SYNTAX_TYPE_NON_TERMINATING_MACRO; 273 else 274 syntaxType = SYNTAX_TYPE_TERMINATING_MACRO; 275 // FIXME synchronization 276 syntax.put(dispChar,syntaxType); 277 readerMacroFunctions.put(dispChar, LispReader.READ_DISPATCH_CHAR); 278 dispatchTables.put(dispChar, new DispatchTable()); 279 } 280 getDispatchMacroCharacter(char dispChar, char subChar)281 public final LispObject getDispatchMacroCharacter(char dispChar, char subChar) 282 283 { 284 DispatchTable dispatchTable = dispatchTables.get(dispChar); 285 if (dispatchTable == null) 286 { 287 LispCharacter c = LispCharacter.getInstance(dispChar); 288 return error(new LispError(c.princToString() + 289 " is not a dispatch character.")); 290 } 291 LispObject function = 292 dispatchTable.functions.get(LispCharacter.toUpperCase(subChar)); 293 return (function != null) ? function : NIL; 294 } 295 setDispatchMacroCharacter(char dispChar, char subChar, LispObject function)296 public final void setDispatchMacroCharacter(char dispChar, char subChar, 297 LispObject function) 298 299 { 300 DispatchTable dispatchTable = dispatchTables.get(dispChar); 301 if (dispatchTable == null) 302 { 303 LispCharacter c = LispCharacter.getInstance(dispChar); 304 error(new LispError(c.princToString() + 305 " is not a dispatch character.")); 306 } 307 dispatchTable.functions.put(LispCharacter.toUpperCase(subChar), function); 308 } 309 310 protected static class DispatchTable 311 { 312 protected final CharHashMap<LispObject> functions; 313 DispatchTable()314 public DispatchTable() 315 { 316 functions = new CharHashMap<LispObject>(LispObject.class,null); 317 } 318 319 @SuppressWarnings("unchecked") DispatchTable(DispatchTable dt)320 public DispatchTable(DispatchTable dt) 321 { 322 functions = (CharHashMap<LispObject>) dt.functions.clone(); 323 } 324 } 325 326 // ### readtablep 327 private static final Primitive READTABLEP = 328 new Primitive("readtablep", "object") 329 { 330 @Override 331 public LispObject execute(LispObject arg) 332 { 333 return arg instanceof Readtable ? T : NIL; 334 } 335 }; 336 337 // ### copy-readtable 338 private static final Primitive COPY_READTABLE = 339 new Primitive("copy-readtable", "&optional from-readtable to-readtable") 340 { 341 @Override 342 public LispObject execute() 343 { 344 return new Readtable(currentReadtable()); 345 } 346 347 @Override 348 public LispObject execute(LispObject arg) 349 { 350 return new Readtable(arg); 351 } 352 353 @Override 354 public LispObject execute(LispObject first, LispObject second) 355 356 { 357 Readtable from = designator_readtable(first); 358 if (second == NIL) 359 return new Readtable(from); 360 Readtable to = checkReadtable(second); 361 copyReadtable(from, to); 362 return to; 363 } 364 }; 365 366 // ### get-macro-character char &optional readtable 367 // => function, non-terminating-p 368 private static final Primitive GET_MACRO_CHARACTER = 369 new Primitive("get-macro-character", "char &optional readtable") 370 { 371 @Override 372 public LispObject execute(LispObject arg) 373 { 374 char c = LispCharacter.getValue(arg); 375 Readtable rt = currentReadtable(); 376 return rt.getMacroCharacter(c); 377 } 378 379 @Override 380 public LispObject execute(LispObject first, LispObject second) 381 382 { 383 char c = LispCharacter.getValue(first); 384 Readtable rt = designator_readtable(second); 385 return rt.getMacroCharacter(c); 386 } 387 }; 388 389 // ### set-macro-character char new-function &optional non-terminating-p readtable 390 // => t 391 private static final Primitive SET_MACRO_CHARACTER = 392 new Primitive("set-macro-character", 393 "char new-function &optional non-terminating-p readtable") 394 { 395 @Override 396 public LispObject execute(LispObject first, LispObject second) 397 398 { 399 return execute(first, second, NIL, currentReadtable()); 400 } 401 402 @Override 403 public LispObject execute(LispObject first, LispObject second, 404 LispObject third) 405 406 { 407 return execute(first, second, third, currentReadtable()); 408 } 409 410 @Override 411 public LispObject execute(LispObject first, LispObject second, 412 LispObject third, LispObject fourth) 413 414 { 415 char c = LispCharacter.getValue(first); 416 final LispObject designator; 417 if (second instanceof Function 418 || second instanceof FuncallableStandardObject) 419 designator = second; 420 else if (second instanceof Symbol) 421 designator = second; 422 else 423 return error(new LispError(second.princToString() + 424 " does not designate a function.")); 425 byte syntaxType; 426 if (third != NIL) 427 syntaxType = SYNTAX_TYPE_NON_TERMINATING_MACRO; 428 else 429 syntaxType = SYNTAX_TYPE_TERMINATING_MACRO; 430 Readtable rt = designator_readtable(fourth); 431 // REVIEW synchronization 432 rt.syntax.put(c, syntaxType); 433 rt.readerMacroFunctions.put(c, designator); 434 return T; 435 } 436 }; 437 438 // ### make-dispatch-macro-character char &optional non-terminating-p readtable 439 // => t 440 private static final Primitive MAKE_DISPATCH_MACRO_CHARACTER = 441 new Primitive("make-dispatch-macro-character", 442 "char &optional non-terminating-p readtable") 443 { 444 @Override 445 public LispObject execute(LispObject[] args) 446 { 447 if (args.length < 1 || args.length > 3) 448 return error(new WrongNumberOfArgumentsException(this, 1, 3)); 449 char dispChar = LispCharacter.getValue(args[0]); 450 LispObject non_terminating_p; 451 if (args.length > 1) 452 non_terminating_p = args[1]; 453 else 454 non_terminating_p = NIL; 455 Readtable readtable; 456 if (args.length == 3) 457 readtable = checkReadtable(args[2]); 458 else 459 readtable = currentReadtable(); 460 readtable.makeDispatchMacroCharacter(dispChar, non_terminating_p); 461 return T; 462 } 463 }; 464 465 // ### get-dispatch-macro-character disp-char sub-char &optional readtable 466 // => function 467 private static final Primitive GET_DISPATCH_MACRO_CHARACTER = 468 new Primitive("get-dispatch-macro-character", 469 "disp-char sub-char &optional readtable") 470 { 471 @Override 472 public LispObject execute(LispObject[] args) 473 { 474 if (args.length < 2 || args.length > 3) 475 return error(new WrongNumberOfArgumentsException(this, 1, 3)); 476 char dispChar = LispCharacter.getValue(args[0]); 477 char subChar = LispCharacter.getValue(args[1]); 478 Readtable readtable; 479 if (args.length == 3) 480 readtable = designator_readtable(args[2]); 481 else 482 readtable = currentReadtable(); 483 return readtable.getDispatchMacroCharacter(dispChar, subChar); 484 } 485 }; 486 487 // ### set-dispatch-macro-character disp-char sub-char new-function &optional readtable 488 // => t 489 private static final Primitive SET_DISPATCH_MACRO_CHARACTER = 490 new Primitive("set-dispatch-macro-character", 491 "disp-char sub-char new-function &optional readtable") 492 { 493 @Override 494 public LispObject execute(LispObject[] args) 495 { 496 if (args.length < 3 || args.length > 4) 497 return error(new WrongNumberOfArgumentsException(this, 3, 4)); 498 char dispChar = LispCharacter.getValue(args[0]); 499 char subChar = LispCharacter.getValue(args[1]); 500 LispObject function = coerceToFunction(args[2]); 501 Readtable readtable; 502 if (args.length == 4) 503 readtable = designator_readtable(args[3]); 504 else 505 readtable = currentReadtable(); 506 readtable.setDispatchMacroCharacter(dispChar, subChar, function); 507 return T; 508 } 509 }; 510 511 // ### set-syntax-from-char to-char from-char &optional to-readtable from-readtable 512 // => t 513 private static final Primitive SET_SYNTAX_FROM_CHAR = 514 new Primitive("set-syntax-from-char", 515 "to-char from-char &optional to-readtable from-readtable") 516 { 517 @Override 518 public LispObject execute(LispObject[] args) 519 { 520 if (args.length < 2 || args.length > 4) 521 return error(new WrongNumberOfArgumentsException(this, 2, 4)); 522 char toChar = LispCharacter.getValue(args[0]); 523 char fromChar = LispCharacter.getValue(args[1]); 524 Readtable toReadtable; 525 if (args.length > 2) 526 toReadtable = checkReadtable(args[2]); 527 else 528 toReadtable = currentReadtable(); 529 Readtable fromReadtable; 530 if (args.length > 3) 531 fromReadtable = designator_readtable(args[3]); 532 else 533 fromReadtable = checkReadtable(STANDARD_READTABLE.symbolValue()); 534 // REVIEW synchronization 535 toReadtable.syntax.put(toChar, fromReadtable.syntax.get(fromChar)); 536 toReadtable.readerMacroFunctions.put(toChar, 537 fromReadtable.readerMacroFunctions.get(fromChar)); 538 // "If the character is a dispatching macro character, its entire 539 // dispatch table of reader macro functions is copied." 540 DispatchTable found = fromReadtable.dispatchTables.get(fromChar); 541 if (found!=null) 542 toReadtable.dispatchTables.put(toChar, new DispatchTable(found)); 543 else 544 // Don't leave behind dispatch tables when fromChar 545 // doesn't have one 546 toReadtable.dispatchTables.put(toChar, null); 547 return T; 548 } 549 }; 550 551 // ### readtable-case readtable => mode 552 private static final Primitive READTABLE_CASE = 553 new Primitive("readtable-case", "readtable") 554 { 555 @Override 556 public LispObject execute(LispObject arg) 557 { 558 return checkReadtable(arg).readtableCase; 559 } 560 }; 561 562 // ### %set-readtable-case readtable new-mode => new-mode 563 private static final Primitive _SET_READTABLE_CASE = 564 new Primitive("%set-readtable-case", PACKAGE_SYS, false, 565 "readtable new-mode") 566 { 567 @Override 568 public LispObject execute(LispObject first, LispObject second) 569 570 { 571 final Readtable readtable = checkReadtable(first); 572 if (second == Keyword.UPCASE || second == Keyword.DOWNCASE || 573 second == Keyword.INVERT || second == Keyword.PRESERVE) 574 { 575 readtable.readtableCase = second; 576 return second; 577 } 578 return type_error(second, list(Symbol.MEMBER, 579 Keyword.INVERT, 580 Keyword.PRESERVE, 581 Keyword.DOWNCASE, 582 Keyword.UPCASE)); 583 } 584 }; 585 } 586