parent
8604e18719
commit
77d3b0b41e
|
@ -163,7 +163,6 @@ pic_error(pic_state *pic, const char *msg, pic_value irrs)
|
|||
pic_raise(pic, pic_obj_value(e));
|
||||
}
|
||||
|
||||
|
||||
static pic_value
|
||||
pic_error_with_exception_handler(pic_state *pic)
|
||||
{
|
||||
|
|
|
@ -506,7 +506,7 @@ gc_mark_global_symbols(pic_state *pic)
|
|||
M(sDEFINE); M(sLAMBDA); M(sIF); M(sBEGIN); M(sQUOTE); M(sSETBANG);
|
||||
M(sQUASIQUOTE); M(sUNQUOTE); M(sUNQUOTE_SPLICING);
|
||||
M(sDEFINE_SYNTAX); M(sIMPORT); M(sEXPORT);
|
||||
M(sDEFINE_LIBRARY);
|
||||
M(sDEFINE_LIBRARY); M(sIN_LIBRARY);
|
||||
M(sCOND_EXPAND); M(sAND); M(sOR); M(sELSE); M(sLIBRARY);
|
||||
M(sONLY); M(sRENAME); M(sPREFIX); M(sEXCEPT);
|
||||
M(sCONS); M(sCAR); M(sCDR); M(sNILP);
|
||||
|
@ -519,7 +519,7 @@ gc_mark_global_symbols(pic_state *pic)
|
|||
|
||||
M(rDEFINE); M(rLAMBDA); M(rIF); M(rBEGIN); M(rQUOTE); M(rSETBANG);
|
||||
M(rDEFINE_SYNTAX); M(rIMPORT); M(rEXPORT);
|
||||
M(rDEFINE_LIBRARY);
|
||||
M(rDEFINE_LIBRARY); M(rIN_LIBRARY);
|
||||
M(rCOND_EXPAND);
|
||||
M(rCONS); M(rCAR); M(rCDR); M(rNILP);
|
||||
M(rSYMBOLP); M(rPAIRP);
|
||||
|
|
|
@ -97,7 +97,7 @@ typedef struct {
|
|||
pic_sym *sDEFINE, *sLAMBDA, *sIF, *sBEGIN, *sQUOTE, *sSETBANG;
|
||||
pic_sym *sQUASIQUOTE, *sUNQUOTE, *sUNQUOTE_SPLICING;
|
||||
pic_sym *sDEFINE_SYNTAX, *sIMPORT, *sEXPORT;
|
||||
pic_sym *sDEFINE_LIBRARY;
|
||||
pic_sym *sDEFINE_LIBRARY, *sIN_LIBRARY;
|
||||
pic_sym *sCOND_EXPAND, *sAND, *sOR, *sELSE, *sLIBRARY;
|
||||
pic_sym *sONLY, *sRENAME, *sPREFIX, *sEXCEPT;
|
||||
pic_sym *sCONS, *sCAR, *sCDR, *sNILP;
|
||||
|
@ -111,7 +111,7 @@ typedef struct {
|
|||
|
||||
pic_sym *rDEFINE, *rLAMBDA, *rIF, *rBEGIN, *rQUOTE, *rSETBANG;
|
||||
pic_sym *rDEFINE_SYNTAX, *rIMPORT, *rEXPORT;
|
||||
pic_sym *rDEFINE_LIBRARY;
|
||||
pic_sym *rDEFINE_LIBRARY, *rIN_LIBRARY;
|
||||
pic_sym *rCOND_EXPAND;
|
||||
pic_sym *rCONS, *rCAR, *rCDR, *rNILP;
|
||||
pic_sym *rSYMBOLP, *rPAIRP;
|
||||
|
@ -213,6 +213,7 @@ pic_value pic_eval(pic_state *, pic_value, struct pic_lib *);
|
|||
struct pic_proc *pic_compile(pic_state *, pic_value, struct pic_lib *);
|
||||
pic_value pic_macroexpand(pic_state *, pic_value, struct pic_lib *);
|
||||
|
||||
void pic_in_library(pic_state *, pic_value);
|
||||
struct pic_lib *pic_make_library(pic_state *, pic_value);
|
||||
struct pic_lib *pic_find_library(pic_state *, pic_value);
|
||||
|
||||
|
|
|
@ -29,6 +29,18 @@ pic_make_library(pic_state *pic, pic_value name)
|
|||
return lib;
|
||||
}
|
||||
|
||||
void
|
||||
pic_in_library(pic_state *pic, pic_value spec)
|
||||
{
|
||||
struct pic_lib *lib;
|
||||
|
||||
lib = pic_find_library(pic, spec);
|
||||
if (! lib) {
|
||||
pic_errorf(pic, "library not found: ~a", spec);
|
||||
}
|
||||
pic->lib = lib;
|
||||
}
|
||||
|
||||
struct pic_lib *
|
||||
pic_find_library(pic_state *pic, pic_value spec)
|
||||
{
|
||||
|
@ -270,33 +282,45 @@ pic_lib_export(pic_state *pic)
|
|||
static pic_value
|
||||
pic_lib_define_library(pic_state *pic)
|
||||
{
|
||||
struct pic_lib *lib, *prev = pic->lib;
|
||||
struct pic_lib *prev = pic->lib;
|
||||
size_t argc, i;
|
||||
pic_value spec, *argv;
|
||||
|
||||
pic_get_args(pic, "o*", &spec, &argc, &argv);
|
||||
|
||||
if ((lib = pic_find_library(pic, spec)) == NULL) {
|
||||
lib = pic_make_library(pic, spec);
|
||||
if (! pic_find_library(pic, spec)) {
|
||||
pic_make_library(pic, spec);
|
||||
}
|
||||
|
||||
pic_try {
|
||||
pic->lib = lib;
|
||||
pic_in_library(pic, spec);
|
||||
|
||||
for (i = 0; i < argc; ++i) {
|
||||
pic_void(pic_eval(pic, argv[i], pic->lib));
|
||||
}
|
||||
|
||||
pic->lib = prev;
|
||||
pic_in_library(pic, prev->name);
|
||||
}
|
||||
pic_catch {
|
||||
pic->lib = prev; /* restores pic->lib even if an error occured */
|
||||
pic_in_library(pic, prev->name); /* restores pic->lib even if an error occurs */
|
||||
pic_raise(pic, pic->err);
|
||||
}
|
||||
|
||||
return pic_none_value();
|
||||
}
|
||||
|
||||
static pic_value
|
||||
pic_lib_in_library(pic_state *pic)
|
||||
{
|
||||
pic_value spec;
|
||||
|
||||
pic_get_args(pic, "o", &spec);
|
||||
|
||||
pic_in_library(pic, spec);
|
||||
|
||||
return pic_none_value();
|
||||
}
|
||||
|
||||
void
|
||||
pic_init_lib(pic_state *pic)
|
||||
{
|
||||
|
@ -306,4 +330,5 @@ pic_init_lib(pic_state *pic)
|
|||
pic_defmacro(pic, pic->sIMPORT, pic->rIMPORT, pic_lib_import);
|
||||
pic_defmacro(pic, pic->sEXPORT, pic->rEXPORT, pic_lib_export);
|
||||
pic_defmacro(pic, pic->sDEFINE_LIBRARY, pic->rDEFINE_LIBRARY, pic_lib_define_library);
|
||||
pic_defmacro(pic, pic->sIN_LIBRARY, pic->rIN_LIBRARY, pic_lib_in_library);
|
||||
}
|
||||
|
|
|
@ -391,6 +391,7 @@ pic_null_syntactic_environment(pic_state *pic)
|
|||
pic_define_syntactic_keyword(pic, env, pic->sDEFINE_LIBRARY, pic->rDEFINE_LIBRARY);
|
||||
pic_define_syntactic_keyword(pic, env, pic->sIMPORT, pic->rIMPORT);
|
||||
pic_define_syntactic_keyword(pic, env, pic->sEXPORT, pic->rEXPORT);
|
||||
pic_define_syntactic_keyword(pic, env, pic->sIN_LIBRARY, pic->rIN_LIBRARY);
|
||||
pic_define_syntactic_keyword(pic, env, pic->sCOND_EXPAND, pic->rCOND_EXPAND);
|
||||
|
||||
return env;
|
||||
|
|
|
@ -250,6 +250,7 @@ pic_open(int argc, char *argv[], char **envp, pic_allocf allocf)
|
|||
S(sIMPORT, "import");
|
||||
S(sEXPORT, "export");
|
||||
S(sDEFINE_LIBRARY, "define-library");
|
||||
S(sIN_LIBRARY, "in-library");
|
||||
S(sCOND_EXPAND, "cond-expand");
|
||||
S(sAND, "and");
|
||||
S(sOR, "or");
|
||||
|
@ -301,6 +302,7 @@ pic_open(int argc, char *argv[], char **envp, pic_allocf allocf)
|
|||
R(rIMPORT, "import");
|
||||
R(rEXPORT, "export");
|
||||
R(rDEFINE_LIBRARY, "define-library");
|
||||
R(rIN_LIBRARY, "in-library");
|
||||
R(rCOND_EXPAND, "cond-expand");
|
||||
R(rCONS, "cons");
|
||||
R(rCAR, "car");
|
||||
|
|
Loading…
Reference in New Issue