116 lines
2.4 KiB
C
116 lines
2.4 KiB
C
/**
|
|
* See Copyright Notice in picrin.h
|
|
*/
|
|
|
|
#include "picrin.h"
|
|
#include "picrin/lib.h"
|
|
#include "picrin/pair.h"
|
|
#include "picrin/macro.h"
|
|
|
|
struct pic_lib *
|
|
pic_make_library(pic_state *pic, pic_value name)
|
|
{
|
|
struct pic_lib *lib;
|
|
struct pic_senv *senv;
|
|
|
|
if ((lib = pic_find_library(pic, name)) != NULL) {
|
|
|
|
#if DEBUG
|
|
printf("* reopen library: ");
|
|
pic_debug(pic, name);
|
|
puts("");
|
|
#endif
|
|
|
|
return lib;
|
|
}
|
|
|
|
senv = pic_null_syntactic_environment(pic);
|
|
|
|
lib = (struct pic_lib *)pic_obj_alloc(pic, sizeof(struct pic_lib), PIC_TT_LIB);
|
|
lib->env = senv;
|
|
lib->name = name;
|
|
xh_init_int(&lib->exports, sizeof(pic_sym));
|
|
|
|
/* register! */
|
|
pic->lib_tbl = pic_acons(pic, name, pic_obj_value(lib), pic->lib_tbl);
|
|
|
|
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)
|
|
{
|
|
pic_value v;
|
|
|
|
v = pic_assoc(pic, spec, pic->lib_tbl, NULL);
|
|
if (pic_false_p(v)) {
|
|
return NULL;
|
|
}
|
|
return pic_lib_ptr(pic_cdr(pic, v));
|
|
}
|
|
|
|
void
|
|
pic_import(pic_state *pic, pic_value spec)
|
|
{
|
|
struct pic_lib *lib;
|
|
xh_iter it;
|
|
|
|
lib = pic_find_library(pic, spec);
|
|
if (! lib) {
|
|
pic_errorf(pic, "library not found: ~a", spec);
|
|
}
|
|
xh_begin(&it, &lib->exports);
|
|
while (xh_next(&it)) {
|
|
|
|
#if DEBUG
|
|
printf("* importing %s as %s\n", pic_symbol_name(pic, xh_key(it.e, pic_sym)), pic_symbol_name(pic, xh_val(it.e, pic_sym)));
|
|
#endif
|
|
|
|
pic_put_rename(pic, pic->lib->env, xh_key(it.e, pic_sym), xh_val(it.e, pic_sym));
|
|
}
|
|
}
|
|
|
|
void
|
|
pic_export(pic_state *pic, pic_sym sym)
|
|
{
|
|
pic_sym rename;
|
|
|
|
if (! pic_find_rename(pic, pic->lib->env, sym, &rename)) {
|
|
pic_errorf(pic, "export: symbol not defined %s", pic_symbol_name(pic, sym));
|
|
}
|
|
|
|
#if DEBUG
|
|
printf("* exporting %s as %s\n", pic_symbol_name(pic, sym), pic_symbol_name(pic, rename));
|
|
#endif
|
|
|
|
xh_put_int(&pic->lib->exports, sym, &rename);
|
|
}
|
|
|
|
void
|
|
pic_export_as(pic_state *pic, pic_sym sym, pic_sym as)
|
|
{
|
|
pic_sym rename;
|
|
|
|
if (! pic_find_rename(pic, pic->lib->env, sym, &rename)) {
|
|
pic_errorf(pic, "export: symbol not defined %s", pic_symbol_name(pic, sym));
|
|
}
|
|
|
|
#if DEBUG
|
|
printf("* exporting %s as %s\n", pic_symbol_name(pic, as), pic_symbol_name(pic, rename));
|
|
#endif
|
|
|
|
xh_put_int(&pic->lib->exports, as, &rename);
|
|
}
|