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