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