Beispiel #1
0
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);
}
Beispiel #2
0
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);
}
Beispiel #3
0
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);
	}
}