LispRef content(LispRef stream, LispRef eos_error_p, LispRef eos_value)
{
WITH_DEBUG(fprintf(stderr, "content\n"));
char tag;
read_byte(tag);
WITH_DEBUG(fprintf(stderr, " tag: %x\n", tag));
switch (tag)
{
case TC_NULL:
return nullReference(stream, eos_error_p, eos_value);
case TC_REFERENCE:
return prevObject(stream, eos_error_p, eos_value);
case TC_CLASS:
return newClass(stream, eos_error_p, eos_value);
case TC_OBJECT:
return newObject(stream, eos_error_p, eos_value);
case TC_STRING:
return newString(stream, eos_error_p, eos_value);
case TC_STATE:
return newState(stream, eos_error_p, eos_value);
case TC_VECTOR:
return newVector(stream, eos_error_p, eos_value);
case TC_STREAM:
return newStream(stream, eos_error_p, eos_value);
case TC_RESET:
return reset(stream, eos_error_p, eos_value);
case TC_SELF:
return stream;
case TC_FUNCTION:
return newFunction(stream, eos_error_p, eos_value);
case TC_BYTEVECTOR:
return newBytevector(stream, eos_error_p, eos_value);
case TC_INT:
return newInt(stream, eos_error_p, eos_value);
case TC_DOUBLE:
return newDouble(stream, eos_error_p, eos_value);
case TC_SYMBOL:
return newSymbol(stream, eos_error_p, eos_value);
case TC_KEYWORD:
return newKeyword(stream, eos_error_p, eos_value);
case TC_CHAR:
return newChar(stream, eos_error_p, eos_value);
case TC_CONS:
return newCons(stream, eos_error_p, eos_value);
default:
{
LispRef str, args;
eul_allocate_string(str, "unknown tag in ~a");
eul_allocate_cons(args, stream, eul_nil);
eul_serial_error(stream, str, args);
return eul_nil;
}
}
}
OBJ
builtin_cons(int numArgs){
if(numArgs != 2){
POPN(numArgs);
js_error("(cons): expects 2 arguments", js_nil);
}
OBJ arg2 = POP();
OBJ arg1 = POP();
return newCons(arg1, arg2);
}
static OBJ
readList(OBJ inStream){
int ch;
OBJ car, cdr;
ch = skipWhiteSpace(inStream);
if( ch == ')'){
return js_nil;
}
unreadChar(inStream, ch);
car = js_read(inStream);
cdr = readList(inStream);
return newCons(car, cdr);
}
OBJ
js_read(OBJ inStream){
OBJ retVal;
prompt_off();
char ch = skipWhiteSpace(inStream);
if( ch == -1){
retVal = js_eof;
unreadChar(inStream, ch);
}
else if(ch == '('){
retVal = readList(inStream);
}
else if(ch =='\''){
OBJ expr = js_read(inStream);
// (quote (expr* (nil))) -> expr must be a cons
return newCons(symbolTableGetOrAdd("quote"),
newCons(expr, js_nil));
}
else if(ch == '"'){
retVal = readString(inStream);
}
else if(isDigit(ch)){
retVal = readNumber(inStream, ch, 0);
}else if(ch == '-'){
/*
* TO-DO refactor: implement proper read ahead solution
*/
// simple read ahead to catch negative numbers
char nextCh = nextChar(inStream);
if(isDigit(nextCh)){
retVal = readNumber(inStream, nextCh, 1);
}else{
unreadChar(inStream, nextCh);
retVal = readSymbol(inStream, ch);
}
}
#ifdef DEBUG
else if(ch == '%'){
ch = nextChar(inStream);
OBJ debugOption;
if(ch == '\n' ){
unreadChar(inStream, ch);
debugOption = newSymbol("");
}else{
debugOption = readSymbol(inStream, ch);
}
switchDebugOptions( debugOption );
retVal = js_void;
}
#endif
else {
retVal = readSymbol(inStream, ch);
}
if(thisIsTheEnd(inStream)){
prompt_on();
};
return retVal;
}
