Many resources are needed to download a project. Please understand that we have to compensate our server costs. Thank you in advance.
Project price only 1 $
You can buy this project and download/modify it how often you want.
org.armedbear.lisp.Stream Maven / Gradle / Ivy
/*
* Stream.java
*
* Copyright (C) 2003-2007 Peter Graves
* $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;
import static org.armedbear.lisp.Lisp.*;
import java.io.BufferedInputStream;
import java.io.BufferedOutputStream;
import java.io.IOException;
import java.io.InputStream;
import java.io.OutputStream;
import java.io.OutputStreamWriter;
import java.io.PrintWriter;
import java.io.PushbackReader;
import java.io.Reader;
import java.io.StringWriter;
import java.io.Writer;
import java.math.BigInteger;
import java.nio.charset.Charset;
import java.util.BitSet;
import java.util.List;
import java.util.LinkedList;
import java.util.SortedMap;
import java.util.Set;
import org.armedbear.lisp.util.DecodingReader;
/** The stream class
*
* A base class for all Lisp built-in streams.
*
*/
public class Stream extends StructureObject {
protected LispObject elementType;
protected boolean isInputStream;
protected boolean isOutputStream;
protected boolean isCharacterStream;
protected boolean isBinaryStream;
private boolean pastEnd = false;
private boolean interactive;
private boolean open = true;
// Character input.
protected PushbackReader reader;
protected int offset;
protected int lineNumber;
// Character output.
private Writer writer;
/** The number of characters on the current line of output
*
* Used to determine whether additional line feeds are
* required when calling FRESH-LINE
*/
protected int charPos;
public enum EolStyle {
RAW,
CR,
CRLF,
LF
}
static final protected Symbol keywordDefault = internKeyword("DEFAULT");
static final private Symbol keywordCodePage = internKeyword("CODE-PAGE");
static final private Symbol keywordID = internKeyword("ID");
static final private Symbol keywordEolStyle = internKeyword("EOL-STYLE");
static final private Symbol keywordCR = internKeyword("CR");
static final private Symbol keywordLF = internKeyword("LF");
static final private Symbol keywordCRLF = internKeyword("CRLF");
static final private Symbol keywordRAW = internKeyword("RAW");
public final static EolStyle platformEolStyle = Utilities.isPlatformWindows ? EolStyle.CRLF : EolStyle.LF;
protected EolStyle eolStyle = platformEolStyle;
protected char eolChar = (eolStyle == EolStyle.CR) ? '\r' : '\n';
protected LispObject externalFormat = keywordDefault;
protected String encoding = null;
protected char lastChar = 0;
// Binary input.
private InputStream in;
// Binary output.
private OutputStream out;
protected Stream(Symbol structureClass) {
super(structureClass);
}
public Stream(Symbol structureClass, InputStream stream) {
this(structureClass);
initAsBinaryInputStream(stream);
}
public Stream(Symbol structureClass, Reader r) {
this(structureClass);
initAsCharacterInputStream(r);
}
public Stream(Symbol structureClass, OutputStream stream) {
this(structureClass);
initAsBinaryOutputStream(stream);
}
public Stream(Symbol structureClass, Writer w) {
this(structureClass);
initAsCharacterOutputStream(w);
}
public Stream(Symbol structureClass, InputStream inputStream, LispObject elementType) {
this(structureClass, inputStream, elementType, keywordDefault);
}
// Input stream constructors.
public Stream(Symbol structureClass, InputStream inputStream,
LispObject elementType, LispObject format) {
this(structureClass);
this.elementType = elementType;
setExternalFormat(format);
if (elementType == Symbol.CHARACTER || elementType == Symbol.BASE_CHAR) {
Reader r =
new DecodingReader(inputStream, 4096,
(encoding == null)
? Charset.defaultCharset()
: Charset.forName(encoding));
initAsCharacterInputStream(r);
} else {
isBinaryStream = true;
InputStream stream = new BufferedInputStream(inputStream);
initAsBinaryInputStream(stream);
}
}
public Stream(Symbol structureClass, InputStream inputStream, LispObject elementType, boolean interactive) {
this(structureClass, inputStream, elementType);
setInteractive(interactive);
}
public Stream(Symbol structureClass, OutputStream outputStream, LispObject elementType) {
this(structureClass, outputStream, elementType, keywordDefault);
}
// Output stream constructors.
public Stream(Symbol structureClass, OutputStream outputStream, LispObject elementType, LispObject format) {
this(structureClass);
this.elementType = elementType;
setExternalFormat(format);
if (elementType == Symbol.CHARACTER || elementType == Symbol.BASE_CHAR) {
Writer w =
(encoding == null) ?
new OutputStreamWriter(outputStream)
: new OutputStreamWriter(outputStream,
Charset.forName(encoding).newEncoder());
initAsCharacterOutputStream(w);
} else {
OutputStream stream = new BufferedOutputStream(outputStream);
initAsBinaryOutputStream(stream);
}
}
public Stream(Symbol structureClass, OutputStream outputStream,
LispObject elementType,
boolean interactive) {
this(structureClass, outputStream, elementType);
setInteractive(interactive);
}
protected void initAsCharacterInputStream(Reader reader) {
if (! (reader instanceof PushbackReader))
this.reader = new PushbackReader(reader, 5);
else
this.reader = (PushbackReader)reader;
isInputStream = true;
isCharacterStream = true;
}
protected void initAsBinaryInputStream(InputStream in) {
this.in = in;
isInputStream = true;
isBinaryStream = true;
}
protected void initAsCharacterOutputStream(Writer writer) {
this.writer = writer;
isOutputStream = true;
isCharacterStream = true;
}
protected void initAsBinaryOutputStream(OutputStream out) {
this.out = out;
isOutputStream = true;
isBinaryStream = true;
}
public boolean isInputStream() {
return isInputStream;
}
public boolean isOutputStream() {
return isOutputStream;
}
public boolean isCharacterInputStream() {
return isCharacterStream && isInputStream;
}
public boolean isBinaryInputStream() {
return isBinaryStream && isInputStream;
}
public boolean isCharacterOutputStream() {
return isCharacterStream && isOutputStream;
}
public boolean isBinaryOutputStream() {
return isBinaryStream && isOutputStream;
}
public boolean isInteractive() {
return interactive;
}
public void setInteractive(boolean b) {
interactive = b;
}
public LispObject getExternalFormat() {
return externalFormat;
}
public String getEncoding() {
return encoding;
}
public void setExternalFormat(LispObject format) {
// make sure we encode any remaining buffers with the current format
finishOutput();
if (format == keywordDefault) {
encoding = null;
eolStyle = platformEolStyle;
eolChar = (eolStyle == EolStyle.CR) ? '\r' : '\n';
externalFormat = format;
return;
}
LispObject enc;
boolean encIsCp = false;
if (format instanceof Cons) {
// meaning a non-empty list
enc = format.car();
if (enc == keywordCodePage) {
encIsCp = true;
enc = getf(format.cdr(), keywordID, null);
}
LispObject eol = getf(format.cdr(), keywordEolStyle, keywordRAW);
if (eol == keywordCR)
eolStyle = EolStyle.CR;
else if (eol == keywordLF)
eolStyle = EolStyle.LF;
else if (eol == keywordCRLF)
eolStyle = EolStyle.CRLF;
else if (eol != keywordRAW)
; //###FIXME: raise an error
} else
enc = format;
if (enc.numberp())
encoding = enc.toString();
else if (enc instanceof AbstractString)
encoding = enc.getStringValue();
else if (enc == keywordDefault)
// This allows the user to use the encoding determined by
// Java to be the default for the current environment
// while still being able to set other stream options
// (e.g. :EOL-STYLE)
encoding = null;
else if (enc instanceof Symbol)
encoding = ((Symbol)enc).getName();
else
; //###FIXME: raise an error!
if (encIsCp)
encoding = "Cp" + encoding;
eolChar = (eolStyle == EolStyle.CR) ? '\r' : '\n';
externalFormat = format;
if (reader != null
&& reader instanceof DecodingReader)
((DecodingReader)reader).setCharset(Charset.forName(encoding));
}
public static final Primitive STREAM_EXTERNAL_FORMAT = new pf_stream_external_format();
@DocString(
name="stream-external-format",
args="stream",
doc="Returns the external format of STREAM."
)
private static final class pf_stream_external_format extends Primitive {
pf_stream_external_format() {
super("stream-external-format", "stream");
}
public LispObject execute(LispObject arg) {
if (arg instanceof Stream) {
return ((Stream)arg).getExternalFormat();
} else {
return type_error(arg, Symbol.STREAM);
}
}
}
// DEFSETF-ed in 'setf.lisp'
public static final Primitive SET_STREAM_EXTERNAL_FORMAT = new pf__set_stream_external_format();
@DocString(
name="%set-stream-external-format",
args="stream format"
)
private static final class pf__set_stream_external_format extends Primitive {
pf__set_stream_external_format() {
super("%set-stream-external-format",
PACKAGE_SYS, false, "stream external-format");
}
public LispObject execute(LispObject stream, LispObject format) {
Stream s = checkStream(stream);
s.setExternalFormat(format);
return format;
}
};
public static final Primitive AVAILABLE_ENCODINGS = new pf_available_encodings();
@DocString(name="available-encodings",
returns="encodings",
doc="Returns all charset encodings suitable for passing to a stream constructor available at runtime.")
private static final class pf_available_encodings extends Primitive {
pf_available_encodings() {
super("available-encodings", PACKAGE_SYS, true);
}
public LispObject execute() {
LispObject result = NIL;
for (Symbol encoding : availableEncodings()) {
result = result.push(encoding);
}
return result.nreverse();
}
}
static public List availableEncodings() {
List result = new LinkedList();
SortedMap available = Charset.availableCharsets();
Set encodings = available.keySet();
for (String charset : encodings) {
result.add (PACKAGE_KEYWORD.intern (charset));
}
return result;
}
public boolean isOpen() {
return open;
}
public void setOpen(boolean b) {
open = b;
}
@Override
public LispObject typeOf() {
return Symbol.SYSTEM_STREAM;
}
@Override
public LispObject classOf() {
return BuiltInClass.SYSTEM_STREAM;
}
@Override
public LispObject typep(LispObject typeSpecifier) {
if (typeSpecifier == Symbol.SYSTEM_STREAM)
return T;
if (typeSpecifier == Symbol.STREAM)
return T;
if (typeSpecifier == BuiltInClass.STREAM)
return T;
return super.typep(typeSpecifier);
}
public LispObject getElementType() {
return elementType;
}
// Character input.
public int getOffset() {
return offset;
}
// Character input.
public final int getLineNumber() {
return lineNumber;
}
protected void setWriter(Writer writer) {
this.writer = writer;
}
// Character output.
public int getCharPos() {
return charPos;
}
// Character output.
public void setCharPos(int n) {
charPos = n;
}
/** Class to abstract readtable access
*
* Many of the functions below (used to) exist in 2 variants.
* One with hardcoded access to the FaslReadtable, the other
* with hardcoded access to the *readtable* variable.
*
* In order to prevent code duplication,
* this class abstracts access.
*/
public static abstract class ReadtableAccessor {
/** Given the thread passed, return the applicable readtable. */
public abstract Readtable rt(LispThread thread);
}
/** pre-instantiated readtable accessor for the *readtable*. */
public static ReadtableAccessor currentReadtable
= new ReadtableAccessor()
{
public Readtable rt(LispThread thread)
{
return
(Readtable)Symbol.CURRENT_READTABLE.symbolValue(thread);
}
};
/** pre-instantiated readtable accessor for the fasl readtable. */
public static ReadtableAccessor faslReadtable
= new ReadtableAccessor()
{
public Readtable rt(LispThread thread)
{
return FaslReadtable.getInstance();
}
};
public LispObject read(boolean eofError, LispObject eofValue,
boolean recursive, LispThread thread,
ReadtableAccessor rta)
{
LispObject result = readPreservingWhitespace(eofError, eofValue,
recursive, thread, rta);
if (result != eofValue && !recursive) {
try {
if (_charReady()) {
int n = _readChar();
if (n >= 0) {
char c = (char) n; // ### BUG: Codepoint conversion
Readtable rt = rta.rt(thread);
if (!rt.isWhitespace(c))
_unreadChar(c);
}
}
} catch (IOException e) {
return error(new StreamError(this, e));
}
}
if (!eofError && result == eofValue) return result;
if (Symbol.READ_SUPPRESS.symbolValue(thread) != NIL)
return NIL;
else
return result;
}
// ### *sharp-equal-alist*
// internal symbol
private static final Symbol _SHARP_EQUAL_ALIST_ =
internSpecial("*SHARP-EQUAL-ALIST*", PACKAGE_SYS, NIL);
private static final Symbol _SHARP_SHARP_ALIST_ =
internSpecial("*SHARP-SHARP-ALIST*", PACKAGE_SYS, NIL);
public LispObject readPreservingWhitespace(boolean eofError,
LispObject eofValue,
boolean recursive,
LispThread thread,
ReadtableAccessor rta)
{
if (recursive) {
final Readtable rt = rta.rt(thread);
while (true) {
int n = -1;
try {
n = _readChar();
} catch (IOException e) {
Debug.trace(e);
error(new StreamError(this, e));
}
if (n < 0) {
if (eofError)
return error(new EndOfFile(this));
else
return eofValue;
}
char c = (char) n; // ### BUG: Codepoint conversion
if (rt.isWhitespace(c))
continue;
LispObject result = processChar(thread, c, rt);
if (result != null)
return result;
}
} else {
final SpecialBindingsMark mark = thread.markSpecialBindings();
thread.bindSpecial(_SHARP_EQUAL_ALIST_, NIL);
thread.bindSpecial(_SHARP_SHARP_ALIST_, NIL);
try {
return readPreservingWhitespace(eofError, eofValue, true,
thread, rta);
} finally {
thread.resetSpecialBindings(mark);
}
}
}
/** Dispatch macro function if 'c' has one associated,
* read a token otherwise.
*
* When the macro function returns zero values, this function
* returns null or the token or returned value otherwise.
*/
private final LispObject processChar(LispThread thread,
char c, Readtable rt)
{
final LispObject handler = rt.getReaderMacroFunction(c);
LispObject value;
if (handler instanceof ReaderMacroFunction) {
thread._values = null;
value = ((ReaderMacroFunction)handler).execute(this, c);
}
else if (handler != null && handler != NIL) {
thread._values = null;
value = handler.execute(this, LispCharacter.getInstance(c));
}
else
return readToken(c, rt);
// If we're looking at zero return values, set 'value' to null
if (value == NIL) {
LispObject[] values = thread._values;
if (values != null && values.length == 0) {
value = null;
thread._values = null; // reset 'no values' indicator
}
}
return value;
}
public LispObject readPathname(ReadtableAccessor rta) {
LispObject obj = read(true, NIL, false,
LispThread.currentThread(), rta);
if (obj instanceof AbstractString) {
return Pathname.parseNamestring((AbstractString)obj);
}
if (obj.listp())
return Pathname.makePathname(obj);
return error(new TypeError("#p requires a string argument."));
}
public LispObject readSymbol() {
final Readtable rt =
(Readtable) Symbol.CURRENT_READTABLE.symbolValue(LispThread.currentThread());
return readSymbol(rt);
}
public LispObject readSymbol(Readtable rt) {
final StringBuilder sb = new StringBuilder();
final BitSet flags = _readToken(sb, rt);
return new Symbol(rt.getReadtableCase() == Keyword.INVERT
? invert(sb.toString(), flags)
: sb.toString());
}
public LispObject readStructure(ReadtableAccessor rta) {
final LispThread thread = LispThread.currentThread();
LispObject obj = read(true, NIL, true, thread, rta);
if (Symbol.READ_SUPPRESS.symbolValue(thread) != NIL)
return NIL;
if (obj.listp()) {
Symbol structure = checkSymbol(obj.car());
LispClass c = LispClass.findClass(structure);
if (!(c instanceof StructureClass))
return error(new ReaderError(structure.getName() +
" is not a defined structure type.",
this));
LispObject args = obj.cdr();
Symbol DEFSTRUCT_DEFAULT_CONSTRUCTOR =
PACKAGE_SYS.intern("DEFSTRUCT-DEFAULT-CONSTRUCTOR");
LispObject constructor =
DEFSTRUCT_DEFAULT_CONSTRUCTOR.getSymbolFunctionOrDie().execute(structure);
final int length = args.length();
if ((length % 2) != 0)
return error(new ReaderError("Odd number of keyword arguments following #S: " +
obj.princToString(),
this));
LispObject[] array = new LispObject[length];
LispObject rest = args;
for (int i = 0; i < length; i += 2) {
LispObject key = rest.car();
if (key instanceof Symbol && ((Symbol)key).getPackage() == PACKAGE_KEYWORD) {
array[i] = key;
} else {
array[i] = PACKAGE_KEYWORD.intern(javaString(key));
}
array[i + 1] = rest.cadr();
rest = rest.cddr();
}
return funcall(constructor.getSymbolFunctionOrDie(), array,
thread);
}
return error(new ReaderError("Non-list following #S: " +
obj.princToString(),
this));
}
public LispObject readString(char terminator, ReadtableAccessor rta)
{
final LispThread thread = LispThread.currentThread();
final Readtable rt = rta.rt(thread);
StringBuilder sb = new StringBuilder();
try
{
while (true) {
int n = _readChar();
if (n < 0)
return error(new EndOfFile(this));
char c = (char) n; // ### BUG: Codepoint conversion
if (rt.getSyntaxType(c) == Readtable.SYNTAX_TYPE_SINGLE_ESCAPE) {
// Single escape.
n = _readChar();
if (n < 0)
return error(new EndOfFile(this));
sb.append((char)n); // ### BUG: Codepoint conversion
continue;
}
if (c == terminator)
break;
// Default.
sb.append(c);
}
}
catch (java.io.IOException e)
{
//error(new EndOfFile(stream));
return new SimpleString(sb);
}
return new SimpleString(sb);
}
public LispObject readList(boolean requireProperList,
ReadtableAccessor rta)
{
final LispThread thread = LispThread.currentThread();
Cons first = null;
Cons last = null;
Readtable rt;
try {
while (true) {
rt = rta.rt(thread);
char c = flushWhitespace(rt);
if (c == ')') {
return first == null ? NIL : first;
}
if (c == '.') {
int n = _readChar();
if (n < 0)
return error(new EndOfFile(this));
char nextChar = (char) n; // ### BUG: Codepoint conversion
if (isTokenDelimiter(nextChar, rt)) {
if (last == null) {
if (Symbol.READ_SUPPRESS.symbolValue(thread) != NIL)
return NIL;
else
return error(new ReaderError("Nothing appears before . in list.",
this));
}
_unreadChar(nextChar);
LispObject obj = read(true, NIL, true, thread, rta);
if (requireProperList) {
if (!obj.listp())
error(new ReaderError("The value " +
obj.princToString() +
" is not of type " +
Symbol.LIST.princToString() + ".",
this));
}
last.cdr = obj;
continue;
}
// normal token beginning with '.'
_unreadChar(nextChar);
}
LispObject obj = processChar(thread, c, rt);
if (obj == null)
continue;
if (first == null) {
first = new Cons(obj);
last = first;
} else {
Cons newCons = new Cons(obj);
last.cdr = newCons;
last = newCons;
}
}
} catch (IOException e) {
error(new StreamError(this, e));
return null;
}
}
private static final boolean isTokenDelimiter(char c, Readtable rt)
{
byte type = rt.getSyntaxType(c);
return type == Readtable.SYNTAX_TYPE_TERMINATING_MACRO ||
type == Readtable.SYNTAX_TYPE_WHITESPACE;
}
public LispObject readDispatchChar(char dispChar,
ReadtableAccessor rta)
{
int numArg = -1;
char c = 0;
try {
while (true) {
int n = _readChar();
if (n < 0)
return error(new EndOfFile(this));
c = (char) n; // ### BUG: Codepoint conversion
if (c < '0' || c > '9')
break;
if (numArg < 0)
numArg = 0;
numArg = numArg * 10 + c - '0';
}
} catch (IOException e) {
error(new StreamError(this, e));
}
final LispThread thread = LispThread.currentThread();
final Readtable rt = rta.rt(thread);
LispObject fun = rt.getDispatchMacroCharacter(dispChar, c);
if (fun != NIL) {
LispObject result;
thread._values = null;
if (fun instanceof DispatchMacroFunction)
return ((DispatchMacroFunction)fun).execute(this, c, numArg);
else
return
thread.execute(fun, this, LispCharacter.getInstance(c),
(numArg < 0) ? NIL : Fixnum.getInstance(numArg));
}
if (Symbol.READ_SUPPRESS.symbolValue(thread) != NIL)
return null;
return error(new ReaderError("No dispatch function defined for #\\" + c,
this));
}
public LispObject readSharpLeftParen(char c, int n,
ReadtableAccessor rta)
{
final LispThread thread = LispThread.currentThread();
LispObject list = readList(true, rta);
if (_BACKQUOTE_COUNT_.symbolValue(thread).zerop()) {
if (n >= 0) {
LispObject[] array = new LispObject[n];
for (int i = 0; i < n; i++) {
array[i] = list.car();
if (list.cdr() != NIL)
list = list.cdr();
}
return new SimpleVector(array);
} else
return new SimpleVector(list);
}
return new Cons(_BQ_VECTOR_FLAG_.symbolValue(thread), list);
}
public LispObject readSharpStar(char ignored, int n,
ReadtableAccessor rta)
{
final LispThread thread = LispThread.currentThread();
final Readtable rt = rta.rt(thread);
final boolean suppress =
(Symbol.READ_SUPPRESS.symbolValue(thread) != NIL);
StringBuilder sb = new StringBuilder();
try
{
while (true) {
int ch = _readChar();
if (ch < 0)
break;
char c = (char) ch;
if (c == '0' || c == '1')
sb.append(c);
else {
int syntaxType = rt.getSyntaxType(c);
if (syntaxType == Readtable.SYNTAX_TYPE_WHITESPACE ||
syntaxType == Readtable.SYNTAX_TYPE_TERMINATING_MACRO) {
_unreadChar(c);
break;
} else if (!suppress) {
String name = LispCharacter.charToName(c);
if (name == null)
name = "#\\" + c;
error(new ReaderError("Illegal element for bit-vector: " + name,
this));
}
}
}
}
catch (java.io.IOException e)
{
error(new ReaderError("IO error: ",
this));
return NIL;
}
if (suppress)
return NIL;
if (n >= 0) {
// n was supplied.
final int length = sb.length();
if (length == 0) {
if (n > 0)
return error(new ReaderError("No element specified for bit vector of length " +
n + '.',
this));
}
if (n > length) {
final char c = sb.charAt(length - 1);
for (int i = length; i < n; i++)
sb.append(c);
} else if (n < length) {
return error(new ReaderError("Bit vector is longer than specified length: #" +
n + '*' + sb.toString(),
this));
}
}
return new SimpleBitVector(sb.toString());
}
public LispObject readSharpDot(char c, int n,
ReadtableAccessor rta)
{
final LispThread thread = LispThread.currentThread();
if (Symbol.READ_EVAL.symbolValue(thread) == NIL)
return error(new ReaderError("Can't read #. when *READ-EVAL* is NIL.",
this));
else
return eval(read(true, NIL, true, thread, rta),
new Environment(), thread);
}
public LispObject readCharacterLiteral(Readtable rt, LispThread thread)
{
try {
int n = _readChar();
if (n < 0)
return error(new EndOfFile(this));
char c = (char) n; // ### BUG: Codepoint conversion
StringBuilder sb = new StringBuilder(String.valueOf(c));
while (true) {
n = _readChar();
if (n < 0)
break;
c = (char) n; // ### BUG: Codepoint conversion
if (rt.isWhitespace(c))
break;
if (rt.getSyntaxType(c) ==
Readtable.SYNTAX_TYPE_TERMINATING_MACRO) {
_unreadChar(c);
break;
}
sb.append(c);
}
if (Symbol.READ_SUPPRESS.symbolValue(thread) != NIL)
return NIL;
if (sb.length() == 1)
return LispCharacter.getInstance(sb.charAt(0));
String token = sb.toString();
n = LispCharacter.nameToChar(token);
if (n >= 0)
return LispCharacter.getInstance((char)n); // ### BUG: Codepoint conversion
return error(new LispError("Unrecognized character name: \"" + token + '"'));
} catch (IOException e) {
return error(new StreamError(this, e));
}
}
public void skipBalancedComment() {
try {
while (true) {
int n = _readChar();
if (n < 0)
return;
if (n == '|') {
n = _readChar();
if (n == '#')
return;
else
_unreadChar(n);
} else if (n == '#') {
n = _readChar();
if (n == '|')
skipBalancedComment(); // Nested comment. Recurse!
else
_unreadChar(n);
}
}
} catch (IOException e) {
error(new StreamError(this, e));
}
}
public LispObject readArray(int rank, ReadtableAccessor rta) {
final LispThread thread = LispThread.currentThread();
LispObject obj = read(true, NIL, true, thread, rta);
if (Symbol.READ_SUPPRESS.symbolValue(thread) != NIL)
return NIL;
switch (rank) {
case -1:
return error(new ReaderError("No dimensions argument to #A.", this));
case 0:
return new ZeroRankArray(T, obj, false);
case 1: {
if (obj.listp() || obj instanceof AbstractVector)
return new SimpleVector(obj);
return error(new ReaderError(obj.princToString() + " is not a sequence.",
this));
}
default:
return new SimpleArray_T(rank, obj);
}
}
public LispObject readComplex(ReadtableAccessor rta) {
final LispThread thread = LispThread.currentThread();
LispObject obj = read(true, NIL, true, thread, rta);
if (Symbol.READ_SUPPRESS.symbolValue(thread) != NIL)
return NIL;
if (obj instanceof Cons && obj.length() == 2)
return Complex.getInstance(obj.car(), obj.cadr());
// Error.
StringBuilder sb = new StringBuilder("Invalid complex number format");
if (this instanceof FileStream) {
Pathname p = ((FileStream)this).getPathname();
if (p != null) {
String namestring = p.getNamestring();
if (namestring != null) {
sb.append(" in #P\"");
sb.append(namestring);
sb.append('"');
}
}
sb.append(" at offset ");
sb.append(_getFilePosition());
}
sb.append(": #C");
sb.append(obj.printObject());
return error(new ReaderError(sb.toString(), this));
}
private String readMultipleEscape(Readtable rt) {
StringBuilder sb = new StringBuilder();
try {
while (true) {
int n = _readChar();
if (n < 0)
return serror(new EndOfFile(this));
char c = (char) n; // ### BUG: Codepoint conversion
byte syntaxType = rt.getSyntaxType(c);
if (syntaxType == Readtable.SYNTAX_TYPE_SINGLE_ESCAPE) {
n = _readChar();
if (n < 0)
return serror(new EndOfFile(this));
sb.append((char)n); // ### BUG: Codepoint conversion
continue;
}
if (syntaxType == Readtable.SYNTAX_TYPE_MULTIPLE_ESCAPE)
break;
sb.append(c);
}
} catch (IOException e) {
return serror(new StreamError(this, e));
}
return sb.toString();
}
private static final int findUnescapedSingleColon(String s, BitSet flags) {
if (flags == null)
return s.indexOf(':');
final int limit = s.length();
for (int i = 0; i < limit; i++) {
if (s.charAt(i) == ':' && !flags.get(i)) {
return i;
}
}
return -1;
}
private static final int findUnescapedDoubleColon(String s, BitSet flags) {
if (flags == null)
return s.indexOf("::");
final int limit = s.length() - 1;
for (int i = 0; i < limit; i++) {
if (s.charAt(i) == ':' && !flags.get(i)) {
if (s.charAt(i + 1) == ':' && !flags.get(i + 1)) {
return i;
}
}
}
return -1;
}
private final LispObject readToken(char c, Readtable rt)
{
StringBuilder sb = new StringBuilder(String.valueOf(c));
final LispThread thread = LispThread.currentThread();
BitSet flags = _readToken(sb, rt);
if (Symbol.READ_SUPPRESS.symbolValue(thread) != NIL)
return NIL;
final LispObject readtableCase = rt.getReadtableCase();
final String token = sb.toString();
final boolean invert = readtableCase == Keyword.INVERT;
final int length = token.length();
if (length > 0) {
final char firstChar = token.charAt(0);
if (flags == null) {
if (firstChar == '.') {
// Section 2.3.3: "If a token consists solely of dots (with
// no escape characters), then an error of type READER-
// ERROR is signaled, except in one circumstance: if the
// token is a single dot and appears in a situation where
// dotted pair notation permits a dot, then it is accepted
// as part of such syntax and no error is signaled."
boolean ok = false;
for (int i = length; i-- > 1;) {
if (token.charAt(i) != '.') {
ok = true;
break;
}
}
if (!ok) {
final String message;
if (length > 1)
message = "Too many dots.";
else
message = "Dot context error.";
return error(new ReaderError(message, this));
}
}
final int radix = getReadBase(thread);
if ("+-.0123456789".indexOf(firstChar) >= 0) {
LispObject number = makeNumber(token, length, radix);
if (number != null)
return number;
} else if (Character.digit(firstChar, radix) >= 0) {
LispObject number = makeNumber(token, length, radix);
if (number != null)
return number;
}
}
String symbolName;
String packageName = null;
BitSet symbolFlags;
BitSet packageFlags = null;
Package pkg = null;
boolean internSymbol = true;
if (firstChar == ':' && (flags == null || !flags.get(0))) {
symbolName = token.substring(1);
pkg = PACKAGE_KEYWORD;
if (flags != null)
symbolFlags = flags.get(1, flags.size());
else
symbolFlags = null;
} else {
int index = findUnescapedDoubleColon(token, flags);
if (index > 0) {
packageName = token.substring(0, index);
packageFlags = (flags != null) ? flags.get(0, index) : null;
symbolName = token.substring(index + 2);
symbolFlags = (flags != null) ? flags.get(index+2, flags.size()) : null;
} else {
index = findUnescapedSingleColon(token, flags);
if (index > 0) {
packageName = token.substring(0, index);
packageFlags = (flags != null) ? flags.get(0, index) : null;
symbolName = token.substring(index + 1);
symbolFlags = (flags != null) ? flags.get(index+2, flags.size()) : null;
internSymbol = false;
} else {
pkg = (Package)Symbol._PACKAGE_.symbolValue(thread);
symbolName = token;
symbolFlags = flags;
}
}
}
if (pkg == null) {
if (invert)
packageName = invert(packageName, packageFlags);
pkg = getCurrentPackage().findPackage(packageName);
if (pkg == null)
return error(new ReaderError("The package \"" + packageName + "\" can't be found.", this));
}
if (invert)
symbolName = invert(symbolName, symbolFlags);
if (internSymbol) {
return pkg.intern(symbolName);
} else {
Symbol symbol = pkg.findExternalSymbol(symbolName);
if (symbol != null)
return symbol;
// Error!
if (pkg.findInternalSymbol(symbolName) != null) {
return error(new ReaderError("The symbol \"~A\" is not external in package ~A.",
this,
new SimpleString(symbolName),
new SimpleString(packageName)));
} else {
return error(new ReaderError("The symbol \"~A\" was not found in package ~A.",
this,
new SimpleString(symbolName),
new SimpleString(packageName)));
}
}
} else { // token.length == 0
Package pkg = (Package)Symbol._PACKAGE_.symbolValue(thread);
return pkg.intern("");
}
}
private final BitSet _readToken(StringBuilder sb, Readtable rt)
{
BitSet flags = null;
final LispObject readtableCase = rt.getReadtableCase();
if (sb.length() > 0) {
Debug.assertTrue(sb.length() == 1);
char c = sb.charAt(0);
byte syntaxType = rt.getSyntaxType(c);
if (syntaxType == Readtable.SYNTAX_TYPE_SINGLE_ESCAPE) {
int n = -1;
try {
n = _readChar();
} catch (IOException e) {
error(new StreamError(this, e));
return flags;
}
if (n < 0) {
error(new EndOfFile(this));
return null; // Not reached
}
sb.setCharAt(0, (char) n); // ### BUG: Codepoint conversion
flags = new BitSet(1);
flags.set(0);
} else if (syntaxType == Readtable.SYNTAX_TYPE_MULTIPLE_ESCAPE) {
sb.setLength(0);
sb.append(readMultipleEscape(rt));
flags = new BitSet(sb.length());
flags.set(0, sb.length());
} else if (rt.isInvalid(c)) {
rt.checkInvalid(c, this); // Signals a reader-error.
} else if (readtableCase == Keyword.UPCASE) {
sb.setCharAt(0, LispCharacter.toUpperCase(c));
} else if (readtableCase == Keyword.DOWNCASE) {
sb.setCharAt(0, LispCharacter.toLowerCase(c));
}
}
try {
while (true) {
int n = _readChar();
if (n < 0)
break;
char c = (char) n; // ### BUG: Codepoint conversion
if (rt.isWhitespace(c)) {
_unreadChar(n);
break;
}
byte syntaxType = rt.getSyntaxType(c);
if (syntaxType == Readtable.SYNTAX_TYPE_TERMINATING_MACRO) {
_unreadChar(c);
break;
}
rt.checkInvalid(c, this);
if (syntaxType == Readtable.SYNTAX_TYPE_SINGLE_ESCAPE) {
n = _readChar();
if (n < 0)
break;
sb.append((char)n); // ### BUG: Codepoint conversion
if (flags == null)
flags = new BitSet(sb.length());
flags.set(sb.length() - 1);
continue;
}
if (syntaxType == Readtable.SYNTAX_TYPE_MULTIPLE_ESCAPE) {
int begin = sb.length();
sb.append(readMultipleEscape(rt));
int end = sb.length();
if (flags == null)
flags = new BitSet(sb.length());
flags.set(begin, end);
continue;
}
if (readtableCase == Keyword.UPCASE)
c = LispCharacter.toUpperCase(c);
else if (readtableCase == Keyword.DOWNCASE)
c = LispCharacter.toLowerCase(c);
sb.append(c);
}
} catch (IOException e) {
error(new StreamError(this, e));
return flags;
}
return flags;
}
public static final String invert(String s, BitSet flags) {
// Section 23.1.2: "When the readtable case is :INVERT, then if all of
// the unescaped letters in the extended token are of the same case,
// those (unescaped) letters are converted to the opposite case."
final int limit = s.length();
final int LOWER = 1;
final int UPPER = 2;
int state = 0;
for (int i = 0; i < limit; i++) {
// We only care about unescaped characters.
if (flags != null && flags.get(i))
continue;
char c = s.charAt(i);
if (Character.isUpperCase(c)) {
if (state == LOWER)
return s; // Mixed case.
state = UPPER;
}
if (Character.isLowerCase(c)) {
if (state == UPPER)
return s; // Mixed case.
state = LOWER;
}
}
StringBuilder sb = new StringBuilder(limit);
for (int i = 0; i < limit; i++) {
char c = s.charAt(i);
if (flags != null && flags.get(i)) // Escaped.
sb.append(c);
else if (Character.isUpperCase(c))
sb.append(Character.toLowerCase(c));
else if (Character.isLowerCase(c))
sb.append(Character.toUpperCase(c));
else
sb.append(c);
}
return sb.toString();
}
private static final int getReadBase(LispThread thread)
{
final int readBase;
final LispObject readBaseObject = Symbol.READ_BASE.symbolValue(thread);
if (readBaseObject instanceof Fixnum) {
readBase = ((Fixnum)readBaseObject).value;
} else
// The value of *READ-BASE* is not a Fixnum.
return ierror(new LispError("The value of *READ-BASE* is not " +
"of type '(INTEGER 2 36)."));
if (readBase < 2 || readBase > 36)
return ierror(new LispError("The value of *READ-BASE* is not " +
"of type '(INTEGER 2 36)."));
return readBase;
}
private final LispObject makeNumber(String token, int length, int radix)
{
if (length == 0)
return null;
if (token.indexOf('/') >= 0)
return makeRatio(token, radix);
if (token.charAt(length - 1) == '.') {
radix = 10;
token = token.substring(0, --length);
}
boolean numeric = true;
if (radix == 10) {
for (int i = length; i-- > 0;) {
char c = token.charAt(i);
if (c < '0' || c > '9') {
if (i > 0 || (c != '-' && c != '+')) {
numeric = false;
break;
}
}
}
} else {
for (int i = length; i-- > 0;) {
char c = token.charAt(i);
if (Character.digit(c, radix) < 0) {
if (i > 0 || (c != '-' && c != '+')) {
numeric = false;
break;
}
}
}
}
if (!numeric) // Can't be an integer.
return makeFloat(token, length);
if (token.charAt(0) == '+')
token = token.substring(1);
try {
int n = Integer.parseInt(token, radix);
return (n >= 0 && n <= 255) ? Fixnum.constants[n] : Fixnum.getInstance(n);
} catch (NumberFormatException e) {}
// parseInt() failed.
try {
return Bignum.getInstance(token, radix);
} catch (NumberFormatException e) {}
// Not a number.
return null;
}
private final LispObject makeRatio(String token, int radix)
{
final int index = token.indexOf('/');
if (index < 0)
return null;
try {
BigInteger numerator =
new BigInteger(token.substring(0, index), radix);
BigInteger denominator =
new BigInteger(token.substring(index + 1), radix);
// Check the denominator here, before calling number(), so we can
// signal a READER-ERROR, as required by ANSI, instead of DIVISION-
// BY-ZERO.
if (denominator.signum() == 0)
error(new ReaderError("Division by zero.", this));
return number(numerator, denominator);
} catch (NumberFormatException e) {
return null;
}
}
private static final LispObject makeFloat(final String token,
final int length)
{
if (length == 0)
return null;
StringBuilder sb = new StringBuilder();
int i = 0;
boolean maybe = false;
char marker = 0;
char c = token.charAt(i);
if (c == '-' || c == '+') {
sb.append(c);
++i;
}
while (i < length) {
c = token.charAt(i);
if (c == '.' || (c >= '0' && c <= '9')) {
if (c == '.')
maybe = true;
sb.append(c);
++i;
} else
break;
}
if (i < length) {
c = token.charAt(i);
if ("esfdlESFDL".indexOf(c) >= 0) {
// Exponent marker.
maybe = true;
marker = LispCharacter.toUpperCase(c);
if (marker == 'S')
marker = 'F';
else if (marker == 'L')
marker = 'D';
else if (marker == 'E') {
LispObject format = Symbol.READ_DEFAULT_FLOAT_FORMAT.symbolValue();
if (format == Symbol.SINGLE_FLOAT || format == Symbol.SHORT_FLOAT)
marker = 'F';
else
marker = 'D';
}
sb.append('E');
++i;
}
}
if (!maybe)
return null;
// Append rest of token.
sb.append(token.substring(i));
c = sb.charAt(sb.length()-1);
if (! ('0' <= c && c <= '9'))
// we need to check that the last item is a number:
// the Double.parseDouble routine accepts numbers ending in 'D'
// like 1e2d. The same is true for Float.parseFloat and the 'F'
// character. However, these are not valid Lisp floats.
return null;
try {
if (marker == 0) {
LispObject format = Symbol.READ_DEFAULT_FLOAT_FORMAT.symbolValue();
if (format == Symbol.SINGLE_FLOAT || format == Symbol.SHORT_FLOAT)
marker = 'F';
else
marker = 'D';
}
if (marker == 'D')
return new DoubleFloat(Double.parseDouble(sb.toString()));
else
return new SingleFloat(Float.parseFloat(sb.toString()));
} catch (NumberFormatException e) {
return null;
}
}
public LispObject readRadix(int radix, ReadtableAccessor rta) {
StringBuilder sb = new StringBuilder();
final LispThread thread = LispThread.currentThread();
final Readtable rt = rta.rt(thread);
boolean escaped = (_readToken(sb, rt) != null);
if (Symbol.READ_SUPPRESS.symbolValue(thread) != NIL)
return NIL;
if (escaped)
return error(new ReaderError("Illegal syntax for number.", this));
String s = sb.toString();
if (s.indexOf('/') >= 0)
return makeRatio(s, radix);
// Integer.parseInt() below handles a prefixed '-' character correctly, but
// does not accept a prefixed '+' character, so we skip over it here
if (s.charAt(0) == '+')
s = s.substring(1);
try {
int n = Integer.parseInt(s, radix);
return (n >= 0 && n <= 255) ? Fixnum.constants[n] : Fixnum.getInstance(n);
} catch (NumberFormatException e) {}
// parseInt() failed.
try {
return Bignum.getInstance(s, radix);
} catch (NumberFormatException e) {}
// Not a number.
return error(new LispError());
}
private char flushWhitespace(Readtable rt) {
try {
while (true) {
int n = _readChar();
if (n < 0)
return (char)ierror(new EndOfFile(this));
char c = (char) n; // ### BUG: Codepoint conversion
if (!rt.isWhitespace(c))
return c;
}
} catch (IOException e) {
error(new StreamError(this, e));
return 0;
}
}
public LispObject readDelimitedList(char delimiter)
{
final LispThread thread = LispThread.currentThread();
LispObject result = NIL;
while (true) {
Readtable rt = (Readtable) Symbol.CURRENT_READTABLE.symbolValue(thread);
char c = flushWhitespace(rt);
if (c == delimiter)
break;
LispObject obj = processChar(thread, c, rt);
if (obj != null)
result = new Cons(obj, result);
}
if (Symbol.READ_SUPPRESS.symbolValue(thread) != NIL)
return NIL;
else
return result.nreverse();
}
// read-line &optional stream eof-error-p eof-value recursive-p
// => line, missing-newline-p
// recursive-p is ignored
public LispObject readLine(boolean eofError, LispObject eofValue)
{
final LispThread thread = LispThread.currentThread();
StringBuilder sb = new StringBuilder();
try {
while (true) {
int n = _readChar();
if (n < 0) {
if (sb.length() == 0) {
if (eofError)
return error(new EndOfFile(this));
return thread.setValues(eofValue, T);
}
return thread.setValues(new SimpleString(sb), T);
}
if (n == '\n')
return thread.setValues(new SimpleString(sb), NIL);
else
sb.append((char)n); // ### BUG: Codepoint conversion
}
} catch (IOException e) {
return error(new StreamError(this, e));
}
}
// read-char &optional stream eof-error-p eof-value recursive-p => char
// recursive-p is ignored
public LispObject readChar() {
try {
int n = _readChar();
if (n < 0)
return error(new EndOfFile(this));
return LispCharacter.getInstance((char)n); // ### BUG: Codepoint conversion
} catch (IOException e) {
return error(new StreamError(this, e));
}
}
public LispObject readChar(boolean eofError, LispObject eofValue)
{
try {
int n = _readChar();
if (n < 0) {
if (eofError)
return error(new EndOfFile(this));
else
return eofValue;
}
return LispCharacter.getInstance((char)n); // ### BUG: Codepoint conversion
} catch (IOException e) {
return error(new StreamError(this, e));
}
}
// read-char-no-hang &optional stream eof-error-p eof-value recursive-p => char
// recursive-p is ignored
public LispObject readCharNoHang(boolean eofError, LispObject eofValue)
{
try {
return _charReady() ? readChar(eofError, eofValue) : NIL;
} catch (IOException e) {
return error(new StreamError(this, e));
}
}
// unread-char character &optional input-stream => nil
public LispObject unreadChar(LispCharacter c) {
try {
_unreadChar(c.value);
return NIL;
} catch (IOException e) {
return error(new StreamError(this, e));
}
}
public LispObject finishOutput() {
_finishOutput();
return NIL;
}
// clear-input &optional input-stream => nil
public LispObject clearInput() {
_clearInput();
return NIL;
}
public LispObject getFilePosition() {
long pos = _getFilePosition();
return pos >= 0 ? number(pos) : NIL;
}
public LispObject setFilePosition(LispObject arg) {
return _setFilePosition(arg) ? T : NIL;
}
// close stream &key abort => result
// Must return true if stream was open, otherwise implementation-dependent.
public LispObject close(LispObject abort) {
_close();
return T;
}
// read-byte stream &optional eof-error-p eof-value => byte
// Reads an 8-bit byte.
public LispObject readByte(boolean eofError, LispObject eofValue)
{
int n = _readByte();
if (n < 0) {
if (eofError)
return error(new EndOfFile(this));
else
return eofValue;
}
return Fixnum.constants[n];
}
public LispObject terpri() {
_writeChar('\n');
return NIL;
}
public LispObject freshLine() {
if (charPos == 0)
return NIL;
_writeChar('\n');
return T;
}
public void print(char c) {
_writeChar(c);
}
// PRIN1 produces output suitable for input to READ.
// Binds *PRINT-ESCAPE* to true.
public void prin1(LispObject obj) {
LispThread thread = LispThread.currentThread();
final SpecialBindingsMark mark = thread.markSpecialBindings();
thread.bindSpecial(Symbol.PRINT_ESCAPE, T);
try {
_writeString(obj.printObject());
} finally {
thread.resetSpecialBindings(mark);
}
}
public LispObject listen() {
if (pastEnd)
return NIL;
try {
if (isCharacterInputStream()) {
if (! _charReady())
return NIL;
int n = _readChar();
if (n < 0)
return NIL;
_unreadChar(n);
return T;
} else if (isInputStream()) {
if (! _byteReady())
return NIL;
return T;
} else
return error(new StreamError(this, "Not an input stream"));
} catch (IOException e) {
return error(new StreamError(this, e));
}
}
public LispObject fileLength() {
return type_error(this, Symbol.FILE_STREAM);
}
public LispObject fileStringLength(LispObject arg) {
if (arg instanceof LispCharacter) {
if (Utilities.isPlatformWindows) {
if (((LispCharacter)arg).value == '\n')
return Fixnum.TWO;
}
return Fixnum.ONE;
}
if (arg instanceof AbstractString) {
if (Utilities.isPlatformWindows) {
int fileStringLength = 0;
char[] chars = ((AbstractString)arg).getStringChars();
for (int i = chars.length; i-- > 0;) {
if (chars[i] == '\n')
fileStringLength += 2;
else
++fileStringLength;
}
return number(fileStringLength);
}
return number(arg.length());
}
return error(new TypeError(arg.princToString() +
" is neither a string nor a character."));
}
/** Reads a character off an underlying stream
*
* @return a character, or -1 at end-of-file
*/
protected int _readChar() throws IOException {
if (reader == null)
streamNotCharacterInputStream();
int n = reader.read();
if (n < 0) {
pastEnd = true;
return -1;
}
++offset;
if (n == '\r' && eolStyle == EolStyle.CRLF) {
n = _readChar();
if (n != '\n') {
_unreadChar(n);
return '\r';
} else
return '\n';
}
if (n == eolChar) {
++lineNumber;
return '\n';
}
return n;
}
/** Puts a character back into the (underlying) stream
*
* @param n
*/
protected void _unreadChar(int n) throws IOException {
if (reader == null)
streamNotCharacterInputStream();
--offset;
if (n == '\n') {
n = eolChar;
--lineNumber;
}
reader.unread(n);
pastEnd = false;
}
/** Returns a boolean indicating input readily available
*
* @return true if a character is available
*/
protected boolean _charReady() throws IOException {
if (reader == null)
streamNotCharacterInputStream();
return reader.ready();
}
protected boolean _byteReady() throws IOException {
if (in == null)
streamNotInputStream();
return (in.available() != 0);
}
/** Writes a character into the underlying stream,
* updating charPos while doing so
*
* @param c
*/
public void _writeChar(char c) {
try {
if (c == '\n') {
if (eolStyle == EolStyle.CRLF && lastChar != '\r')
writer.write('\r');
writer.write(eolChar);
lastChar = eolChar;
writer.flush();
charPos = 0;
} else {
writer.write(c);
lastChar = c;
++charPos;
}
} catch (NullPointerException e) {
// writer is null
streamNotCharacterOutputStream();
} catch (IOException e) {
error(new StreamError(this, e));
}
}
/** Writes a series of characters in the underlying stream,
* updating charPos while doing so
*
* @param chars
* @param start
* @param end
*/
public void _writeChars(char[] chars, int start, int end)
{
try {
if (eolStyle != EolStyle.RAW) {
for (int i = start; i < end; i++)
//###FIXME: the number of writes can be greatly reduced by
// writing the space between newlines as chunks.
_writeChar(chars[i]);
return;
}
writer.write(chars, start, end - start);
if (start < end)
lastChar = chars[end-1];
int index = -1;
for (int i = end; i-- > start;) {
if (chars[i] == '\n') {
index = i;
break;
}
}
if (index < 0) {
// No newline.
charPos += (end - start);
} else {
charPos = end - (index + 1);
writer.flush();
}
} catch (NullPointerException e) {
if (writer == null)
streamNotCharacterOutputStream();
else
throw e;
} catch (IOException e) {
error(new StreamError(this, e));
}
}
/** Writes a string to the underlying stream,
* updating charPos while doing so
*
* @param s
*/
public void _writeString(String s) {
try {
_writeChars(s.toCharArray(), 0, s.length());
} catch (NullPointerException e) {
if (writer == null)
streamNotCharacterOutputStream();
else
throw e;
}
}
/** Writes a string to the underlying stream, appending
* a new line and updating charPos while doing so
*
* @param s
*/
public void _writeLine(String s) {
try {
_writeString(s);
_writeChar('\n');
} catch (NullPointerException e) {
// writer is null
streamNotCharacterOutputStream();
}
}
// Reads an 8-bit byte.
/** Reads an 8-bit byte off the underlying stream
*
* @return
*/
public int _readByte() {
try {
int n = in.read();
if (n < 0)
pastEnd = true;
return n; // Reads an 8-bit byte.
} catch (IOException e) {
return ierror(new StreamError(this, e));
}
}
// Writes an 8-bit byte.
/** Writes an 8-bit byte off the underlying stream
*
* @param n
*/
public void _writeByte(int n) {
try {
out.write(n); // Writes an 8-bit byte.
} catch (NullPointerException e) {
// out is null
streamNotBinaryOutputStream();
} catch (IOException e) {
error(new StreamError(this, e));
}
}
/** Flushes any buffered output in the (underlying) stream
*
*/
public void _finishOutput() {
try {
if (writer != null)
writer.flush();
if (out != null)
out.flush();
} catch (IOException e) {
error(new StreamError(this, e));
}
}
/** Reads all input from the underlying stream,
* until _charReady() indicates no more input to be available
*
*/
public void _clearInput() {
if (reader != null) {
int c = 0;
try {
while (_charReady() && (c >= 0))
c = _readChar();
} catch (IOException e) {
error(new StreamError(this, e));
}
} else if (in != null) {
try {
int n = 0;
while (in.available() > 0)
n = in.read();
if (n < 0)
pastEnd = true;
} catch (IOException e) {
error(new StreamError(this, e));
}
}
}
/** Returns a (non-negative) file position integer or a negative value
* if the position cannot be determined.
*
* @return non-negative value as a position spec
* @return negative value for 'unspecified'
*/
protected long _getFilePosition() {
return -1;
}
/** Sets the file position based on a position designator passed in arg
*
* @param arg File position specifier as described in the CLHS
* @return true on success, false on failure
*/
protected boolean _setFilePosition(LispObject arg) {
return false;
}
/** Closes the stream and underlying streams
*
*/
public void _close() {
try {
if (reader != null)
reader.close();
if (in != null)
in.close();
if (writer != null)
writer.close();
if (out != null)
out.close();
setOpen(false);
} catch (IOException e) {
error(new StreamError(this, e));
}
}
public void printStackTrace(Throwable t) {
StringWriter sw = new StringWriter();
PrintWriter pw = new PrintWriter(sw);
t.printStackTrace(pw);
try {
writer.write(sw.toString());
writer.write('\n');
lastChar = '\n';
writer.flush();
charPos = 0;
} catch (IOException e) {
error(new StreamError(this, e));
}
}
protected LispObject streamNotInputStream() {
return error(new StreamError(this, princToString() + " is not an input stream."));
}
protected LispObject streamNotCharacterInputStream() {
return error(new StreamError(this, princToString() + " is not a character input stream."));
}
protected LispObject streamNotOutputStream() {
return error(new StreamError(this, princToString() + " is not an output stream."));
}
protected LispObject streamNotBinaryOutputStream() {
return error(new StreamError(this, princToString() + " is not a binary output stream."));
}
protected LispObject streamNotCharacterOutputStream() {
return error(new StreamError(this, princToString() + " is not a character output stream."));
}
// ### %stream-write-char character output-stream => character
// OUTPUT-STREAM must be a real stream, not an output stream designator!
private static final Primitive _WRITE_CHAR =
new Primitive("%stream-write-char", PACKAGE_SYS, true,
"character output-stream") {
@Override
public LispObject execute(LispObject first, LispObject second)
{
checkStream(second)._writeChar(LispCharacter.getValue(first));
return first;
}
};
// ### %write-char character output-stream => character
private static final Primitive _STREAM_WRITE_CHAR =
new Primitive("%write-char", PACKAGE_SYS, false,
"character output-stream") {
@Override
public LispObject execute(LispObject first, LispObject second)
{
final char c = LispCharacter.getValue(first);
if (second == T)
second = Symbol.TERMINAL_IO.symbolValue();
else if (second == NIL)
second = Symbol.STANDARD_OUTPUT.symbolValue();
final Stream stream = checkStream(second);
stream._writeChar(c);
return first;
}
};
// ### %write-string string output-stream start end => string
private static final Primitive _WRITE_STRING =
new Primitive("%write-string", PACKAGE_SYS, false,
"string output-stream start end") {
@Override
public LispObject execute(LispObject first, LispObject second,
LispObject third, LispObject fourth)
{
final AbstractString s = checkString(first);
char[] chars = s.chars();
final Stream out = outSynonymOf(second);
final int start = Fixnum.getValue(third);
final int end;
if (fourth == NIL)
end = chars.length;
else {
end = Fixnum.getValue(fourth);
}
checkBounds(start, end, chars.length);
out._writeChars(chars, start, end);
return first;
}
};
// ### %finish-output output-stream => nil
private static final Primitive _FINISH_OUTPUT =
new Primitive("%finish-output", PACKAGE_SYS, false, "output-stream") {
@Override
public LispObject execute(LispObject arg) {
return finishOutput(arg);
}
};
// ### %force-output output-stream => nil
private static final Primitive _FORCE_OUTPUT =
new Primitive("%force-output", PACKAGE_SYS, false, "output-stream") {
@Override
public LispObject execute(LispObject arg) {
return finishOutput(arg);
}
};
static final LispObject finishOutput(LispObject arg)
{
final LispObject out;
if (arg == T)
out = Symbol.TERMINAL_IO.symbolValue();
else if (arg == NIL)
out = Symbol.STANDARD_OUTPUT.symbolValue();
else
out = arg;
return checkStream(out).finishOutput();
}
// ### clear-input &optional input-stream => nil
private static final Primitive CLEAR_INPUT =
new Primitive(Symbol.CLEAR_INPUT, "&optional input-stream") {
@Override
public LispObject execute(LispObject[] args) {
if (args.length > 1)
return error(new WrongNumberOfArgumentsException(this, -1, 1));
final Stream in;
if (args.length == 0)
in = checkCharacterInputStream(Symbol.STANDARD_INPUT.symbolValue());
else
in = inSynonymOf(args[0]);
in.clearInput();
return NIL;
}
};
// ### %clear-output output-stream => nil
// "If any of these operations does not make sense for output-stream, then
// it does nothing."
private static final Primitive _CLEAR_OUTPUT =
new Primitive("%clear-output", PACKAGE_SYS, false, "output-stream") {
@Override
public LispObject execute(LispObject arg) {
if (arg == T) // *TERMINAL-IO*
return NIL;
if (arg == NIL) // *STANDARD-OUTPUT*
return NIL;
if (arg instanceof Stream)
return NIL;
return type_error(arg, Symbol.STREAM);
}
};
// ### close stream &key abort => result
private static final Primitive CLOSE =
new Primitive(Symbol.CLOSE, "stream &key abort") {
@Override
public LispObject execute(LispObject arg) {
return checkStream(arg).close(NIL);
}
@Override
public LispObject execute(LispObject first, LispObject second,
LispObject third)
{
final Stream stream = checkStream(first);
if (second == Keyword.ABORT)
return stream.close(third);
return program_error("Unrecognized keyword argument "
+ second.princToString() + ".");
}
};
// ### out-synonym-of stream-designator => stream
private static final Primitive OUT_SYNONYM_OF =
new Primitive("out-synonym-of", PACKAGE_SYS, true, "stream-designator") {
@Override
public LispObject execute (LispObject arg) {
if (arg instanceof Stream)
return arg;
if (arg == T)
return Symbol.TERMINAL_IO.symbolValue();
if (arg == NIL)
return Symbol.STANDARD_OUTPUT.symbolValue();
return arg;
}
};
// ### write-8-bits
// write-8-bits byte stream => nil
private static final Primitive WRITE_8_BITS =
new Primitive("write-8-bits", PACKAGE_SYS, true, "byte stream") {
@Override
public LispObject execute (LispObject first, LispObject second)
{
int n = Fixnum.getValue(first);
if (n < 0 || n > 255)
return type_error(first, UNSIGNED_BYTE_8);
checkStream(second)._writeByte(n);
return NIL;
}
};
// ### read-8-bits
// read-8-bits stream &optional eof-error-p eof-value => byte
private static final Primitive READ_8_BITS =
new Primitive("read-8-bits", PACKAGE_SYS, true,
"stream &optional eof-error-p eof-value") {
@Override
public LispObject execute (LispObject first, LispObject second,
LispObject third)
{
return checkBinaryInputStream(first).readByte((second != NIL),
third);
}
@Override
public LispObject execute (LispObject[] args) {
int length = args.length;
if (length < 1 || length > 3)
return error(new WrongNumberOfArgumentsException(this, 1, 3));
final Stream in = checkBinaryInputStream(args[0]);
boolean eofError = length > 1 ? (args[1] != NIL) : true;
LispObject eofValue = length > 2 ? args[2] : NIL;
return in.readByte(eofError, eofValue);
}
};
// ### read-line &optional input-stream eof-error-p eof-value recursive-p
// => line, missing-newline-p
private static final Primitive READ_LINE =
new Primitive(Symbol.READ_LINE,
"&optional input-stream eof-error-p eof-value recursive-p") {
@Override
public LispObject execute() {
final LispObject obj = Symbol.STANDARD_INPUT.symbolValue();
final Stream stream = checkStream(obj);
return stream.readLine(true, NIL);
}
@Override
public LispObject execute(LispObject arg) {
if (arg == T)
arg = Symbol.TERMINAL_IO.symbolValue();
else if (arg == NIL)
arg = Symbol.STANDARD_INPUT.symbolValue();
final Stream stream = checkStream(arg);
return stream.readLine(true, NIL);
}
@Override
public LispObject execute(LispObject first, LispObject second)
{
if (first == T)
first = Symbol.TERMINAL_IO.symbolValue();
else if (first == NIL)
first = Symbol.STANDARD_INPUT.symbolValue();
final Stream stream = checkStream(first);
return stream.readLine(second != NIL, NIL);
}
@Override
public LispObject execute(LispObject first, LispObject second,
LispObject third)
{
if (first == T)
first = Symbol.TERMINAL_IO.symbolValue();
else if (first == NIL)
first = Symbol.STANDARD_INPUT.symbolValue();
final Stream stream = checkStream(first);
return stream.readLine(second != NIL, third);
}
@Override
public LispObject execute(LispObject first, LispObject second,
LispObject third, LispObject fourth)
{
// recursive-p is ignored
if (first == T)
first = Symbol.TERMINAL_IO.symbolValue();
else if (first == NIL)
first = Symbol.STANDARD_INPUT.symbolValue();
final Stream stream = checkStream(first);
return stream.readLine(second != NIL, third);
}
};
// ### %read-from-string string eof-error-p eof-value start end preserve-whitespace
// => object, position
private static final Primitive _READ_FROM_STRING =
new Primitive("%read-from-string", PACKAGE_SYS, false) {
@Override
public LispObject execute(LispObject first, LispObject second,
LispObject third, LispObject fourth,
LispObject fifth, LispObject sixth)
{
String s = first.getStringValue();
boolean eofError = (second != NIL);
boolean preserveWhitespace = (sixth != NIL);
final int startIndex;
if (fourth != NIL)
startIndex = Fixnum.getValue(fourth);
else
startIndex = 0;
final int endIndex;
if (fifth != NIL)
endIndex = Fixnum.getValue(fifth);
else
endIndex = s.length();
StringInputStream in =
new StringInputStream(s, startIndex, endIndex);
final LispThread thread = LispThread.currentThread();
LispObject result;
if (preserveWhitespace)
result = in.readPreservingWhitespace(eofError, third, false,
thread, currentReadtable);
else
result = in.read(eofError, third, false, thread, currentReadtable);
return thread.setValues(result, Fixnum.getInstance(in.getOffset()));
}
};
// ### read &optional input-stream eof-error-p eof-value recursive-p => object
private static final Primitive READ =
new Primitive(Symbol.READ,
"&optional input-stream eof-error-p eof-value recursive-p") {
@Override
public LispObject execute() {
final LispThread thread = LispThread.currentThread();
final LispObject obj = Symbol.STANDARD_INPUT.symbolValue(thread);
final Stream stream = checkStream(obj);
return stream.read(true, NIL, false, thread, currentReadtable);
}
@Override
public LispObject execute(LispObject arg) {
final LispThread thread = LispThread.currentThread();
if (arg == T)
arg = Symbol.TERMINAL_IO.symbolValue(thread);
else if (arg == NIL)
arg = Symbol.STANDARD_INPUT.symbolValue(thread);
final Stream stream = checkStream(arg);
return stream.read(true, NIL, false, thread, currentReadtable);
}
@Override
public LispObject execute(LispObject first, LispObject second)
{
final LispThread thread = LispThread.currentThread();
if (first == T)
first = Symbol.TERMINAL_IO.symbolValue(thread);
else if (first == NIL)
first = Symbol.STANDARD_INPUT.symbolValue(thread);
final Stream stream = checkStream(first);
return stream.read(second != NIL, NIL, false, thread, currentReadtable);
}
@Override
public LispObject execute(LispObject first, LispObject second,
LispObject third)
{
final LispThread thread = LispThread.currentThread();
if (first == T)
first = Symbol.TERMINAL_IO.symbolValue(thread);
else if (first == NIL)
first = Symbol.STANDARD_INPUT.symbolValue(thread);
final Stream stream = checkStream(first);
return stream.read(second != NIL, third, false, thread, currentReadtable);
}
@Override
public LispObject execute(LispObject first, LispObject second,
LispObject third, LispObject fourth)
{
final LispThread thread = LispThread.currentThread();
if (first == T)
first = Symbol.TERMINAL_IO.symbolValue(thread);
else if (first == NIL)
first = Symbol.STANDARD_INPUT.symbolValue(thread);
final Stream stream = checkStream(first);
return stream.read(second != NIL, third, fourth != NIL,
thread, currentReadtable);
}
};
// ### read-preserving-whitespace
// &optional input-stream eof-error-p eof-value recursive-p => object
private static final Primitive READ_PRESERVING_WHITESPACE =
new Primitive(Symbol.READ_PRESERVING_WHITESPACE,
"&optional input-stream eof-error-p eof-value recursive-p") {
@Override
public LispObject execute(LispObject[] args) {
int length = args.length;
if (length > 4)
return error(new WrongNumberOfArgumentsException(this, -1, 4));
Stream stream =
length > 0 ? inSynonymOf(args[0]) : getStandardInput();
boolean eofError = length > 1 ? (args[1] != NIL) : true;
LispObject eofValue = length > 2 ? args[2] : NIL;
boolean recursive = length > 3 ? (args[3] != NIL) : false;
return stream.readPreservingWhitespace(eofError, eofValue,
recursive,
LispThread.currentThread(),
currentReadtable);
}
};
// ### read-char &optional input-stream eof-error-p eof-value recursive-p
// => char
private static final Primitive READ_CHAR =
new Primitive(Symbol.READ_CHAR,
"&optional input-stream eof-error-p eof-value recursive-p") {
@Override
public LispObject execute() {
return checkCharacterInputStream(Symbol.STANDARD_INPUT.symbolValue()).readChar();
}
@Override
public LispObject execute(LispObject arg) {
return inSynonymOf(arg).readChar();
}
@Override
public LispObject execute(LispObject first, LispObject second)
{
return inSynonymOf(first).readChar(second != NIL, NIL);
}
@Override
public LispObject execute(LispObject first, LispObject second,
LispObject third)
{
return inSynonymOf(first).readChar(second != NIL, third);
}
@Override
public LispObject execute(LispObject first, LispObject second,
LispObject third, LispObject fourth)
{
return inSynonymOf(first).readChar(second != NIL, third);
}
};
// ### read-char-no-hang &optional input-stream eof-error-p eof-value
// recursive-p => char
private static final Primitive READ_CHAR_NO_HANG =
new Primitive("read-char-no-hang", "&optional input-stream eof-error-p eof-value recursive-p") {
@Override
public LispObject execute(LispObject[] args) {
int length = args.length;
if (length > 4)
error(new WrongNumberOfArgumentsException(this, -1, 4));
Stream stream =
length > 0 ? inSynonymOf(args[0]) : getStandardInput();
boolean eofError = length > 1 ? (args[1] != NIL) : true;
LispObject eofValue = length > 2 ? args[2] : NIL;
// recursive-p is ignored
// boolean recursive = length > 3 ? (args[3] != NIL) : false;
return stream.readCharNoHang(eofError, eofValue);
}
};
// ### read-delimited-list char &optional input-stream recursive-p => list
private static final Primitive READ_DELIMITED_LIST =
new Primitive("read-delimited-list", "char &optional input-stream recursive-p") {
@Override
public LispObject execute(LispObject[] args) {
int length = args.length;
if (length < 1 || length > 3)
error(new WrongNumberOfArgumentsException(this, 1, 3));
char c = LispCharacter.getValue(args[0]);
Stream stream =
length > 1 ? inSynonymOf(args[1]) : getStandardInput();
return stream.readDelimitedList(c);
}
};
// ### unread-char character &optional input-stream => nil
private static final Primitive UNREAD_CHAR =
new Primitive(Symbol.UNREAD_CHAR, "character &optional input-stream") {
@Override
public LispObject execute(LispObject arg) {
return getStandardInput().unreadChar(checkCharacter(arg));
}
@Override
public LispObject execute(LispObject first, LispObject second)
{
Stream stream = inSynonymOf(second);
return stream.unreadChar(checkCharacter(first));
}
};
// ### write-vector-unsigned-byte-8
private static final Primitive WRITE_VECTOR_UNSIGNED_BYTE_8 =
new Primitive("write-vector-unsigned-byte-8", PACKAGE_SYS, true,
"vector stream start end") {
@Override
public LispObject execute(LispObject first, LispObject second,
LispObject third, LispObject fourth)
{
final AbstractVector v = checkVector(first);
final Stream stream = checkStream(second);
int start = Fixnum.getValue(third);
int end = Fixnum.getValue(fourth);
for (int i = start; i < end; i++)
stream._writeByte(v.aref(i));
return v;
}
};
// ### read-vector-unsigned-byte-8 vector stream start end => position
private static final Primitive READ_VECTOR_UNSIGNED_BYTE_8 =
new Primitive("read-vector-unsigned-byte-8", PACKAGE_SYS, true,
"vector stream start end") {
@Override
public LispObject execute(LispObject first, LispObject second,
LispObject third, LispObject fourth)
{
AbstractVector v = checkVector(first);
Stream stream = checkBinaryInputStream(second);
int start = Fixnum.getValue(third);
int end = Fixnum.getValue(fourth);
if (!v.getElementType().equal(UNSIGNED_BYTE_8))
return type_error(first, list(Symbol.VECTOR,
UNSIGNED_BYTE_8));
for (int i = start; i < end; i++) {
int n = stream._readByte();
if (n < 0) {
// End of file.
return Fixnum.getInstance(i);
}
v.aset(i, n);
}
return fourth;
}
};
// ### file-position
private static final Primitive FILE_POSITION =
new Primitive("file-position", "stream &optional position-spec") {
@Override
public LispObject execute(LispObject arg) {
return checkStream(arg).getFilePosition();
}
@Override
public LispObject execute(LispObject first, LispObject second)
{
return checkStream(first).setFilePosition(second);
}
};
// ### stream-line-number
private static final Primitive STREAM_LINE_NUMBER =
new Primitive("stream-line-number", PACKAGE_SYS, false, "stream") {
@Override
public LispObject execute(LispObject arg) {
return Fixnum.getInstance(checkStream(arg).getLineNumber() + 1);
}
};
// ### stream-offset
private static final Primitive STREAM_OFFSET =
new Primitive("stream-offset", PACKAGE_SYS, false, "stream") {
@Override
public LispObject execute(LispObject arg) {
return number(checkStream(arg).getOffset());
}
};
// ### stream-charpos stream => position
private static final Primitive STREAM_CHARPOS =
new Primitive("stream-charpos", PACKAGE_SYS, false) {
@Override
public LispObject execute(LispObject arg) {
Stream stream = checkCharacterOutputStream(arg);
return Fixnum.getInstance(stream.getCharPos());
}
};
// ### stream-%set-charpos stream newval => newval
private static final Primitive STREAM_SET_CHARPOS =
new Primitive("stream-%set-charpos", PACKAGE_SYS, false) {
@Override
public LispObject execute(LispObject first, LispObject second)
{
Stream stream = checkCharacterOutputStream(first);
stream.setCharPos(Fixnum.getValue(second));
return second;
}
};
public InputStream getWrappedInputStream() {
return in;
}
public OutputStream getWrappedOutputStream() {
return out;
}
public Writer getWrappedWriter() {
return writer;
}
public PushbackReader getWrappedReader() {
return reader;
}
}
