picrin/extlib/benz/lib.c

213 lines
4.7 KiB
C
Raw Normal View History

2014-08-25 00:38:09 -04:00
/**
* See Copyright Notice in picrin.h
*/
#include "picrin.h"
2015-06-09 07:20:56 -04:00
static void
setup_default_env(pic_state *pic, struct pic_env *env)
{
void pic_define_syntactic_keyword(pic_state *, struct pic_env *, pic_sym *, pic_sym *);
2015-06-09 12:06:56 -04:00
pic_define_syntactic_keyword(pic, env, pic->sDEFINE_LIBRARY, pic->uDEFINE_LIBRARY);
pic_define_syntactic_keyword(pic, env, pic->sIMPORT, pic->uIMPORT);
pic_define_syntactic_keyword(pic, env, pic->sEXPORT, pic->uEXPORT);
pic_define_syntactic_keyword(pic, env, pic->sCOND_EXPAND, pic->uCOND_EXPAND);
2015-06-09 07:20:56 -04:00
}
2014-08-25 00:38:09 -04:00
struct pic_lib *
2015-05-30 11:25:40 -04:00
pic_make_library(pic_state *pic, pic_value name)
2014-08-25 00:38:09 -04:00
{
struct pic_lib *lib;
2015-05-30 09:39:03 -04:00
struct pic_env *env;
2015-01-18 07:32:16 -05:00
struct pic_dict *exports;
2014-08-25 00:38:09 -04:00
if ((lib = pic_find_library(pic, name)) != NULL) {
2015-05-30 11:25:40 -04:00
pic_errorf(pic, "library name already in use: ~s", name);
2014-08-25 00:38:09 -04:00
}
2015-06-09 07:20:56 -04:00
env = pic_make_env(pic, NULL);
2015-01-18 07:32:16 -05:00
exports = pic_make_dict(pic);
2014-08-25 00:38:09 -04:00
2015-06-09 07:20:56 -04:00
setup_default_env(pic, env);
2014-08-25 00:38:09 -04:00
lib = (struct pic_lib *)pic_obj_alloc(pic, sizeof(struct pic_lib), PIC_TT_LIB);
lib->name = name;
2015-05-30 09:39:03 -04:00
lib->env = env;
2015-01-18 07:32:16 -05:00
lib->exports = exports;
2014-08-25 00:38:09 -04:00
/* register! */
pic->libs = pic_acons(pic, name, pic_obj_value(lib), pic->libs);
return lib;
}
struct pic_lib *
pic_find_library(pic_state *pic, pic_value spec)
{
pic_value v;
v = pic_assoc(pic, spec, pic->libs, NULL);
if (pic_false_p(v)) {
return NULL;
}
return pic_lib_ptr(pic_cdr(pic, v));
}
2015-06-16 12:52:20 -04:00
void
pic_import(pic_state *pic, struct pic_lib *lib)
2014-08-25 00:38:09 -04:00
{
2015-06-16 12:52:20 -04:00
pic_sym *name, *realname, *uid;
2015-06-24 16:56:15 -04:00
khiter_t it;
2015-06-09 09:36:04 -04:00
2015-06-16 12:52:20 -04:00
pic_dict_for_each (name, lib->exports, it) {
realname = pic_sym_ptr(pic_dict_ref(pic, lib->exports, name));
2015-06-09 09:36:04 -04:00
if ((uid = pic_find_variable(pic, lib->env, pic_obj_value(realname))) == NULL) {
2015-06-09 09:36:04 -04:00
pic_errorf(pic, "attempted to export undefined variable '~s'", pic_obj_value(realname));
}
2015-06-16 12:52:20 -04:00
pic_put_variable(pic, pic->lib->env, pic_obj_value(name), uid);
2014-08-25 00:38:09 -04:00
}
}
void
2015-06-16 12:52:20 -04:00
pic_export(pic_state *pic, pic_sym *name)
2014-08-25 00:38:09 -04:00
{
2015-06-16 12:52:20 -04:00
pic_dict_set(pic, pic->lib->exports, name, pic_obj_value(name));
2014-08-25 00:38:09 -04:00
}
2015-06-16 09:51:05 -04:00
static pic_value
pic_lib_make_library(pic_state *pic)
{
pic_value name;
pic_get_args(pic, "o", &name);
return pic_obj_value(pic_make_library(pic, name));
}
static pic_value
pic_lib_find_library(pic_state *pic)
{
pic_value name;
struct pic_lib *lib;
pic_get_args(pic, "o", &name);
if ((lib = pic_find_library(pic, name)) == NULL) {
return pic_false_value();
}
return pic_obj_value(lib);
}
2015-06-16 11:03:52 -04:00
static pic_value
pic_lib_current_library(pic_state *pic)
{
pic_value lib;
size_t n;
n = pic_get_args(pic, "|o", &lib);
if (n == 0) {
return pic_obj_value(pic->lib);
}
else {
pic_assert_type(pic, lib, lib);
pic->lib = pic_lib_ptr(lib);
return pic_undef_value();
}
}
2015-06-16 11:59:19 -04:00
static pic_value
pic_lib_library_import(pic_state *pic)
{
pic_value lib_opt;
pic_sym *name, *realname, *uid, *alias = NULL;
struct pic_lib *lib;
pic_get_args(pic, "om|m", &lib_opt, &name, &alias);
pic_assert_type(pic, lib_opt, lib);
if (alias == NULL) {
alias = name;
}
lib = pic_lib_ptr(lib_opt);
if (! pic_dict_has(pic, lib->exports, name)) {
pic_errorf(pic, "attempted to import undefined variable '~s'", pic_obj_value(name));
} else {
realname = pic_sym_ptr(pic_dict_ref(pic, lib->exports, name));
}
if ((uid = pic_find_variable(pic, lib->env, pic_obj_value(realname))) == NULL) {
pic_errorf(pic, "attempted to export undefined variable '~s'", pic_obj_value(realname));
} else {
pic_put_variable(pic, pic->lib->env, pic_obj_value(alias), uid);
}
return pic_undef_value();
}
2015-06-16 12:42:44 -04:00
static pic_value
pic_lib_library_export(pic_state *pic)
{
pic_sym *name, *alias = NULL;
pic_get_args(pic, "m|m", &name, &alias);
if (alias == NULL) {
alias = name;
}
pic_dict_set(pic, pic->lib->exports, alias, pic_obj_value(name));
return pic_undef_value();
}
2015-06-16 09:51:05 -04:00
static pic_value
pic_lib_library_exports(pic_state *pic)
{
pic_value lib, exports = pic_nil_value();
pic_sym *sym;
2015-06-24 16:56:15 -04:00
khiter_t it;
2015-06-16 09:51:05 -04:00
pic_get_args(pic, "o", &lib);
pic_assert_type(pic, lib, lib);
pic_dict_for_each (sym, pic_lib_ptr(lib)->exports, it) {
pic_push(pic, pic_obj_value(sym), exports);
}
return exports;
}
static pic_value
pic_lib_library_environment(pic_state *pic)
{
pic_value lib;
pic_get_args(pic, "o", &lib);
pic_assert_type(pic, lib, lib);
return pic_obj_value(pic_lib_ptr(lib)->env);
}
2014-08-25 00:38:09 -04:00
void
pic_init_lib(pic_state *pic)
{
2015-06-16 09:51:05 -04:00
pic_defun(pic, "make-library", pic_lib_make_library);
pic_defun(pic, "find-library", pic_lib_find_library);
pic_defun(pic, "library-exports", pic_lib_library_exports);
pic_defun(pic, "library-environment", pic_lib_library_environment);
2015-06-16 12:42:44 -04:00
pic_defun(pic, "current-library", pic_lib_current_library);
pic_defun(pic, "library-import", pic_lib_library_import);
pic_defun(pic, "library-export", pic_lib_library_export);
2014-08-25 00:38:09 -04:00
}