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