static FObject LoadLibrary(FObject nam)
{
FDontWait dw;
FObject lp = R.LibraryPath;
while (PairP(lp))
{
FAssert(StringP(First(lp)));
FObject le = R.LibraryExtensions;
while (PairP(le))
{
FAssert(StringP(First(le)));
FObject libfn = LibraryNameFlat(First(lp), nam, First(le));
FObject port = OpenInputFile(libfn);
if (TextualPortP(port) == 0)
{
libfn = LibraryNameDeep(First(lp), nam, First(le));
port = OpenInputFile(libfn);
}
if (TextualPortP(port))
{
WantIdentifiersPort(port, 1);
for (;;)
{
FObject obj = Read(port);
if (obj == EndOfFileObject)
break;
if (PairP(obj) == 0 || EqualToSymbol(First(obj), R.DefineLibrarySymbol) == 0)
RaiseExceptionC(R.Syntax, "define-library", "expected a library",
List(libfn, obj));
CompileLibrary(obj);
}
}
FObject lib = FindLibrary(nam);
if (LibraryP(lib))
return(lib);
le = Rest(le);
}
lp = Rest(lp);
}
FAssert(lp == EmptyListObject);
return(NoValueObject);
}
LVal remove_if_not1(Function1 f,LVal v) {
LVal ret;
for(ret=0;v;v=Next(v)) {
LVal fret=f(v);
if(fret) {
if(NumberP(first(v))) {
ret=consi(firsti(v),ret);
}else if(StringP(first(v))) {
ret=conss(q(firsts(v)),ret);
}
}
sL(fret);
}
return nreverse(ret);
}
void CLispEng::Print(ostream& os, CP form) {
form &= ~FLAG_Mark;
//!!! os << "<" << (void*)form << ">";
os << String(' ', m_printIndent*2);
switch (Type(form)) {
/*!!! case TS_NIL:
os << "NIL";
break;*/
case TS_CHARACTER:
{
os << "#\\";
wchar_t ch = AsChar(form);
switch (ch) {
case '\0': os << "NULL"; break;
case '\a': os << "BELL"; break;
case '\b': os << "BS"; break;
case '\t': os << "TAB"; break;
case '\n': os << "NL"; break;
case '\r': os << "CR"; break;
case '\f': os << "FF"; break;
case '\x1B': os << "ESC"; break;
case '\x7F': os << "RUBOUT"; break;
default: os << (char)ch; break; //!!!
}
}
break;
case TS_FIXNUM:
os << AsNumber(form);
break;
case TS_FRAME_PTR:
os << "#<FRAME " << (DWORD)AsIndex(form) << ">";
break;
case TS_FRAMEINFO:
os << "#<FRAMEINFO>";
break;
case TS_BIGNUM:
os << ToBigInteger(form);
break;
case TS_FLONUM:
os << AsFloatVal(form);
break;
case TS_SYMBOL:
{
//!!! Print(get_Special(L_S_PACKAGE));//!!!D
CSymbolValue *sv = ToSymbol(form);
if (sv->HomePackage == m_packKeyword)
os << ':';
else if (!sv->HomePackage)
os << "#:";
/*!!! else if (!ToPackage(get_Special(L_S_PACKAGE))->IsPresent(form))
{
CPackage *pack = ToPackage(sv->HomePackage);
os << pack->m_name << ':';
if (pack->m_mapExternalSym.find(sv) == pack->m_mapExternalSym.end())
os << ':';
}*/
#if UCFG_LISP_SPLIT_SYM
os << SymNameByIdx(AsIndex(form));
#else
os << sv->m_s;
#endif
}
break;
case TS_PATHNAME:
os << "#P\"" << AsPathname(form)->ToString() << "\"";
break;
case TS_RATIO:
Print(os, AsRatio(form)->m_numerator);
os << "/";
Print(os, AsRatio(form)->m_denominator);
break;//!!!
case TS_MACRO:
os << "#<MACRO>";
break;
case TS_COMPLEX:
os << "#C()"; //!!!
break;
case TS_CONS:
switch (form) {
case 0:
os << "NIL";
break;
case V_U:
os << "#<UNBOUND>";
break;
default:
CSPtr car = Car(form),
cdr = Cdr(form);
if (car == S(L_QUOTE)) {
if (ConsP(cdr)) {
os << "\'";
Print(os, Car(cdr));
break;
}
}
if (car == S(L_BACKQUOTE)) {
os << "`";
Print(os, Car(cdr));
} else if (car == S(L_UNQUOTE)) {
os << ",";
Print(os, Car(cdr));
} else if (car == S(L_SPLICE)) {
os << ",@";
Print(os, Car(cdr));
} else {
os << "(";
PrintList(os, form);
os << ")";
}
}
break;
case TS_STRUCT:
os << "#<STRUCT " << (DWORD)AsIndex(form) << ">";
break;
case TS_STREAM:
os << "#<STREAM " << (DWORD)AsIndex(form) << ">";
break;
case TS_WEAKPOINTER:
os << "<#WEAKPOINTER ";
Print(os, ToWeakPointer(form)->m_p);
os << ">";
break;
case TS_SUBR:
case TS_INTFUNC:
case TS_CCLOSURE:
{
os << "#\'";
Push(m_r);
pair<CP, CP> pp = GetFunctionName(form);
Print(os, pp.second);
m_r = Pop();
}
break;
case TS_PACKAGE:
os << "#<PACKAGE " << ToPackage(form)->m_name << ">";
break;
case TS_READTABLE:
os << "#<READTABLE>";
break;
case TS_HASHTABLE:
{
os << "#S(HASH-TABLE <fun>";
CHashMap& m = *Lisp().ToHashTable(form)->m_pMap;
for (CHashMap::iterator i=m.begin(); i!=m.end(); ++i) {
os << "(";
Print(os, i->first);
os << " . ";
Print(os, i->second);
os << ")";
}
os << ">";
}
break;
case TS_ARRAY:
if (StringP(form))
os << "\"" << AsString(form) << "\"";
else if (VectorP(form)) {
os << "#(";
CArrayValue *av = ToArray(form);
for (size_t i=0; i<av->GetVectorLength(); i++) {
if (i)
os << " ";
Print(os, av->GetElement(i));
}
os << ")";
} else {
CArrayValue *av = ToArray(form);
os << "<ARRAY " << (DWORD)av->TotalSize() << ">";
//!!!
/*!!! os << "#(";
for (int i=0; i<vv->m_count-1; i++)
{
Print(vv->m_pData[i]);
os << " ";
}
os << ")";*/
}
break;
case TS_OBJECT:
{
os << "#<OBJECT ";
//!!! Print(ToObject(form)->m_class);
os << " ";
//!!! Print(ToObject(form)->m_slots);
os << ">";
}
break;
case TS_SYMBOLMACRO:
{
os << "#<SYMBOL-MACRO ";
CSymbolMacro *sm = ToSymbolMacro(form);
Print(os, sm->m_macro);
os << ">";
}
break;
#if UCFG_LISP_FFI
case TS_FF_PTR:
os << "#<POINTER " << ToPointer(form) << ">";
break;
#endif
default:
os << "#<Bad Form>";
//!!! Ext::Throw(E_FAIL);
}
}
