static environment_t* except(environment_t* e, cons_t* ids)
{
assert_type(PAIR, ids);
// build a new environment and return it
environment_t *r = null_environment();
for ( dict_t::const_iterator i = e->symbols.begin();
i != e->symbols.end(); ++i )
{
std::string name = (*i).first;
// do not import specified name
// TODO: Fix slow O(n^2) algo below
for ( cons_t *id = ids; !nullp(id); id = cdr(id) ) {
assert_type(SYMBOL, car(id));
if ( symbol_name(car(id)) == name )
goto DO_NOT_IMPORT;
}
r->symbols[name] = (*i).second;
DO_NOT_IMPORT:
continue;
}
return r;
}
static environment_t* only(environment_t* e, cons_t* ids)
{
assert_type(PAIR, ids);
// build a new environment and return it
environment_t *r = null_environment();
for ( dict_t::const_iterator i = e->symbols.begin();
i != e->symbols.end(); ++i )
{
std::string name = (*i).first;
// only import specified names
// TODO: Fix slow O(n^2) algo below
for ( cons_t *id = ids; !nullp(id); id = cdr(id) ) {
assert_type(SYMBOL, car(id));
if ( symbol_name(car(id)) == name ) {
r->symbols[name] = (*i).second;
break;
}
}
}
return r;
}
static environment_t* rename(environment_t* e, cons_t* ids)
{
assert_type(PAIR, ids);
// build a new environment and return it
environment_t *r = null_environment();
// TODO: Below code runs in slow O(n^2) time
for ( dict_t::const_iterator i = e->symbols.begin();
i != e->symbols.end(); ++i )
{
std::string name = (*i).first;
// find new name
for ( cons_t *id = ids; !nullp(id); id = cdr(id) ) {
assert_type(PAIR, car(id));
assert_type(SYMBOL, caar(id));
assert_type(SYMBOL, cadar(id));
if ( symbol_name(caar(id)) == name ) {
name = symbol_name(cadar(id));
break;
}
}
r->symbols[name] = (*i).second;
}
return r;
}
environment_t* import_library(const std::string& name)
{
load_library_index();
environment_t* r = null_environment();
/*
* This library needs special treatment; all other libraries depend on it
* to load dynamic shared object files.
*/
if ( name == "(unix dlopen)" ) {
import_unix_dlopen(r);
return r;
}
/*
* TODO: This lookup is O(n^2)-slow, but it will run so seldomly that it really
* doesn't matter. Can be done in O(n log n) or O(1) time, but at a cost
* of algorithmic complexity.
*/
for ( library_map_t* lib = library_map;
lib->library_name != NULL; ++lib )
{
if ( name == lib->library_name ) {
import_scheme_file(r, lib->source_file);
return r;
}
}
raise(runtime_exception("Unknown library: " + name));
return NULL;
}
cons_t* proc_environment(cons_t* p, environment_t*)
{
assert_length_min(p, 1);
environment_t *out = null_environment(7);
// Handle import sets
for ( ; !nullp(p); p = cdr(p) ) {
environment_t *impenv = import_set(car(p));
merge(out, impenv);
impenv->outer = out;
}
return environment(out);
}
static environment_t* prefix(environment_t* e, cons_t* identifier)
{
assert_type(SYMBOL, identifier);
// build a new environment and return it
environment_t *r = null_environment();
for ( dict_t::const_iterator i = e->symbols.begin();
i != e->symbols.end(); ++i )
{
const std::string prefix = symbol_name(identifier);
const std::string name = (*i).first;
r->symbols[prefix + name] = (*i).second;
}
return r;
}
library_t() :
name(nil()),
exports(null_environment()),
internals(exports->extend())
{
}
void load_library_index()
{
if ( library_map != NULL )
return;
std::string filename = library_file(library_index_file);
environment_t *env = null_environment();
program_t *p = parse(slurp(open_file(filename)), env);
cons_t *index = p->root;
if ( !pairp(index) || !symbolp(caar(index)) )
invalid_index_format(filename + ": no list with symbols");
for ( ; !nullp(index); index = cdr(index) ) {
if ( symbol_name(caar(index)) == "define-library-index" ) {
if ( library_map != NULL )
invalid_index_format(filename + ": only one define-library-index allowed");
if ( !listp(cdar(index)) ) {
invalid_index_format(filename
+ ": define-library-index is not a list");
}
size_t len = length(cdar(index));
library_map = (library_map_t*) malloc((1+len)*sizeof(library_map_t));
size_t i = 0;
for ( cons_t *lib = cdar(index); !nullp(lib); lib = cdr(lib), ++i ) {
cons_t *name = caar(lib);
cons_t *file = cadar(lib);
if ( !listp(name) || !stringp(file) )
invalid_index_format(filename + ": not list/string pair");
library_map[i].library_name = strdup(sprint(name).c_str());
library_map[i].source_file = strdup(file->string);
}
// important to signal end of list:
library_map[i].library_name = NULL;
library_map[i].source_file = NULL;
continue;
} else if ( symbol_name(caar(index)) == "define-repl-imports" ) {
if ( repl_libraries != NULL )
invalid_index_format(filename + ": only one define-repl-imports allowed");
if ( !listp(cdar(index)) ) {
invalid_index_format(filename
+ ": define-repl-imports is not a list");
}
size_t len = length(cdar(index));
repl_libraries = (const char**) malloc((1+len)*sizeof(char*));
const char **s = repl_libraries;
for ( cons_t *lib = cdar(index); !nullp(lib); lib = cdr(lib), ++s ) {
cons_t *name = car(lib);
*s = strdup(sprint(name).c_str());
}
*s = NULL;
continue;
} else
invalid_index_format(filename + ": unknown label "
+ sprint(caar(index)));
}
}