extern "C" cons_t* srfi0_cond_expand(const cons_t* p, environment_t* e)
{
return eval(cond_expand(p, e), e);
}
/*
* Parse (define-library ...) form into given environment, with the
* following format:
*
* (define-library <library name>
* <library declaration> ...)
*
* where <library declaration> is any of:
*
* - (export <export spec> ...)
* - (import <import set> ...)
* - (begin <command or definition> ...)
* - (include <filename1> <filename2> ...)
* - (include-ci <filename1> <filename2> ...)
* - (cond-expand <cond-expand clause> ...)
*/
static library_t* define_library(cons_t* p, const char* file)
{
library_t *r = new library_t();
cons_t *exports = nil();
// find current dir for resolving include and include-ci
std::string curdir = sdirname(file);
// define-library
if ( symbol_name(caar(p)) != "define-library" )
raise(syntax_error(format(
"Imported file does not begin with define-library: %s", file)));
// <library name>
r->name = verify_library_name(cadar(p));
// A <library declaration> can be either ...
for ( p = cdr(cdar(p)); !nullp(p); p = cdr(p) ) {
cons_t *id = caar(p);
cons_t *body = cdar(p);
std::string s = symbol_name(id);
if ( s == "export" ) {
exports = body;
continue;
}
if ( s == "import" ) {
// TODO: Make sure that proc_import does not override
// r->internals->outer
proc_import(body, r->internals);
continue;
}
if ( s == "begin" ) {
eval(car(p), r->internals);
continue;
}
if ( s == "include" ) {
eval(splice(list(symbol("begin")),
include(body, r->internals, curdir.c_str())),
r->internals);
continue;
}
if ( s == "include-ci" ) {
eval(splice(list(symbol("begin")),
include_ci(body, r->internals, curdir.c_str())),
r->internals);
continue;
}
if ( s == "cond-expand" ) {
eval(cond_expand(body, r->internals), r->internals);
continue;
}
}
// copy exports into exports-environemnt
for ( p = exports; !nullp(p); p = cdr(p) ) {
// handle renaming
if ( listp(car(p)) && length(car(p))==3 &&
symbol_name(caar(p))=="rename" )
{
assert_type(SYMBOL, cadar(p));
assert_type(SYMBOL, caddar(p));
std::string internal_name = symbol_name(cadar(p));
std::string external_name = symbol_name(caddar(p));
r->exports->define(external_name,
r->internals->lookup(internal_name));
} else if ( listp(car(p)) )
raise(syntax_error("(export <spec> ...) only allows (rename x y)"));
else if ( type_of(car(p)) == SYMBOL ) {
r->exports->define(symbol_name(car(p)),
r->internals->lookup(symbol_name(car(p))));
} else
raise(syntax_error(
"(export <spec> ...) requires <spec> to be "
"either an identifier or a pair of them."));
}
return r;
}
