change the behavior of pic_deflibrary

fix regression
This commit is contained in:
Yuichi Nishiwaki 2016-02-15 13:20:26 +09:00
parent 294477ff13
commit 8610f5090d
18 changed files with 224 additions and 220 deletions

View File

@ -282,8 +282,8 @@ pic_callcc_callcc(pic_state *pic)
void void
pic_init_callcc(pic_state *pic) pic_init_callcc(pic_state *pic)
{ {
pic_deflibrary (pic, "(scheme base)") { pic_deflibrary(pic, "(scheme base)");
pic_redefun(pic, pic->PICRIN_BASE, "call-with-current-continuation", pic_callcc_callcc);
pic_redefun(pic, pic->PICRIN_BASE, "call/cc", pic_callcc_callcc); pic_redefun(pic, pic->PICRIN_BASE, "call-with-current-continuation", pic_callcc_callcc);
} pic_redefun(pic, pic->PICRIN_BASE, "call/cc", pic_callcc_callcc);
} }

View File

@ -284,27 +284,27 @@ pic_number_expt(pic_state *pic)
void void
pic_init_math(pic_state *pic) pic_init_math(pic_state *pic)
{ {
pic_deflibrary (pic, "(picrin math)") { pic_deflibrary(pic, "(picrin math)");
pic_defun(pic, "floor/", pic_number_floor2);
pic_defun(pic, "truncate/", pic_number_trunc2);
pic_defun(pic, "floor", pic_number_floor);
pic_defun(pic, "ceiling", pic_number_ceil);
pic_defun(pic, "truncate", pic_number_trunc);
pic_defun(pic, "round", pic_number_round);
pic_defun(pic, "finite?", pic_number_finite_p); pic_defun(pic, "floor/", pic_number_floor2);
pic_defun(pic, "infinite?", pic_number_infinite_p); pic_defun(pic, "truncate/", pic_number_trunc2);
pic_defun(pic, "nan?", pic_number_nan_p); pic_defun(pic, "floor", pic_number_floor);
pic_defun(pic, "sqrt", pic_number_sqrt); pic_defun(pic, "ceiling", pic_number_ceil);
pic_defun(pic, "exp", pic_number_exp); pic_defun(pic, "truncate", pic_number_trunc);
pic_defun(pic, "log", pic_number_log); pic_defun(pic, "round", pic_number_round);
pic_defun(pic, "sin", pic_number_sin);
pic_defun(pic, "cos", pic_number_cos); pic_defun(pic, "finite?", pic_number_finite_p);
pic_defun(pic, "tan", pic_number_tan); pic_defun(pic, "infinite?", pic_number_infinite_p);
pic_defun(pic, "acos", pic_number_acos); pic_defun(pic, "nan?", pic_number_nan_p);
pic_defun(pic, "asin", pic_number_asin); pic_defun(pic, "sqrt", pic_number_sqrt);
pic_defun(pic, "atan", pic_number_atan); pic_defun(pic, "exp", pic_number_exp);
pic_defun(pic, "abs", pic_number_abs); pic_defun(pic, "log", pic_number_log);
pic_defun(pic, "expt", pic_number_expt); pic_defun(pic, "sin", pic_number_sin);
} pic_defun(pic, "cos", pic_number_cos);
pic_defun(pic, "tan", pic_number_tan);
pic_defun(pic, "acos", pic_number_acos);
pic_defun(pic, "asin", pic_number_asin);
pic_defun(pic, "atan", pic_number_atan);
pic_defun(pic, "abs", pic_number_abs);
pic_defun(pic, "expt", pic_number_expt);
} }

View File

@ -93,12 +93,12 @@ pic_file_delete(pic_state *pic)
void void
pic_init_file(pic_state *pic) pic_init_file(pic_state *pic)
{ {
pic_deflibrary (pic, "(scheme file)") { pic_deflibrary(pic, "(scheme file)");
pic_defun(pic, "open-input-file", pic_file_open_input_file);
pic_defun(pic, "open-binary-input-file", pic_file_open_binary_input_file); pic_defun(pic, "open-input-file", pic_file_open_input_file);
pic_defun(pic, "open-output-file", pic_file_open_output_file); pic_defun(pic, "open-binary-input-file", pic_file_open_binary_input_file);
pic_defun(pic, "open-binary-output-file", pic_file_open_binary_output_file); pic_defun(pic, "open-output-file", pic_file_open_output_file);
pic_defun(pic, "file-exists?", pic_file_exists_p); pic_defun(pic, "open-binary-output-file", pic_file_open_binary_output_file);
pic_defun(pic, "delete-file", pic_file_delete); pic_defun(pic, "file-exists?", pic_file_exists_p);
} pic_defun(pic, "delete-file", pic_file_delete);
} }

View File

@ -25,7 +25,7 @@ pic_load_load(pic_state *pic)
void void
pic_init_load(pic_state *pic) pic_init_load(pic_state *pic)
{ {
pic_deflibrary (pic, "(scheme load)") { pic_deflibrary(pic, "(scheme load)");
pic_defun(pic, "load", pic_load_load);
} pic_defun(pic, "load", pic_load_load);
} }

View File

@ -85,9 +85,9 @@ pic_str_string_fill_ip(pic_state *pic)
void void
pic_init_mutable_string(pic_state *pic) pic_init_mutable_string(pic_state *pic)
{ {
pic_deflibrary (pic, "(picrin string)") { pic_deflibrary(pic, "(picrin string)");
pic_defun(pic, "string-set!", pic_str_string_set);
pic_defun(pic, "string-copy!", pic_str_string_copy_ip); pic_defun(pic, "string-set!", pic_str_string_set);
pic_defun(pic, "string-fill!", pic_str_string_fill_ip); pic_defun(pic, "string-copy!", pic_str_string_copy_ip);
} pic_defun(pic, "string-fill!", pic_str_string_fill_ip);
} }

View File

@ -127,11 +127,11 @@ pic_system_getenvs(pic_state *pic)
void void
pic_init_system(pic_state *pic) pic_init_system(pic_state *pic)
{ {
pic_deflibrary (pic, "(scheme process-context)") { pic_deflibrary(pic, "(scheme process-context)");
pic_defun(pic, "command-line", pic_system_cmdline);
pic_defun(pic, "exit", pic_system_exit); pic_defun(pic, "command-line", pic_system_cmdline);
pic_defun(pic, "emergency-exit", pic_system_emergency_exit); pic_defun(pic, "exit", pic_system_exit);
pic_defun(pic, "get-environment-variable", pic_system_getenv); pic_defun(pic, "emergency-exit", pic_system_emergency_exit);
pic_defun(pic, "get-environment-variables", pic_system_getenvs); pic_defun(pic, "get-environment-variable", pic_system_getenv);
} pic_defun(pic, "get-environment-variables", pic_system_getenvs);
} }

View File

@ -41,9 +41,9 @@ pic_jiffies_per_second(pic_state *pic)
void void
pic_init_time(pic_state *pic) pic_init_time(pic_state *pic)
{ {
pic_deflibrary (pic, "(scheme time)") { pic_deflibrary(pic, "(scheme time)");
pic_defun(pic, "current-second", pic_current_second);
pic_defun(pic, "current-jiffy", pic_current_jiffy); pic_defun(pic, "current-second", pic_current_second);
pic_defun(pic, "jiffies-per-second", pic_jiffies_per_second); pic_defun(pic, "current-jiffy", pic_current_jiffy);
} pic_defun(pic, "jiffies-per-second", pic_jiffies_per_second);
} }

View File

@ -13,7 +13,7 @@ pic_random_real(pic_state *pic)
void void
pic_init_random(pic_state *pic) pic_init_random(pic_state *pic)
{ {
pic_deflibrary (pic, "(srfi 27)") { pic_deflibrary(pic, "(srfi 27)");
pic_defun(pic, "random-real", pic_random_real);
} pic_defun(pic, "random-real", pic_random_real);
} }

View File

@ -246,29 +246,31 @@ pic_rl_history_expand(pic_state *pic)
void void
pic_init_readline(pic_state *pic){ pic_init_readline(pic_state *pic){
using_history(); using_history();
pic_deflibrary (pic, "(picrin readline)") {
pic_defun(pic, "readline", pic_rl_readline); pic_deflibrary(pic, "(picrin readline)");
}
pic_deflibrary (pic, "(picrin readline history)") { pic_defun(pic, "readline", pic_rl_readline);
/* pic_defun(pic, "history-offset", pic_rl_history_offset); */
pic_defun(pic, "history-length", pic_rl_history_length); pic_deflibrary(pic, "(picrin readline history)");
pic_defun(pic, "add-history", pic_rl_add_history);
pic_defun(pic, "stifle-history", pic_rl_stifle_history); /* pic_defun(pic, "history-offset", pic_rl_history_offset); */
pic_defun(pic, "unstifle-history", pic_rl_unstifle_history); pic_defun(pic, "history-length", pic_rl_history_length);
pic_defun(pic, "history-stifled?", pic_rl_history_is_stifled); pic_defun(pic, "add-history", pic_rl_add_history);
pic_defun(pic, "where-history", pic_rl_where_history); pic_defun(pic, "stifle-history", pic_rl_stifle_history);
pic_defun(pic, "current-history", pic_rl_current_history); pic_defun(pic, "unstifle-history", pic_rl_unstifle_history);
pic_defun(pic, "history-get", pic_rl_history_get); pic_defun(pic, "history-stifled?", pic_rl_history_is_stifled);
pic_defun(pic, "clear-history", pic_rl_clear_history); pic_defun(pic, "where-history", pic_rl_where_history);
pic_defun(pic, "remove-history", pic_rl_remove_history); pic_defun(pic, "current-history", pic_rl_current_history);
pic_defun(pic, "history-set-pos", pic_rl_history_set_pos); pic_defun(pic, "history-get", pic_rl_history_get);
pic_defun(pic, "previous-history", pic_rl_previous_history); pic_defun(pic, "clear-history", pic_rl_clear_history);
pic_defun(pic, "next-history", pic_rl_next_history); pic_defun(pic, "remove-history", pic_rl_remove_history);
pic_defun(pic, "history-search", pic_rl_history_search); pic_defun(pic, "history-set-pos", pic_rl_history_set_pos);
pic_defun(pic, "history-search-prefix", pic_rl_history_search_prefix); pic_defun(pic, "previous-history", pic_rl_previous_history);
pic_defun(pic, "read-history", pic_rl_read_history); pic_defun(pic, "next-history", pic_rl_next_history);
pic_defun(pic, "write-history", pic_rl_write_history); pic_defun(pic, "history-search", pic_rl_history_search);
pic_defun(pic, "truncate-file", pic_rl_truncate_file); pic_defun(pic, "history-search-prefix", pic_rl_history_search_prefix);
pic_defun(pic, "history-expand", pic_rl_history_expand); pic_defun(pic, "read-history", pic_rl_read_history);
} pic_defun(pic, "write-history", pic_rl_write_history);
pic_defun(pic, "truncate-file", pic_rl_truncate_file);
pic_defun(pic, "history-expand", pic_rl_history_expand);
} }

View File

@ -178,12 +178,12 @@ pic_regexp_regexp_replace(pic_state *pic)
void void
pic_init_regexp(pic_state *pic) pic_init_regexp(pic_state *pic)
{ {
pic_deflibrary (pic, "(picrin regexp)") { pic_deflibrary(pic, "(picrin regexp)");
pic_defun(pic, "regexp", pic_regexp_regexp);
pic_defun(pic, "regexp?", pic_regexp_regexp_p); pic_defun(pic, "regexp", pic_regexp_regexp);
pic_defun(pic, "regexp-match", pic_regexp_regexp_match); pic_defun(pic, "regexp?", pic_regexp_regexp_p);
/* pic_defun(pic, "regexp-search", pic_regexp_regexp_search); */ pic_defun(pic, "regexp-match", pic_regexp_regexp_match);
pic_defun(pic, "regexp-split", pic_regexp_regexp_split); /* pic_defun(pic, "regexp-search", pic_regexp_regexp_search); */
pic_defun(pic, "regexp-replace", pic_regexp_regexp_replace); pic_defun(pic, "regexp-split", pic_regexp_regexp_split);
} pic_defun(pic, "regexp-replace", pic_regexp_regexp_replace);
} }

View File

@ -402,123 +402,123 @@ pic_init_srfi_106(pic_state *pic)
#define pic_defun_(pic, name, f) pic_define(pic, pic->lib, name, pic_obj_value(pic_make_proc(pic, f, 0, NULL))) #define pic_defun_(pic, name, f) pic_define(pic, pic->lib, name, pic_obj_value(pic_make_proc(pic, f, 0, NULL)))
#define pic_define_(pic, name, v) pic_define(pic, pic->lib, name, v) #define pic_define_(pic, name, v) pic_define(pic, pic->lib, name, v)
pic_deflibrary (pic, "(srfi 106)") { pic_deflibrary(pic, "(srfi 106)");
pic_defun_(pic, "socket?", pic_socket_socket_p);
pic_defun_(pic, "make-socket", pic_socket_make_socket); pic_defun_(pic, "socket?", pic_socket_socket_p);
pic_defun_(pic, "socket-accept", pic_socket_socket_accept); pic_defun_(pic, "make-socket", pic_socket_make_socket);
pic_defun_(pic, "socket-send", pic_socket_socket_send); pic_defun_(pic, "socket-accept", pic_socket_socket_accept);
pic_defun_(pic, "socket-recv", pic_socket_socket_recv); pic_defun_(pic, "socket-send", pic_socket_socket_send);
pic_defun_(pic, "socket-shutdown", pic_socket_socket_shutdown); pic_defun_(pic, "socket-recv", pic_socket_socket_recv);
pic_defun_(pic, "socket-close", pic_socket_socket_close); pic_defun_(pic, "socket-shutdown", pic_socket_socket_shutdown);
pic_defun_(pic, "socket-input-port", pic_socket_socket_input_port); pic_defun_(pic, "socket-close", pic_socket_socket_close);
pic_defun_(pic, "socket-output-port", pic_socket_socket_output_port); pic_defun_(pic, "socket-input-port", pic_socket_socket_input_port);
pic_defun_(pic, "call-with-socket", pic_socket_call_with_socket); pic_defun_(pic, "socket-output-port", pic_socket_socket_output_port);
pic_defun_(pic, "call-with-socket", pic_socket_call_with_socket);
#ifdef AF_INET #ifdef AF_INET
pic_define_(pic, "*af-inet*", pic_int_value(AF_INET)); pic_define_(pic, "*af-inet*", pic_int_value(AF_INET));
#else #else
pic_define_(pic, "*af-inet*", pic_false_value()); pic_define_(pic, "*af-inet*", pic_false_value());
#endif #endif
#ifdef AF_INET6 #ifdef AF_INET6
pic_define_(pic, "*af-inet6*", pic_int_value(AF_INET6)); pic_define_(pic, "*af-inet6*", pic_int_value(AF_INET6));
#else #else
pic_define_(pic, "*af-inet6*", pic_false_value()); pic_define_(pic, "*af-inet6*", pic_false_value());
#endif #endif
#ifdef AF_UNSPEC #ifdef AF_UNSPEC
pic_define_(pic, "*af-unspec*", pic_int_value(AF_UNSPEC)); pic_define_(pic, "*af-unspec*", pic_int_value(AF_UNSPEC));
#else #else
pic_define_(pic, "*af-unspec*", pic_false_value()); pic_define_(pic, "*af-unspec*", pic_false_value());
#endif #endif
#ifdef SOCK_STREAM #ifdef SOCK_STREAM
pic_define_(pic, "*sock-stream*", pic_int_value(SOCK_STREAM)); pic_define_(pic, "*sock-stream*", pic_int_value(SOCK_STREAM));
#else #else
pic_define_(pic, "*sock-stream*", pic_false_value()); pic_define_(pic, "*sock-stream*", pic_false_value());
#endif #endif
#ifdef SOCK_DGRAM #ifdef SOCK_DGRAM
pic_define_(pic, "*sock-dgram*", pic_int_value(SOCK_DGRAM)); pic_define_(pic, "*sock-dgram*", pic_int_value(SOCK_DGRAM));
#else #else
pic_define_(pic, "*sock-dgram*", pic_false_value()); pic_define_(pic, "*sock-dgram*", pic_false_value());
#endif #endif
#ifdef AI_CANONNAME #ifdef AI_CANONNAME
pic_define_(pic, "*ai-canonname*", pic_int_value(AI_CANONNAME)); pic_define_(pic, "*ai-canonname*", pic_int_value(AI_CANONNAME));
#else #else
pic_define_(pic, "*ai-canonname*", pic_false_value()); pic_define_(pic, "*ai-canonname*", pic_false_value());
#endif #endif
#ifdef AI_NUMERICHOST #ifdef AI_NUMERICHOST
pic_define_(pic, "*ai-numerichost*", pic_int_value(AI_NUMERICHOST)); pic_define_(pic, "*ai-numerichost*", pic_int_value(AI_NUMERICHOST));
#else #else
pic_define_(pic, "*ai-numerichost*", pic_false_value()); pic_define_(pic, "*ai-numerichost*", pic_false_value());
#endif #endif
/* AI_V4MAPPED and AI_ALL are not supported by *BSDs, even though they are defined in netdb.h. */ /* AI_V4MAPPED and AI_ALL are not supported by *BSDs, even though they are defined in netdb.h. */
#if defined(AI_V4MAPPED) && !defined(BSD) #if defined(AI_V4MAPPED) && !defined(BSD)
pic_define_(pic, "*ai-v4mapped*", pic_int_value(AI_V4MAPPED)); pic_define_(pic, "*ai-v4mapped*", pic_int_value(AI_V4MAPPED));
#else #else
pic_define_(pic, "*ai-v4mapped*", pic_false_value()); pic_define_(pic, "*ai-v4mapped*", pic_false_value());
#endif #endif
#if defined(AI_ALL) && !defined(BSD) #if defined(AI_ALL) && !defined(BSD)
pic_define_(pic, "*ai-all*", pic_int_value(AI_ALL)); pic_define_(pic, "*ai-all*", pic_int_value(AI_ALL));
#else #else
pic_define_(pic, "*ai-all*", pic_false_value()); pic_define_(pic, "*ai-all*", pic_false_value());
#endif #endif
#ifdef AI_ADDRCONFIG #ifdef AI_ADDRCONFIG
pic_define_(pic, "*ai-addrconfig*", pic_int_value(AI_ADDRCONFIG)); pic_define_(pic, "*ai-addrconfig*", pic_int_value(AI_ADDRCONFIG));
#else #else
pic_define_(pic, "*ai-addrconfig*", pic_false_value()); pic_define_(pic, "*ai-addrconfig*", pic_false_value());
#endif #endif
#ifdef AI_PASSIVE #ifdef AI_PASSIVE
pic_define_(pic, "*ai-passive*", pic_int_value(AI_PASSIVE)); pic_define_(pic, "*ai-passive*", pic_int_value(AI_PASSIVE));
#else #else
pic_define_(pic, "*ai-passive*", pic_false_value()); pic_define_(pic, "*ai-passive*", pic_false_value());
#endif #endif
#ifdef IPPROTO_IP #ifdef IPPROTO_IP
pic_define_(pic, "*ipproto-ip*", pic_int_value(IPPROTO_IP)); pic_define_(pic, "*ipproto-ip*", pic_int_value(IPPROTO_IP));
#else #else
pic_define_(pic, "*ipproto-ip*", pic_false_value()); pic_define_(pic, "*ipproto-ip*", pic_false_value());
#endif #endif
#ifdef IPPROTO_TCP #ifdef IPPROTO_TCP
pic_define_(pic, "*ipproto-tcp*", pic_int_value(IPPROTO_TCP)); pic_define_(pic, "*ipproto-tcp*", pic_int_value(IPPROTO_TCP));
#else #else
pic_define_(pic, "*ipproto-tcp*", pic_false_value()); pic_define_(pic, "*ipproto-tcp*", pic_false_value());
#endif #endif
#ifdef IPPROTO_UDP #ifdef IPPROTO_UDP
pic_define_(pic, "*ipproto-udp*", pic_int_value(IPPROTO_UDP)); pic_define_(pic, "*ipproto-udp*", pic_int_value(IPPROTO_UDP));
#else #else
pic_define_(pic, "*ipproto-udp*", pic_false_value()); pic_define_(pic, "*ipproto-udp*", pic_false_value());
#endif #endif
#ifdef MSG_PEEK #ifdef MSG_PEEK
pic_define_(pic, "*msg-peek*", pic_int_value(MSG_PEEK)); pic_define_(pic, "*msg-peek*", pic_int_value(MSG_PEEK));
#else #else
pic_define_(pic, "*msg-peek*", pic_false_value()); pic_define_(pic, "*msg-peek*", pic_false_value());
#endif #endif
#ifdef MSG_OOB #ifdef MSG_OOB
pic_define_(pic, "*msg-oob*", pic_int_value(MSG_OOB)); pic_define_(pic, "*msg-oob*", pic_int_value(MSG_OOB));
#else #else
pic_define_(pic, "*msg-oob*", pic_false_value()); pic_define_(pic, "*msg-oob*", pic_false_value());
#endif #endif
#ifdef MSG_WAITALL #ifdef MSG_WAITALL
pic_define_(pic, "*msg-waitall*", pic_int_value(MSG_WAITALL)); pic_define_(pic, "*msg-waitall*", pic_int_value(MSG_WAITALL));
#else #else
pic_define_(pic, "*msg-waitall*", pic_false_value()); pic_define_(pic, "*msg-waitall*", pic_false_value());
#endif #endif
#ifdef SHUT_RD #ifdef SHUT_RD
pic_define_(pic, "*shut-rd*", pic_int_value(SHUT_RD)); pic_define_(pic, "*shut-rd*", pic_int_value(SHUT_RD));
#else #else
pic_define_(pic, "*shut-rd*", pic_false_value()); pic_define_(pic, "*shut-rd*", pic_false_value());
#endif #endif
#ifdef SHUT_WR #ifdef SHUT_WR
pic_define_(pic, "*shut-wr*", pic_int_value(SHUT_WR)); pic_define_(pic, "*shut-wr*", pic_int_value(SHUT_WR));
#else #else
pic_define_(pic, "*shut-wr*", pic_false_value()); pic_define_(pic, "*shut-wr*", pic_false_value());
#endif #endif
#ifdef SHUT_RDWR #ifdef SHUT_RDWR
pic_define_(pic, "*shut-rdwr*", pic_int_value(SHUT_RDWR)); pic_define_(pic, "*shut-rdwr*", pic_int_value(SHUT_RDWR));
#else #else
pic_define_(pic, "*shut-rdwr*", pic_false_value()); pic_define_(pic, "*shut-rdwr*", pic_false_value());
#endif #endif
}
} }

View File

@ -15,7 +15,7 @@ pic_repl_tty_p(pic_state *pic)
void void
pic_init_repl(pic_state *pic) pic_init_repl(pic_state *pic)
{ {
pic_deflibrary (pic, "(picrin repl)") { pic_deflibrary(pic, "(picrin repl)");
pic_defun(pic, "tty?", pic_repl_tty_p);
} pic_defun(pic, "tty?", pic_repl_tty_p);
} }

View File

@ -219,16 +219,13 @@ pic_value pic_eval(pic_state *, pic_value, struct pic_lib *);
struct pic_proc *pic_make_var(pic_state *, pic_value, struct pic_proc *); struct pic_proc *pic_make_var(pic_state *, pic_value, struct pic_proc *);
#define pic_deflibrary(pic, spec) \ #define pic_deflibrary(pic, spec) do { \
for (((assert(pic->prev_lib == NULL)), \ pic_value libname = pic_read_cstr(pic, spec); \
(pic->prev_lib = pic->lib), \ if (pic_find_library(pic, libname) == NULL) { \
(pic->lib = pic_find_library(pic, pic_read_cstr(pic, (spec)))), \ pic_make_library(pic, libname); \
(pic->lib = pic->lib \ } \
? pic->lib \ pic_in_library(pic, libname); \
: pic_make_library(pic, pic_read_cstr(pic, (spec))))); \ } while (0)
pic->prev_lib != NULL; \
((pic->lib = pic->prev_lib), \
(pic->prev_lib = NULL)))
void pic_warnf(pic_state *, const char *, ...); void pic_warnf(pic_state *, const char *, ...);
struct pic_string *pic_get_backtrace(pic_state *); struct pic_string *pic_get_backtrace(pic_state *);

View File

@ -58,7 +58,7 @@ struct pic_state {
pic_value ptable; /* list of ephemerons */ pic_value ptable; /* list of ephemerons */
struct pic_lib *lib, *prev_lib; struct pic_lib *lib;
pic_sym *sDEFINE, *sDEFINE_MACRO, *sLAMBDA, *sIF, *sBEGIN, *sSETBANG; pic_sym *sDEFINE, *sDEFINE_MACRO, *sLAMBDA, *sIF, *sBEGIN, *sSETBANG;
pic_sym *sQUOTE, *sQUASIQUOTE, *sUNQUOTE, *sUNQUOTE_SPLICING; pic_sym *sQUOTE, *sQUASIQUOTE, *sUNQUOTE, *sUNQUOTE_SPLICING;

View File

@ -55,6 +55,17 @@ pic_make_library(pic_state *pic, pic_value name)
return lib; return lib;
} }
void
pic_in_library(pic_state *pic, pic_value name)
{
struct pic_lib *lib;
if ((lib = pic_find_library(pic, name)) == NULL) {
pic_errorf(pic, "library not found ~s", name);
}
pic->lib = lib;
}
struct pic_lib * struct pic_lib *
pic_find_library(pic_state *pic, pic_value spec) pic_find_library(pic_state *pic, pic_value spec)
{ {

View File

@ -179,13 +179,8 @@ static pic_value
vm_gref(pic_state *pic, pic_sym *uid) vm_gref(pic_state *pic, pic_sym *uid)
{ {
if (! pic_weak_has(pic, pic->globals, uid)) { if (! pic_weak_has(pic, pic->globals, uid)) {
pic_weak_set(pic, pic->globals, uid, pic_invalid_value());
pic_errorf(pic, "uninitialized global variable: %s", pic_symbol_name(pic, uid)); pic_errorf(pic, "uninitialized global variable: %s", pic_symbol_name(pic, uid));
return pic_invalid_value();
} }
return pic_weak_ref(pic, pic->globals, uid); return pic_weak_ref(pic, pic->globals, uid);
} }

View File

@ -116,71 +116,72 @@ static void
pic_init_core(pic_state *pic) pic_init_core(pic_state *pic)
{ {
struct pic_box *pic_vm_gref_slot(pic_state *, pic_sym *); struct pic_box *pic_vm_gref_slot(pic_state *, pic_sym *);
size_t ai;
pic_init_features(pic); pic_init_features(pic);
pic_deflibrary (pic, "(picrin base)") { pic_deflibrary(pic, "(picrin base)");
size_t ai = pic_gc_arena_preserve(pic);
ai = pic_gc_arena_preserve(pic);
#define DONE pic_gc_arena_restore(pic, ai); #define DONE pic_gc_arena_restore(pic, ai);
import_builtin_syntax("define"); import_builtin_syntax("define");
import_builtin_syntax("set!"); import_builtin_syntax("set!");
import_builtin_syntax("quote"); import_builtin_syntax("quote");
import_builtin_syntax("lambda"); import_builtin_syntax("lambda");
import_builtin_syntax("if"); import_builtin_syntax("if");
import_builtin_syntax("begin"); import_builtin_syntax("begin");
import_builtin_syntax("define-macro"); import_builtin_syntax("define-macro");
declare_vm_procedure("cons"); declare_vm_procedure("cons");
declare_vm_procedure("car"); declare_vm_procedure("car");
declare_vm_procedure("cdr"); declare_vm_procedure("cdr");
declare_vm_procedure("null?"); declare_vm_procedure("null?");
declare_vm_procedure("symbol?"); declare_vm_procedure("symbol?");
declare_vm_procedure("pair?"); declare_vm_procedure("pair?");
declare_vm_procedure("+"); declare_vm_procedure("+");
declare_vm_procedure("-"); declare_vm_procedure("-");
declare_vm_procedure("*"); declare_vm_procedure("*");
declare_vm_procedure("/"); declare_vm_procedure("/");
declare_vm_procedure("="); declare_vm_procedure("=");
declare_vm_procedure("<"); declare_vm_procedure("<");
declare_vm_procedure(">"); declare_vm_procedure(">");
declare_vm_procedure("<="); declare_vm_procedure("<=");
declare_vm_procedure(">="); declare_vm_procedure(">=");
declare_vm_procedure("not"); declare_vm_procedure("not");
DONE; DONE;
pic_init_bool(pic); DONE; pic_init_bool(pic); DONE;
pic_init_pair(pic); DONE; pic_init_pair(pic); DONE;
pic_init_port(pic); DONE; pic_init_port(pic); DONE;
pic_init_number(pic); DONE; pic_init_number(pic); DONE;
pic_init_proc(pic); DONE; pic_init_proc(pic); DONE;
pic_init_symbol(pic); DONE; pic_init_symbol(pic); DONE;
pic_init_vector(pic); DONE; pic_init_vector(pic); DONE;
pic_init_blob(pic); DONE; pic_init_blob(pic); DONE;
pic_init_cont(pic); DONE; pic_init_cont(pic); DONE;
pic_init_char(pic); DONE; pic_init_char(pic); DONE;
pic_init_error(pic); DONE; pic_init_error(pic); DONE;
pic_init_str(pic); DONE; pic_init_str(pic); DONE;
pic_init_var(pic); DONE; pic_init_var(pic); DONE;
pic_init_write(pic); DONE; pic_init_write(pic); DONE;
pic_init_read(pic); DONE; pic_init_read(pic); DONE;
pic_init_dict(pic); DONE; pic_init_dict(pic); DONE;
pic_init_record(pic); DONE; pic_init_record(pic); DONE;
pic_init_eval(pic); DONE; pic_init_eval(pic); DONE;
pic_init_lib(pic); DONE; pic_init_lib(pic); DONE;
pic_init_weak(pic); DONE; pic_init_weak(pic); DONE;
pic_defun(pic, "features", pic_features); pic_defun(pic, "features", pic_features);
pic_try { pic_try {
pic_load_cstr(pic, &pic_boot[0][0]); pic_load_cstr(pic, &pic_boot[0][0]);
} }
pic_catch { pic_catch {
pic_print_backtrace(pic, xstdout); pic_print_backtrace(pic, xstdout);
pic_panic(pic, ""); pic_panic(pic, "");
}
} }
} }
@ -348,7 +349,6 @@ pic_open(pic_allocf allocf, void *userdata)
pic->PICRIN_BASE = pic_make_library(pic, pic_read_cstr(pic, "(picrin base)")); pic->PICRIN_BASE = pic_make_library(pic, pic_read_cstr(pic, "(picrin base)"));
pic->PICRIN_USER = pic_make_library(pic, pic_read_cstr(pic, "(picrin user)")); pic->PICRIN_USER = pic_make_library(pic, pic_read_cstr(pic, "(picrin user)"));
pic->lib = pic->PICRIN_USER; pic->lib = pic->PICRIN_USER;
pic->prev_lib = NULL;
pic_gc_arena_restore(pic, ai); pic_gc_arena_restore(pic, ai);

View File

@ -26,9 +26,8 @@ pic_init_picrin(pic_state *pic)
{ {
pic_add_feature(pic, "r7rs"); pic_add_feature(pic, "r7rs");
pic_deflibrary (pic, "(picrin library)") { pic_deflibrary(pic, "(picrin library)");
pic_defun(pic, "libraries", pic_libraries); pic_defun(pic, "libraries", pic_libraries);
}
pic_init_contrib(pic); pic_init_contrib(pic);
pic_load_piclib(pic); pic_load_piclib(pic);