Merge branch 'renaming-import'
This commit is contained in:
Yuichi Nishiwaki
commit
170fef3516
|
|
@ -55,7 +55,7 @@ section status comments
|
|||
4.3.2 Pattern language yes ``syntax-rules``
|
||||
4.3.3 Signaling errors in macro transformers yes
|
||||
5.1 Programs yes
|
||||
5.2 Import declarations incomplete only simple import declarations, no support for import with renaming.
|
||||
5.2 Import declarations yes
|
||||
5.3.1 Top level definitions yes
|
||||
5.3.2 Internal definitions yes TODO: interreferential definitions
|
||||
5.3.3 Multiple-value definitions yes
|
||||
|
|
@ -71,7 +71,7 @@ section status comments
|
|||
6.2.4 Implementation extensions yes
|
||||
6.2.5 Syntax of numerical constants yes
|
||||
6.2.6 Numerical operations yes ``denominator``, ``numerator``, and ``rationalize`` are not supported for now. Also, picrin does not provide complex library procedures.
|
||||
6.2.7 Numerical input and output incomplete only partial support supplied.
|
||||
6.2.7 Numerical input and output yes
|
||||
6.3 Booleans yes
|
||||
6.4 Pairs and lists yes ``list?`` is safe for using against circular list.
|
||||
6.5 Symbols yes
|
||||
|
|
|
|||
|
|
@ -145,7 +145,6 @@ pic_value pic_funcall(pic_state *pic, const char *name, pic_list args);
|
|||
struct pic_proc *pic_get_proc(pic_state *);
|
||||
int pic_get_args(pic_state *, const char *, ...);
|
||||
void pic_defun(pic_state *, const char *, pic_func_t);
|
||||
void pic_defmacro(pic_state *, const char *, struct pic_proc *);
|
||||
|
||||
bool pic_equal_p(pic_state *, pic_value, pic_value);
|
||||
|
||||
|
|
|
|||
|
|
@ -32,6 +32,7 @@ void pic_init_write(pic_state *);
|
|||
void pic_init_read(pic_state *);
|
||||
void pic_init_dict(pic_state *);
|
||||
void pic_init_eval(pic_state *);
|
||||
void pic_init_lib(pic_state *);
|
||||
void pic_init_contrib(pic_state *);
|
||||
|
||||
void pic_load_piclib(pic_state *);
|
||||
|
|
@ -94,6 +95,7 @@ pic_init_core(pic_state *pic)
|
|||
pic_init_read(pic); DONE;
|
||||
pic_init_dict(pic); DONE;
|
||||
pic_init_eval(pic); DONE;
|
||||
pic_init_lib(pic); DONE;
|
||||
|
||||
pic_load_piclib(pic); DONE;
|
||||
|
||||
|
|
|
|||
191
src/lib.c
191
src/lib.c
|
|
@ -6,6 +6,9 @@
|
|||
#include "picrin/lib.h"
|
||||
#include "picrin/pair.h"
|
||||
#include "picrin/macro.h"
|
||||
#include "picrin/error.h"
|
||||
#include "picrin/dict.h"
|
||||
#include "picrin/string.h"
|
||||
|
||||
struct pic_lib *
|
||||
pic_make_library(pic_state *pic, pic_value name)
|
||||
|
|
@ -61,55 +64,197 @@ pic_find_library(pic_state *pic, pic_value spec)
|
|||
return pic_lib_ptr(pic_cdr(pic, v));
|
||||
}
|
||||
|
||||
void
|
||||
pic_import(pic_state *pic, pic_value spec)
|
||||
static struct pic_dict *
|
||||
import_table(pic_state *pic, pic_value spec)
|
||||
{
|
||||
const pic_sym sONLY = pic_intern_cstr(pic, "only");
|
||||
const pic_sym sRENAME = pic_intern_cstr(pic, "rename");
|
||||
const pic_sym sPREFIX = pic_intern_cstr(pic, "prefix");
|
||||
const pic_sym sEXCEPT = pic_intern_cstr(pic, "except");
|
||||
struct pic_lib *lib;
|
||||
struct pic_dict *imports, *dict;
|
||||
pic_value val, id;
|
||||
xh_iter it;
|
||||
|
||||
imports = pic_dict_new(pic);
|
||||
|
||||
if (pic_list_p(spec)) {
|
||||
if (pic_eq_p(pic_car(pic, spec), pic_sym_value(sONLY))) {
|
||||
dict = import_table(pic, pic_cadr(pic, spec));
|
||||
pic_for_each (val, pic_cddr(pic, spec)) {
|
||||
pic_dict_set(pic, imports, pic_sym(val), pic_dict_ref(pic, dict, pic_sym(val)));
|
||||
}
|
||||
return imports;
|
||||
}
|
||||
if (pic_eq_p(pic_car(pic, spec), pic_sym_value(sRENAME))) {
|
||||
imports = import_table(pic, pic_cadr(pic, spec));
|
||||
pic_for_each (val, pic_cddr(pic, spec)) {
|
||||
id = pic_dict_ref(pic, imports, pic_sym(pic_car(pic, val)));
|
||||
pic_dict_del(pic, imports, pic_sym(pic_car(pic, val)));
|
||||
pic_dict_set(pic, imports, pic_sym(pic_cadr(pic, val)), id);
|
||||
}
|
||||
return imports;
|
||||
}
|
||||
if (pic_eq_p(pic_car(pic, spec), pic_sym_value(sPREFIX))) {
|
||||
dict = import_table(pic, pic_cadr(pic, spec));
|
||||
xh_begin(&it, &dict->hash);
|
||||
while (xh_next(&it)) {
|
||||
pic_dict_set(pic, imports, pic_intern_cstr(pic, pic_str_cstr(pic_strcat(pic, pic_str_new_cstr(pic, pic_symbol_name(pic, pic_sym(pic_car(pic, pic_cddr(pic, spec))))), pic_str_new_cstr(pic, pic_symbol_name(pic, xh_key(it.e, pic_sym)))))), xh_val(it.e, pic_value));
|
||||
}
|
||||
return imports;
|
||||
}
|
||||
if (pic_eq_p(pic_car(pic, spec), pic_sym_value(sEXCEPT))) {
|
||||
imports = import_table(pic, pic_cadr(pic, spec));
|
||||
pic_for_each (val, pic_cddr(pic, spec)) {
|
||||
pic_dict_del(pic, imports, pic_sym(val));
|
||||
}
|
||||
return imports;
|
||||
}
|
||||
}
|
||||
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)) {
|
||||
pic_dict_set(pic, imports, xh_key(it.e, pic_sym), pic_sym_value(xh_val(it.e, pic_sym)));
|
||||
}
|
||||
return imports;
|
||||
}
|
||||
|
||||
static void
|
||||
import(pic_state *pic, pic_value spec)
|
||||
{
|
||||
struct pic_dict *imports;
|
||||
xh_iter it;
|
||||
|
||||
imports = import_table(pic, spec);
|
||||
|
||||
xh_begin(&it, &imports->hash);
|
||||
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)));
|
||||
printf("* importing %s as %s\n", pic_symbol_name(pic, xh_key(it.e, pic_sym)), pic_symbol_name(pic, pic_sym(xh_val(it.e, pic_value))));
|
||||
#endif
|
||||
|
||||
pic_put_rename(pic, pic->lib->env, xh_key(it.e, pic_sym), xh_val(it.e, pic_sym));
|
||||
pic_put_rename(pic, pic->lib->env, xh_key(it.e, pic_sym), pic_sym(xh_val(it.e, pic_value)));
|
||||
}
|
||||
}
|
||||
|
||||
static void
|
||||
export(pic_state *pic, pic_value spec)
|
||||
{
|
||||
const pic_sym sRENAME = pic_intern_cstr(pic, "rename");
|
||||
pic_value a, b;
|
||||
pic_sym rename;
|
||||
|
||||
if (pic_sym_p(spec)) { /* (export a) */
|
||||
a = b = spec;
|
||||
} else { /* (export (rename a b)) */
|
||||
if (! pic_list_p(spec))
|
||||
goto fail;
|
||||
if (! pic_length(pic, spec) == 3)
|
||||
goto fail;
|
||||
if (! pic_eq_p(pic_car(pic, spec), pic_sym_value(sRENAME)))
|
||||
goto fail;
|
||||
if (! pic_sym_p(a = pic_list_ref(pic, spec, 1)))
|
||||
goto fail;
|
||||
if (! pic_sym_p(b = pic_list_ref(pic, spec, 2)))
|
||||
goto fail;
|
||||
}
|
||||
|
||||
if (! pic_find_rename(pic, pic->lib->env, pic_sym(a), &rename)) {
|
||||
pic_errorf(pic, "export: symbol not defined %s", pic_symbol_name(pic, pic_sym(a)));
|
||||
}
|
||||
|
||||
#if DEBUG
|
||||
printf("* exporting %s as %s\n", pic_symbol_name(pic, pic_sym(b)), pic_symbol_name(pic, rename));
|
||||
#endif
|
||||
|
||||
xh_put_int(&pic->lib->exports, pic_sym(b), &rename);
|
||||
|
||||
return;
|
||||
|
||||
fail:
|
||||
pic_errorf(pic, "illegal export spec: ~s", spec);
|
||||
}
|
||||
|
||||
void
|
||||
pic_import(pic_state *pic, pic_value spec)
|
||||
{
|
||||
import(pic, spec);
|
||||
}
|
||||
|
||||
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));
|
||||
export(pic, pic_sym_value(sym));
|
||||
}
|
||||
|
||||
#if DEBUG
|
||||
printf("* exporting %s as %s\n", pic_symbol_name(pic, sym), pic_symbol_name(pic, rename));
|
||||
#endif
|
||||
static pic_value
|
||||
pic_lib_import(pic_state *pic)
|
||||
{
|
||||
size_t argc, i;
|
||||
pic_value *argv;
|
||||
|
||||
xh_put_int(&pic->lib->exports, sym, &rename);
|
||||
pic_get_args(pic, "*", &argc, &argv);
|
||||
|
||||
for (i = 0; i < argc; ++i) {
|
||||
import(pic, argv[i]);
|
||||
}
|
||||
|
||||
return pic_none_value();
|
||||
}
|
||||
|
||||
static pic_value
|
||||
pic_lib_export(pic_state *pic)
|
||||
{
|
||||
size_t argc, i;
|
||||
pic_value *argv;
|
||||
|
||||
pic_get_args(pic, "*", &argc, &argv);
|
||||
|
||||
for (i = 0; i < argc; ++i) {
|
||||
export(pic, argv[i]);
|
||||
}
|
||||
|
||||
return pic_none_value();
|
||||
}
|
||||
|
||||
static pic_value
|
||||
pic_lib_define_library(pic_state *pic)
|
||||
{
|
||||
struct pic_lib *prev = pic->lib;
|
||||
size_t argc, i;
|
||||
pic_value spec, *argv;
|
||||
|
||||
pic_get_args(pic, "o*", &spec, &argc, &argv);
|
||||
|
||||
pic_make_library(pic, spec);
|
||||
|
||||
pic_try {
|
||||
pic_in_library(pic, spec);
|
||||
|
||||
for (i = 0; i < argc; ++i) {
|
||||
pic_void(pic_eval(pic, argv[i], pic->lib));
|
||||
}
|
||||
|
||||
pic_in_library(pic, prev->name);
|
||||
}
|
||||
pic_catch {
|
||||
pic_in_library(pic, prev->name); /* restores pic->lib even if an error occurs */
|
||||
pic_throw_error(pic, pic->err);
|
||||
}
|
||||
|
||||
return pic_none_value();
|
||||
}
|
||||
|
||||
void
|
||||
pic_export_as(pic_state *pic, pic_sym sym, pic_sym as)
|
||||
pic_init_lib(pic_state *pic)
|
||||
{
|
||||
pic_sym rename;
|
||||
void pic_defmacro(pic_state *, pic_sym, pic_sym, pic_func_t);
|
||||
|
||||
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);
|
||||
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);
|
||||
}
|
||||
|
|
|
|||
98
src/macro.c
98
src/macro.c
|
|
@ -104,83 +104,6 @@ macroexpand_quote(pic_state *pic, pic_value expr)
|
|||
return pic_cons(pic, pic_sym_value(pic->rQUOTE), pic_cdr(pic, expr));
|
||||
}
|
||||
|
||||
static pic_value
|
||||
macroexpand_import(pic_state *pic, pic_value expr)
|
||||
{
|
||||
pic_value spec;
|
||||
|
||||
pic_for_each (spec, pic_cdr(pic, expr)) {
|
||||
pic_import(pic, spec);
|
||||
}
|
||||
|
||||
return pic_none_value();
|
||||
}
|
||||
|
||||
static pic_value
|
||||
macroexpand_export(pic_state *pic, pic_value expr)
|
||||
{
|
||||
extern pic_value pic_export_as(pic_state *, pic_sym, pic_sym);
|
||||
pic_value spec;
|
||||
pic_sym sRENAME, sym, as;
|
||||
|
||||
sRENAME = pic_intern_cstr(pic, "rename");
|
||||
|
||||
pic_for_each (spec, pic_cdr(pic, expr)) {
|
||||
if (pic_sym_p(spec)) {
|
||||
sym = as = pic_sym(spec);
|
||||
}
|
||||
else if (pic_list_p(spec) && pic_eq_p(pic_car(pic, spec), pic_sym_value(sRENAME))) {
|
||||
if (pic_length(pic, spec) != 3) {
|
||||
pic_error(pic, "syntax error");
|
||||
}
|
||||
if (! pic_sym_p(pic_list_ref(pic, spec, 1))) {
|
||||
pic_error(pic, "syntax error");
|
||||
}
|
||||
sym = pic_sym(pic_list_ref(pic, spec, 1));
|
||||
if (! pic_sym_p(pic_list_ref(pic, spec, 2))) {
|
||||
pic_error(pic, "syntax error");
|
||||
}
|
||||
as = pic_sym(pic_list_ref(pic, spec, 2));
|
||||
}
|
||||
else {
|
||||
pic_error(pic, "syntax error");
|
||||
}
|
||||
/* TODO: warn if symbol is shadowed by local variable */
|
||||
pic_export_as(pic, sym, as);
|
||||
}
|
||||
|
||||
return pic_none_value();
|
||||
}
|
||||
|
||||
static pic_value
|
||||
macroexpand_deflibrary(pic_state *pic, pic_value expr)
|
||||
{
|
||||
struct pic_lib *prev = pic->lib;
|
||||
pic_value v;
|
||||
|
||||
if (pic_length(pic, expr) < 2) {
|
||||
pic_error(pic, "syntax error");
|
||||
}
|
||||
|
||||
pic_make_library(pic, pic_cadr(pic, expr));
|
||||
|
||||
pic_try {
|
||||
pic_in_library(pic, pic_cadr(pic, expr));
|
||||
|
||||
pic_for_each (v, pic_cddr(pic, expr)) {
|
||||
pic_void(pic_eval(pic, v, pic->lib));
|
||||
}
|
||||
|
||||
pic_in_library(pic, prev->name);
|
||||
}
|
||||
pic_catch {
|
||||
pic_in_library(pic, prev->name); /* restores pic->lib even if an error occurs */
|
||||
pic_throw_error(pic, pic->err);
|
||||
}
|
||||
|
||||
return pic_none_value();
|
||||
}
|
||||
|
||||
static pic_value
|
||||
macroexpand_list(pic_state *pic, pic_value obj, struct pic_senv *senv)
|
||||
{
|
||||
|
|
@ -359,16 +282,7 @@ macroexpand_node(pic_state *pic, pic_value expr, struct pic_senv *senv)
|
|||
if (pic_sym_p(car)) {
|
||||
pic_sym tag = pic_sym(car);
|
||||
|
||||
if (tag == pic->rDEFINE_LIBRARY) {
|
||||
return macroexpand_deflibrary(pic, expr);
|
||||
}
|
||||
else if (tag == pic->rIMPORT) {
|
||||
return macroexpand_import(pic, expr);
|
||||
}
|
||||
else if (tag == pic->rEXPORT) {
|
||||
return macroexpand_export(pic, expr);
|
||||
}
|
||||
else if (tag == pic->rDEFINE_SYNTAX) {
|
||||
if (tag == pic->rDEFINE_SYNTAX) {
|
||||
return macroexpand_defsyntax(pic, expr, senv);
|
||||
}
|
||||
else if (tag == pic->rLAMBDA) {
|
||||
|
|
@ -519,17 +433,15 @@ pic_define_syntactic_keyword(pic_state *pic, struct pic_senv *senv, pic_sym sym,
|
|||
}
|
||||
|
||||
void
|
||||
pic_defmacro(pic_state *pic, const char *name, struct pic_proc *macro)
|
||||
pic_defmacro(pic_state *pic, pic_sym name, pic_sym id, pic_func_t func)
|
||||
{
|
||||
pic_sym sym, rename;
|
||||
pic_put_rename(pic, pic->lib->env, name, id);
|
||||
|
||||
/* symbol registration */
|
||||
sym = pic_intern_cstr(pic, name);
|
||||
rename = pic_add_rename(pic, pic->lib->env, sym);
|
||||
define_macro(pic, rename, macro, NULL);
|
||||
define_macro(pic, id, pic_proc_new(pic, func, pic_symbol_name(pic, name)), NULL);
|
||||
|
||||
/* auto export! */
|
||||
pic_export(pic, sym);
|
||||
pic_export(pic, name);
|
||||
}
|
||||
|
||||
bool
|
||||
|
|
|
|||
|
|
@ -0,0 +1,11 @@
|
|||
(define-library (foo)
|
||||
(import (except (rename (prefix (only (scheme base) car cdr cons) my-)
|
||||
(my-car my-kar)
|
||||
(my-cdr my-kdr))
|
||||
my-kar))
|
||||
|
||||
;; (import (rename (scheme base)
|
||||
;; (car my-kar)
|
||||
;; (cdr my-cdr)))
|
||||
|
||||
(export my-kdr my-cons))
|
||||
Loading…
Reference in New Issue