static FObject CompileAkas(FObject env, FObject lst)
{
FObject akalst = EmptyListObject;
while (PairP(lst))
{
FAssert(PairP(First(lst)));
FAssert(IdentifierP(First(First(lst))) || SymbolP(First(First(lst))));
FObject form = First(lst);
if (EqualToSymbol(First(form), R.AkaSymbol))
{
if (PairP(Rest(form)) == 0 || Rest(Rest(form)) != EmptyListObject)
RaiseExceptionC(R.Syntax, "aka", "expected (aka <library-name>)", List(form));
FObject ln = LibraryName(First(Rest(form)));
if (PairP(ln) == 0)
RaiseExceptionC(R.Syntax, "aka",
"library name must be a list of symbols and/or integers",
List(First(Rest(form))));
akalst = MakePair(ln, akalst);
}
else
{
FAssert(EqualToSymbol(First(form), R.ImportSymbol)
|| EqualToSymbol(First(form), R.ExportSymbol)
|| EqualToSymbol(First(form), R.IncludeLibraryDeclarationsSymbol)
|| EqualToSymbol(First(form), R.CondExpandSymbol)
|| EqualToSymbol(First(form), R.BeginSymbol)
|| EqualToSymbol(First(form), R.IncludeSymbol)
|| EqualToSymbol(First(form), R.IncludeCISymbol));
}
lst = Rest(lst);
}
FAssert(lst == EmptyListObject);
return(akalst);
}
void CompileLibrary(FObject expr)
{
if (PairP(Rest(expr)) == 0)
RaiseExceptionC(R.Syntax, "define-library", "expected a library name",
List(expr));
FObject ln = LibraryName(First(Rest(expr)));
if (PairP(ln) == 0)
RaiseExceptionC(R.Syntax, "define-library",
"library name must be a list of symbols and/or integers", List(First(Rest(expr))));
FObject env = MakeEnvironment(ln, FalseObject);
FObject body = ReverseListModify(ExpandLibraryDeclarations(env, Rest(Rest(expr)),
EmptyListObject));
FObject proc = CompileLibraryCode(env, body);
FObject exports = CompileExports(env, body);
FObject akalst = CompileAkas(env, body);
UndefinedList = EmptyListObject;
EqHashMapVisit(AsEnvironment(env)->HashMap, Visit, NoValueObject);
if (UndefinedList != EmptyListObject)
RaiseExceptionC(R.Syntax, "define-library", "identifier(s) used but never defined",
List(UndefinedList, expr));
FObject lib = MakeLibrary(ln, exports, proc);
while (akalst != EmptyListObject)
{
FAssert(PairP(akalst));
FAssert(LibraryP(lib));
MakeLibrary(First(akalst), AsLibrary(lib)->Exports, NoValueObject);
akalst = Rest(akalst);
}
}
static FObject DoImportSet(FObject env, FObject is, FObject form)
{
// <library-name>
// (only <import-set> <identifier> ...)
// (except <import-set> <identifier> ...)
// (prefix <import-set> <identifier>)
// (rename <import-set> (<identifier1> <identifier2>) ...)
if (PairP(is) == 0 || (IdentifierP(First(is)) == 0 && SymbolP(First(is)) == 0))
RaiseExceptionC(R.Syntax, "import", "expected a list starting with an identifier",
List(is, form));
if (EqualToSymbol(First(is), R.OnlySymbol))
{
FObject ilst = DoOnlyOrExcept(env, is, 1);
if (ilst == NoValueObject)
RaiseExceptionC(R.Syntax, "import",
"expected (only <import-set> <identifier> ...)", List(is, form));
return(ilst);
}
else if (EqualToSymbol(First(is), R.ExceptSymbol))
{
FObject ilst = DoOnlyOrExcept(env, is, 0);
if (ilst == NoValueObject)
RaiseExceptionC(R.Syntax, "import",
"expected (except <import-set> <identifier> ...)", List(is, form));
return(ilst);
}
else if (EqualToSymbol(First(is), R.PrefixSymbol))
{
if (PairP(Rest(is)) == 0 || PairP(Rest(Rest(is))) == 0
|| Rest(Rest(Rest(is))) != EmptyListObject ||
(IdentifierP(First(Rest(Rest(is)))) == 0 && SymbolP(First(Rest(Rest(is)))) == 0))
RaiseExceptionC(R.Syntax, "import",
"expected (prefix <import-set> <identifier>)", List(is, form));
FObject prfx;
if (SymbolP(First(Rest(Rest(is)))))
prfx = AsSymbol(First(Rest(Rest(is))))->String;
else
prfx = AsSymbol(AsIdentifier(First(Rest(Rest(is))))->Symbol)->String;
FObject ilst = DoImportSet(env, First(Rest(is)), is);
FObject lst = ilst;
while (PairP(lst))
{
FAssert(GlobalP(First(lst)));
// AsGlobal(First(lst))->Name = PrefixSymbol(prfx, AsGlobal(First(lst))->Name);
Modify(FGlobal, First(lst), Name, PrefixSymbol(prfx, AsGlobal(First(lst))->Name));
lst = Rest(lst);
}
FAssert(lst == EmptyListObject);
return(ilst);
}
else if (EqualToSymbol(First(is), R.RenameSymbol))
{
if (PairP(Rest(is)) == 0)
RaiseExceptionC(R.Syntax, "import",
"expected (rename <import-set> (<identifier> <identifier>) ...)",
List(is, form));
FObject ilst = DoImportSet(env, First(Rest(is)), is);
FObject rlst = Rest(Rest(is));
while (PairP(rlst))
{
FObject rnm = First(rlst);
if (PairP(rnm) == 0 || PairP(Rest(rnm)) == 0 || Rest(Rest(rnm)) != EmptyListObject
|| (IdentifierP(First(rnm)) == 0 && SymbolP(First(rnm)) == 0)
|| (IdentifierP(First(Rest(rnm))) == 0 && SymbolP(First(Rest(rnm))) == 0))
RaiseExceptionC(R.Syntax, "import",
"expected (rename <import-set> (<identifier> <identifier>) ...)",
List(is, form));
rlst = Rest(rlst);
}
if (rlst != EmptyListObject)
RaiseExceptionC(R.Syntax, "import",
"expected (rename <import-set> (<identifier> <identifier>) ...)",
List(is, form));
FObject lst = ilst;
while (PairP(lst))
{
FAssert(GlobalP(First(lst)));
FObject nm = CheckForRename(AsGlobal(First(lst))->Name, Rest(Rest(is)));
if (SymbolP(nm))
{
// AsGlobal(First(lst))->Name = nm;
Modify(FGlobal, First(lst), Name, nm);
}
lst = Rest(lst);
}
FAssert(lst == EmptyListObject);
return(ilst);
}
FObject nam = LibraryName(is);
if (PairP(nam) == 0)
RaiseExceptionC(R.Syntax, "import",
"library name must be a list of symbols and/or integers", List(is));
FObject lib = FindOrLoadLibrary(nam);
if (LibraryP(lib) == 0)
RaiseExceptionC(R.Syntax, "import", "library not found", List(nam, form));
FObject ilst = EmptyListObject;
FObject elst = AsLibrary(lib)->Exports;
while (PairP(elst))
{
FAssert(PairP(First(elst)));
FAssert(SymbolP(First(First(elst))));
FAssert(GlobalP(Rest(First(elst))));
ilst = MakePair(ImportGlobal(env, First(First(elst)), Rest(First(elst))), ilst);
elst = Rest(elst);
}
FAssert(elst == EmptyListObject);
return(ilst);
}
std::string NameName(const flat::Name& name, StringView library_separator, StringView name_separator) {
std::string compiled_name = LibraryName(name.library(), library_separator);
compiled_name += name_separator;
compiled_name += name.name_part();
return compiled_name;
}
