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; }