示例#1
0
文件: io.hpp 项目: leftmike/foment
inline FObject CurrentInputPort()
{
    FAssert(PairP(IndexParameter(INDEX_PARAMETER_CURRENT_INPUT_PORT)));

    FObject port = First(IndexParameter(INDEX_PARAMETER_CURRENT_INPUT_PORT));

    FAssert(InputPortP(port) && InputPortOpenP(port));

    return(port);
}
示例#2
0
FObject CompileProgram(FObject nam, FObject port)
{
    FAssert(TextualPortP(port) && InputPortOpenP(port));

    WantIdentifiersPort(port, 1);

    FDontWait dw;
    FObject env = MakeEnvironment(nam, FalseObject);
    FObject prog = EmptyListObject;
    FObject body = EmptyListObject;

    try
    {
        for (;;)
        {
            FObject obj = Read(port);
            if (obj == EndOfFileObject)
                break;

            if (PairP(obj) && EqualToSymbol(First(obj), R.CondExpandSymbol))
            {
                FObject ce = CondExpand(MakeSyntacticEnv(R.Bedrock), obj, Rest(obj));
                if (ce != EmptyListObject)
                    prog = CondExpandProgram(ce, prog);
            }
            else
                prog = MakePair(obj, prog);
        }

        prog = ReverseListModify(prog);

        while (prog != EmptyListObject)
        {
            FAssert(PairP(prog));

            FObject obj = First(prog);
            if (PairP(obj) == 0)
                break;

            if (EqualToSymbol(First(obj), R.ImportSymbol))
                EnvironmentImport(env, obj);
            else if (EqualToSymbol(First(obj), R.DefineLibrarySymbol))
                CompileLibrary(obj);
            else
                break;

            prog = Rest(prog);
        }

        if (R.LibraryStartupList != EmptyListObject)
        {
            body = MakePair(MakePair(BeginSyntax, ReverseListModify(R.LibraryStartupList)), body);
            R.LibraryStartupList = EmptyListObject;
        }

        while (prog != EmptyListObject)
        {
            FAssert(PairP(prog));

            body = CompileEvalExpr(First(prog), env, body);
            prog = Rest(prog);
        }
    }
    catch (FObject obj)
    {
        if (ExceptionP(obj) == 0)
            WriteStringC(R.StandardOutput, "exception: ");
        Write(R.StandardOutput, obj, 0);
        WriteCh(R.StandardOutput, '\n');
    }

    FObject proc = CompileLambda(env, NoValueObject, EmptyListObject, ReverseListModify(body));

    UndefinedList = EmptyListObject;
    EqHashMapVisit(AsEnvironment(env)->HashMap, Visit, NoValueObject);
    if (UndefinedList != EmptyListObject)
        RaiseExceptionC(R.Syntax, "program", "identifier(s) used but never defined",
                List(UndefinedList, nam));

    return(proc);
}