From 8f6113f61bbee6a335d9d60892b6f989de7f2127 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Mon, 3 Apr 2017 00:37:37 +0900 Subject: [PATCH] library system is now implemeted in scheme --- Makefile | 4 +- contrib/10.math/math.c | 46 ++--- contrib/20.r7rs/scheme/base.scm | 3 +- contrib/20.r7rs/scheme/eval.scm | 6 +- contrib/20.r7rs/scheme/r5rs.scm | 9 +- contrib/20.r7rs/src/file.c | 15 +- contrib/20.r7rs/src/load.c | 4 +- contrib/20.r7rs/src/system.c | 12 +- contrib/20.r7rs/src/time.c | 8 +- contrib/30.random/src/random.c | 4 +- contrib/30.readline/src/readline.c | 53 +++--- contrib/30.regexp/src/regexp.c | 16 +- contrib/40.srfi/src/106.c | 102 ++++++----- contrib/60.repl/repl.c | 4 +- contrib/60.repl/repl.scm | 4 +- lib/ext/boot.c | 95 +++++++++- lib/ext/eval.c | 40 +++++ lib/ext/lib.c | 2 +- lib/include/picrin.h | 2 +- lib/state.c | 1 - lib/string.c | 6 + piclib/library.scm | 271 +++++++++++++++++++++++++++++ 22 files changed, 563 insertions(+), 144 deletions(-) create mode 100644 piclib/library.scm diff --git a/Makefile b/Makefile index eaece19f..48209640 100644 --- a/Makefile +++ b/Makefile @@ -73,8 +73,8 @@ src/init_contrib.c: # libpicrin.so: $(LIBPICRIN_OBJS) # $(CC) -shared $(CFLAGS) -o $@ $(LIBPICRIN_OBJS) $(LDFLAGS) -lib/ext/boot.c: piclib/boot.scm - bin/picrin-bootstrap tools/mkboot.scm < piclib/boot.scm > lib/ext/boot.c +lib/ext/boot.c: piclib/boot.scm piclib/library.scm + cat piclib/boot.scm piclib/library.scm | bin/picrin-bootstrap tools/mkboot.scm > lib/ext/boot.c $(LIBPICRIN_OBJS) $(PICRIN_OBJS) $(CONTRIB_OBJS): lib/include/picrin.h lib/include/picrin/*.h lib/khash.h lib/object.h lib/state.h lib/vm.h diff --git a/contrib/10.math/math.c b/contrib/10.math/math.c index 592fe6fb..ead97806 100644 --- a/contrib/10.math/math.c +++ b/contrib/10.math/math.c @@ -286,26 +286,32 @@ void pic_init_math(pic_state *pic) { pic_deflibrary(pic, "picrin.math"); + pic_in_library(pic, "picrin.math"); + pic_export(pic, 20, + "floor/", "truncate/", "floor", "ceiling", "truncate", "round", + "finite?", "infinite?", "nan?", + "sqrt", "exp", "log", "sin", "cos", "tan", + "acos", "asin", "atan", "abs", "expt"); - 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, "picrin.math:floor/", pic_number_floor2); + pic_defun(pic, "picrin.math:truncate/", pic_number_trunc2); + pic_defun(pic, "picrin.math:floor", pic_number_floor); + pic_defun(pic, "picrin.math:ceiling", pic_number_ceil); + pic_defun(pic, "picrin.math:truncate", pic_number_trunc); + pic_defun(pic, "picrin.math:round", pic_number_round); - pic_defun(pic, "finite?", pic_number_finite_p); - pic_defun(pic, "infinite?", pic_number_infinite_p); - pic_defun(pic, "nan?", pic_number_nan_p); - pic_defun(pic, "sqrt", pic_number_sqrt); - pic_defun(pic, "exp", pic_number_exp); - pic_defun(pic, "log", pic_number_log); - 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); + pic_defun(pic, "picrin.math:finite?", pic_number_finite_p); + pic_defun(pic, "picrin.math:infinite?", pic_number_infinite_p); + pic_defun(pic, "picrin.math:nan?", pic_number_nan_p); + pic_defun(pic, "picrin.math:sqrt", pic_number_sqrt); + pic_defun(pic, "picrin.math:exp", pic_number_exp); + pic_defun(pic, "picrin.math:log", pic_number_log); + pic_defun(pic, "picrin.math:sin", pic_number_sin); + pic_defun(pic, "picrin.math:cos", pic_number_cos); + pic_defun(pic, "picrin.math:tan", pic_number_tan); + pic_defun(pic, "picrin.math:acos", pic_number_acos); + pic_defun(pic, "picrin.math:asin", pic_number_asin); + pic_defun(pic, "picrin.math:atan", pic_number_atan); + pic_defun(pic, "picrin.math:abs", pic_number_abs); + pic_defun(pic, "picrin.math:expt", pic_number_expt); } diff --git a/contrib/20.r7rs/scheme/base.scm b/contrib/20.r7rs/scheme/base.scm index a65c5df0..2db0c01e 100644 --- a/contrib/20.r7rs/scheme/base.scm +++ b/contrib/20.r7rs/scheme/base.scm @@ -12,8 +12,7 @@ sqrt nan? infinite?) - (picrin macro) - (scheme file)) + (picrin macro)) ;; 4.1.2. Literal expressions diff --git a/contrib/20.r7rs/scheme/eval.scm b/contrib/20.r7rs/scheme/eval.scm index 598d99b8..f2658308 100644 --- a/contrib/20.r7rs/scheme/eval.scm +++ b/contrib/20.r7rs/scheme/eval.scm @@ -7,10 +7,12 @@ #`(set! #,n (+ #,n 1))) (define (environment . specs) - (let ((lib (string-append "picrin.@@my-environment." (number->string counter)))) + (let ((lib (string->symbol + (string-append "picrin.@@my-environment." (number->string counter))))) (inc! counter) (make-library lib) - (eval `(import ,@specs) lib) + (parameterize ((current-library lib)) + (eval `(import ,@specs) lib)) lib)) (export environment eval)) diff --git a/contrib/20.r7rs/scheme/r5rs.scm b/contrib/20.r7rs/scheme/r5rs.scm index a9f20eb2..9baebe65 100644 --- a/contrib/20.r7rs/scheme/r5rs.scm +++ b/contrib/20.r7rs/scheme/r5rs.scm @@ -7,10 +7,7 @@ (scheme cxr) (scheme lazy) (scheme eval) - (scheme load) - (only (picrin base) - library-environment - find-library)) + (scheme load)) (define-library (scheme null) (import (scheme base)) @@ -28,12 +25,12 @@ (define (null-environment n) (if (not (= n 5)) (error "unsupported environment version" n) - "scheme.null")) + '(scheme null))) (define (scheme-report-environment n) (if (not (= n 5)) (error "unsupported environment version" n) - "scheme.r5rs")) + '(scheme r5rs))) (export * + - / < <= = > >= abs acos and diff --git a/contrib/20.r7rs/src/file.c b/contrib/20.r7rs/src/file.c index e7ca2f8a..35286606 100644 --- a/contrib/20.r7rs/src/file.c +++ b/contrib/20.r7rs/src/file.c @@ -77,12 +77,11 @@ pic_file_delete(pic_state *pic) void pic_init_file(pic_state *pic) { - 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_input_file); - pic_defun(pic, "open-output-file", pic_file_open_output_file); - pic_defun(pic, "open-binary-output-file", pic_file_open_output_file); - pic_defun(pic, "file-exists?", pic_file_exists_p); - pic_defun(pic, "delete-file", pic_file_delete); + pic_defun(pic, "scheme.base:open-input-file", pic_file_open_input_file); /* for `include' */ + pic_defun(pic, "scheme.file:open-input-file", pic_file_open_input_file); + pic_defun(pic, "scheme.file:open-binary-input-file", pic_file_open_input_file); + pic_defun(pic, "scheme.file:open-output-file", pic_file_open_output_file); + pic_defun(pic, "scheme.file:open-binary-output-file", pic_file_open_output_file); + pic_defun(pic, "scheme.file:file-exists?", pic_file_exists_p); + pic_defun(pic, "scheme.file:delete-file", pic_file_delete); } diff --git a/contrib/20.r7rs/src/load.c b/contrib/20.r7rs/src/load.c index 8a7259b6..6c901c9a 100644 --- a/contrib/20.r7rs/src/load.c +++ b/contrib/20.r7rs/src/load.c @@ -33,7 +33,5 @@ pic_load_load(pic_state *pic) void pic_init_load(pic_state *pic) { - pic_deflibrary(pic, "scheme.load"); - - pic_defun(pic, "load", pic_load_load); + pic_defun(pic, "scheme.load:load", pic_load_load); } diff --git a/contrib/20.r7rs/src/system.c b/contrib/20.r7rs/src/system.c index 27ebdfbb..75b2914d 100644 --- a/contrib/20.r7rs/src/system.c +++ b/contrib/20.r7rs/src/system.c @@ -114,11 +114,9 @@ pic_system_getenvs(pic_state *pic) void pic_init_system(pic_state *pic) { - pic_deflibrary(pic, "scheme.process-context"); - - pic_defun(pic, "command-line", pic_system_cmdline); - pic_defun(pic, "exit", pic_system_exit); - pic_defun(pic, "emergency-exit", pic_system_emergency_exit); - pic_defun(pic, "get-environment-variable", pic_system_getenv); - pic_defun(pic, "get-environment-variables", pic_system_getenvs); + pic_defun(pic, "scheme.process-context:command-line", pic_system_cmdline); + pic_defun(pic, "scheme.process-context:exit", pic_system_exit); + pic_defun(pic, "scheme.process-context:emergency-exit", pic_system_emergency_exit); + pic_defun(pic, "scheme.process-context:get-environment-variable", pic_system_getenv); + pic_defun(pic, "scheme.process-context:get-environment-variables", pic_system_getenvs); } diff --git a/contrib/20.r7rs/src/time.c b/contrib/20.r7rs/src/time.c index 5c325bbd..1460c0b4 100644 --- a/contrib/20.r7rs/src/time.c +++ b/contrib/20.r7rs/src/time.c @@ -42,9 +42,7 @@ pic_jiffies_per_second(pic_state *pic) void pic_init_time(pic_state *pic) { - pic_deflibrary(pic, "scheme.time"); - - pic_defun(pic, "current-second", pic_current_second); - pic_defun(pic, "current-jiffy", pic_current_jiffy); - pic_defun(pic, "jiffies-per-second", pic_jiffies_per_second); + pic_defun(pic, "scheme.time:current-second", pic_current_second); + pic_defun(pic, "scheme.time:current-jiffy", pic_current_jiffy); + pic_defun(pic, "scheme.time:jiffies-per-second", pic_jiffies_per_second); } diff --git a/contrib/30.random/src/random.c b/contrib/30.random/src/random.c index 2c7f9d6f..2d50e256 100644 --- a/contrib/30.random/src/random.c +++ b/contrib/30.random/src/random.c @@ -15,6 +15,8 @@ void pic_init_random(pic_state *pic) { pic_deflibrary(pic, "srfi.27"); + pic_in_library(pic, "srfi.27"); + pic_export(pic, 1, "random-real"); - pic_defun(pic, "random-real", pic_random_real); + pic_defun(pic, "srfi.27:random-real", pic_random_real); } diff --git a/contrib/30.readline/src/readline.c b/contrib/30.readline/src/readline.c index 2a58b2c6..a78313a9 100644 --- a/contrib/30.readline/src/readline.c +++ b/contrib/30.readline/src/readline.c @@ -245,29 +245,40 @@ pic_init_readline(pic_state *pic){ using_history(); pic_deflibrary(pic, "picrin.readline"); + pic_in_library(pic, "picrin.readline"); + pic_export(pic, 1, "readline"); - pic_defun(pic, "readline", pic_rl_readline); + pic_defun(pic, "picrin.readline:readline", pic_rl_readline); pic_deflibrary(pic, "picrin.readline.history"); + pic_in_library(pic, "picrin.readline.history"); + pic_export(pic, 19, + "history-length", "add-history", "stifle-history", + "unstifle-history", "history-stifled?", + "where-history", "current-history", "history-get", + "clear-history", "remove-history", "history-set-pos", + "previous-history", "next-history", "history-search", + "history-search-prefix", "read-history", + "write-history", "truncate-file", "history-expand"); - /* pic_defun(pic, "history-offset", pic_rl_history_offset); */ - pic_defun(pic, "history-length", pic_rl_history_length); - pic_defun(pic, "add-history", pic_rl_add_history); - pic_defun(pic, "stifle-history", pic_rl_stifle_history); - pic_defun(pic, "unstifle-history", pic_rl_unstifle_history); - pic_defun(pic, "history-stifled?", pic_rl_history_is_stifled); - pic_defun(pic, "where-history", pic_rl_where_history); - pic_defun(pic, "current-history", pic_rl_current_history); - pic_defun(pic, "history-get", pic_rl_history_get); - pic_defun(pic, "clear-history", pic_rl_clear_history); - pic_defun(pic, "remove-history", pic_rl_remove_history); - pic_defun(pic, "history-set-pos", pic_rl_history_set_pos); - pic_defun(pic, "previous-history", pic_rl_previous_history); - pic_defun(pic, "next-history", pic_rl_next_history); - pic_defun(pic, "history-search", pic_rl_history_search); - pic_defun(pic, "history-search-prefix", pic_rl_history_search_prefix); - 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); + /* pic_defun(pic, "picrin.readline.history:history-offset", pic_rl_history_offset); */ + pic_defun(pic, "picrin.readline.history:history-length", pic_rl_history_length); + pic_defun(pic, "picrin.readline.history:add-history", pic_rl_add_history); + pic_defun(pic, "picrin.readline.history:stifle-history", pic_rl_stifle_history); + pic_defun(pic, "picrin.readline.history:unstifle-history", pic_rl_unstifle_history); + pic_defun(pic, "picrin.readline.history:history-stifled?", pic_rl_history_is_stifled); + pic_defun(pic, "picrin.readline.history:where-history", pic_rl_where_history); + pic_defun(pic, "picrin.readline.history:current-history", pic_rl_current_history); + pic_defun(pic, "picrin.readline.history:history-get", pic_rl_history_get); + pic_defun(pic, "picrin.readline.history:clear-history", pic_rl_clear_history); + pic_defun(pic, "picrin.readline.history:remove-history", pic_rl_remove_history); + pic_defun(pic, "picrin.readline.history:history-set-pos", pic_rl_history_set_pos); + pic_defun(pic, "picrin.readline.history:previous-history", pic_rl_previous_history); + pic_defun(pic, "picrin.readline.history:next-history", pic_rl_next_history); + pic_defun(pic, "picrin.readline.history:history-search", pic_rl_history_search); + pic_defun(pic, "picrin.readline.history:history-search-prefix", pic_rl_history_search_prefix); + pic_defun(pic, "picrin.readline.history:read-history", pic_rl_read_history); + pic_defun(pic, "picrin.readline.history:write-history", pic_rl_write_history); + pic_defun(pic, "picrin.readline.history:truncate-file", pic_rl_truncate_file); + pic_defun(pic, "picrin.readline.history:history-expand", pic_rl_history_expand); } diff --git a/contrib/30.regexp/src/regexp.c b/contrib/30.regexp/src/regexp.c index 9a7c0f79..163ccdd8 100644 --- a/contrib/30.regexp/src/regexp.c +++ b/contrib/30.regexp/src/regexp.c @@ -168,11 +168,15 @@ void pic_init_regexp(pic_state *pic) { pic_deflibrary(pic, "picrin.regexp"); + pic_in_library(pic, "picrin.regexp"); + pic_export(pic, 5, + "regexp", "regexp?", + "regexp-match", "regexp-split", "regexp-replace"); - pic_defun(pic, "regexp", pic_regexp_regexp); - pic_defun(pic, "regexp?", pic_regexp_regexp_p); - pic_defun(pic, "regexp-match", pic_regexp_regexp_match); - /* pic_defun(pic, "regexp-search", pic_regexp_regexp_search); */ - pic_defun(pic, "regexp-split", pic_regexp_regexp_split); - pic_defun(pic, "regexp-replace", pic_regexp_regexp_replace); + pic_defun(pic, "picrin.regexp:regexp", pic_regexp_regexp); + pic_defun(pic, "picrin.regexp:regexp?", pic_regexp_regexp_p); + pic_defun(pic, "picrin.regexp:regexp-match", pic_regexp_regexp_match); + /* pic_defun(pic, "picrin.regexp:regexp-search", pic_regexp_regexp_search); */ + pic_defun(pic, "picrin.regexp:regexp-split", pic_regexp_regexp_split); + pic_defun(pic, "picrin.regexp:regexp-replace", pic_regexp_regexp_replace); } diff --git a/contrib/40.srfi/src/106.c b/contrib/40.srfi/src/106.c index 4c1c1924..8215fc79 100644 --- a/contrib/40.srfi/src/106.c +++ b/contrib/40.srfi/src/106.c @@ -355,123 +355,121 @@ pic_socket_call_with_socket(pic_state *pic) void pic_init_srfi_106(pic_state *pic) { - 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-accept", pic_socket_socket_accept); - pic_defun(pic, "socket-send", pic_socket_socket_send); - pic_defun(pic, "socket-recv", pic_socket_socket_recv); - pic_defun(pic, "socket-shutdown", pic_socket_socket_shutdown); - pic_defun(pic, "socket-close", pic_socket_socket_close); - pic_defun(pic, "socket-input-port", pic_socket_socket_input_port); - pic_defun(pic, "socket-output-port", pic_socket_socket_output_port); - pic_defun(pic, "call-with-socket", pic_socket_call_with_socket); + pic_defun(pic, "srfi.106:socket?", pic_socket_socket_p); + pic_defun(pic, "srfi.106:make-socket", pic_socket_make_socket); + pic_defun(pic, "srfi.106:socket-accept", pic_socket_socket_accept); + pic_defun(pic, "srfi.106:socket-send", pic_socket_socket_send); + pic_defun(pic, "srfi.106:socket-recv", pic_socket_socket_recv); + pic_defun(pic, "srfi.106:socket-shutdown", pic_socket_socket_shutdown); + pic_defun(pic, "srfi.106:socket-close", pic_socket_socket_close); + pic_defun(pic, "srfi.106:socket-input-port", pic_socket_socket_input_port); + pic_defun(pic, "srfi.106:socket-output-port", pic_socket_socket_output_port); + pic_defun(pic, "srfi.106:call-with-socket", pic_socket_call_with_socket); #ifdef AF_INET - pic_define(pic, "*af-inet*", pic_int_value(pic, AF_INET)); + pic_define(pic, "srfi.106:*af-inet*", pic_int_value(pic, AF_INET)); #else - pic_define(pic, "*af-inet*", pic_false_value(pic)); + pic_define(pic, "srfi.106:*af-inet*", pic_false_value(pic)); #endif #ifdef AF_INET6 - pic_define(pic, "*af-inet6*", pic_int_value(pic, AF_INET6)); + pic_define(pic, "srfi.106:*af-inet6*", pic_int_value(pic, AF_INET6)); #else - pic_define(pic, "*af-inet6*", pic_false_value(pic)); + pic_define(pic, "srfi.106:*af-inet6*", pic_false_value(pic)); #endif #ifdef AF_UNSPEC - pic_define(pic, "*af-unspec*", pic_int_value(pic, AF_UNSPEC)); + pic_define(pic, "srfi.106:*af-unspec*", pic_int_value(pic, AF_UNSPEC)); #else - pic_define(pic, "*af-unspec*", pic_false_value(pic)); + pic_define(pic, "srfi.106:*af-unspec*", pic_false_value(pic)); #endif #ifdef SOCK_STREAM - pic_define(pic, "*sock-stream*", pic_int_value(pic, SOCK_STREAM)); + pic_define(pic, "srfi.106:*sock-stream*", pic_int_value(pic, SOCK_STREAM)); #else - pic_define(pic, "*sock-stream*", pic_false_value(pic)); + pic_define(pic, "srfi.106:*sock-stream*", pic_false_value(pic)); #endif #ifdef SOCK_DGRAM - pic_define(pic, "*sock-dgram*", pic_int_value(pic, SOCK_DGRAM)); + pic_define(pic, "srfi.106:*sock-dgram*", pic_int_value(pic, SOCK_DGRAM)); #else - pic_define(pic, "*sock-dgram*", pic_false_value(pic)); + pic_define(pic, "srfi.106:*sock-dgram*", pic_false_value(pic)); #endif #ifdef AI_CANONNAME - pic_define(pic, "*ai-canonname*", pic_int_value(pic, AI_CANONNAME)); + pic_define(pic, "srfi.106:*ai-canonname*", pic_int_value(pic, AI_CANONNAME)); #else - pic_define(pic, "*ai-canonname*", pic_false_value(pic)); + pic_define(pic, "srfi.106:*ai-canonname*", pic_false_value(pic)); #endif #ifdef AI_NUMERICHOST - pic_define(pic, "*ai-numerichost*", pic_int_value(pic, AI_NUMERICHOST)); + pic_define(pic, "srfi.106:*ai-numerichost*", pic_int_value(pic, AI_NUMERICHOST)); #else - pic_define(pic, "*ai-numerichost*", pic_false_value(pic)); + pic_define(pic, "srfi.106:*ai-numerichost*", pic_false_value(pic)); #endif /* AI_V4MAPPED and AI_ALL are not supported by *BSDs, even though they are defined in netdb.h. */ #if defined(AI_V4MAPPED) && !defined(BSD) - pic_define(pic, "*ai-v4mapped*", pic_int_value(pic, AI_V4MAPPED)); + pic_define(pic, "srfi.106:*ai-v4mapped*", pic_int_value(pic, AI_V4MAPPED)); #else - pic_define(pic, "*ai-v4mapped*", pic_false_value(pic)); + pic_define(pic, "srfi.106:*ai-v4mapped*", pic_false_value(pic)); #endif #if defined(AI_ALL) && !defined(BSD) - pic_define(pic, "*ai-all*", pic_int_value(pic, AI_ALL)); + pic_define(pic, "srfi.106:*ai-all*", pic_int_value(pic, AI_ALL)); #else - pic_define(pic, "*ai-all*", pic_false_value(pic)); + pic_define(pic, "srfi.106:*ai-all*", pic_false_value(pic)); #endif #ifdef AI_ADDRCONFIG - pic_define(pic, "*ai-addrconfig*", pic_int_value(pic, AI_ADDRCONFIG)); + pic_define(pic, "srfi.106:*ai-addrconfig*", pic_int_value(pic, AI_ADDRCONFIG)); #else - pic_define(pic, "*ai-addrconfig*", pic_false_value(pic)); + pic_define(pic, "srfi.106:*ai-addrconfig*", pic_false_value(pic)); #endif #ifdef AI_PASSIVE - pic_define(pic, "*ai-passive*", pic_int_value(pic, AI_PASSIVE)); + pic_define(pic, "srfi.106:*ai-passive*", pic_int_value(pic, AI_PASSIVE)); #else - pic_define(pic, "*ai-passive*", pic_false_value(pic)); + pic_define(pic, "srfi.106:*ai-passive*", pic_false_value(pic)); #endif #ifdef IPPROTO_IP - pic_define(pic, "*ipproto-ip*", pic_int_value(pic, IPPROTO_IP)); + pic_define(pic, "srfi.106:*ipproto-ip*", pic_int_value(pic, IPPROTO_IP)); #else - pic_define(pic, "*ipproto-ip*", pic_false_value(pic)); + pic_define(pic, "srfi.106:*ipproto-ip*", pic_false_value(pic)); #endif #ifdef IPPROTO_TCP - pic_define(pic, "*ipproto-tcp*", pic_int_value(pic, IPPROTO_TCP)); + pic_define(pic, "srfi.106:*ipproto-tcp*", pic_int_value(pic, IPPROTO_TCP)); #else - pic_define(pic, "*ipproto-tcp*", pic_false_value(pic)); + pic_define(pic, "srfi.106:*ipproto-tcp*", pic_false_value(pic)); #endif #ifdef IPPROTO_UDP - pic_define(pic, "*ipproto-udp*", pic_int_value(pic, IPPROTO_UDP)); + pic_define(pic, "srfi.106:*ipproto-udp*", pic_int_value(pic, IPPROTO_UDP)); #else - pic_define(pic, "*ipproto-udp*", pic_false_value(pic)); + pic_define(pic, "srfi.106:*ipproto-udp*", pic_false_value(pic)); #endif #ifdef MSG_PEEK - pic_define(pic, "*msg-peek*", pic_int_value(pic, MSG_PEEK)); + pic_define(pic, "srfi.106:*msg-peek*", pic_int_value(pic, MSG_PEEK)); #else - pic_define(pic, "*msg-peek*", pic_false_value(pic)); + pic_define(pic, "srfi.106:*msg-peek*", pic_false_value(pic)); #endif #ifdef MSG_OOB - pic_define(pic, "*msg-oob*", pic_int_value(pic, MSG_OOB)); + pic_define(pic, "srfi.106:*msg-oob*", pic_int_value(pic, MSG_OOB)); #else - pic_define(pic, "*msg-oob*", pic_false_value(pic)); + pic_define(pic, "srfi.106:*msg-oob*", pic_false_value(pic)); #endif #ifdef MSG_WAITALL - pic_define(pic, "*msg-waitall*", pic_int_value(pic, MSG_WAITALL)); + pic_define(pic, "srfi.106:*msg-waitall*", pic_int_value(pic, MSG_WAITALL)); #else - pic_define(pic, "*msg-waitall*", pic_false_value(pic)); + pic_define(pic, "srfi.106:*msg-waitall*", pic_false_value(pic)); #endif #ifdef SHUT_RD - pic_define(pic, "*shut-rd*", pic_int_value(pic, SHUT_RD)); + pic_define(pic, "srfi.106:*shut-rd*", pic_int_value(pic, SHUT_RD)); #else - pic_define(pic, "*shut-rd*", pic_false_value(pic)); + pic_define(pic, "srfi.106:*shut-rd*", pic_false_value(pic)); #endif #ifdef SHUT_WR - pic_define(pic, "*shut-wr*", pic_int_value(pic, SHUT_WR)); + pic_define(pic, "srfi.106:*shut-wr*", pic_int_value(pic, SHUT_WR)); #else - pic_define(pic, "*shut-wr*", pic_false_value(pic)); + pic_define(pic, "srfi.106:*shut-wr*", pic_false_value(pic)); #endif #ifdef SHUT_RDWR - pic_define(pic, "*shut-rdwr*", pic_int_value(pic, SHUT_RDWR)); + pic_define(pic, "srfi.106:*shut-rdwr*", pic_int_value(pic, SHUT_RDWR)); #else - pic_define(pic, "*shut-rdwr*", pic_false_value(pic)); + pic_define(pic, "srfi.106:*shut-rdwr*", pic_false_value(pic)); #endif } diff --git a/contrib/60.repl/repl.c b/contrib/60.repl/repl.c index a4585e73..89f14de7 100644 --- a/contrib/60.repl/repl.c +++ b/contrib/60.repl/repl.c @@ -14,7 +14,5 @@ pic_repl_tty_p(pic_state *pic) void pic_init_repl(pic_state *pic) { - pic_deflibrary(pic, "picrin.repl"); - - pic_defun(pic, "tty?", pic_repl_tty_p); + pic_defun(pic, "picrin.repl:tty?", pic_repl_tty_p); } diff --git a/contrib/60.repl/repl.scm b/contrib/60.repl/repl.scm index b2b9323f..2197c786 100644 --- a/contrib/60.repl/repl.scm +++ b/contrib/60.repl/repl.scm @@ -34,7 +34,7 @@ (scheme eval) (scheme r5rs) (picrin macro)) - "picrin.user")) + '(picrin user))) (define (repeat x) (let ((p (list x))) @@ -95,7 +95,7 @@ (lambda (port) (let next ((expr (read port))) (unless (eof-object? expr) - (write (eval expr "picrin.user")) + (write (eval expr)) (newline) (set! str "") (next (read port)))))))))) diff --git a/lib/ext/boot.c b/lib/ext/boot.c index a6471a78..c6a9a70e 100644 --- a/lib/ext/boot.c +++ b/lib/ext/boot.c @@ -164,7 +164,100 @@ static const char boot_rom[][80] = { " ,@body))))))) (define-macro letrec-syntax (lambda (form env) (let ((formal (car", " (cdr form))) (body (cdr (cdr form)))) `(let () ,@(map (lambda (x) `(,(the 'defi", "ne-syntax) ,(car x) ,(cadr x))) formal) ,@body)))) (define-macro let-syntax (lam", -"bda (form env) `(,(the 'letrec-syntax) ,@(cdr form)))) ", +"bda (form env) `(,(the 'letrec-syntax) ,@(cdr form)))) (define (mangle name) (wh", +"en (null? name) (error \"library name should be a list of at least one symbols\" n", +"ame)) (define (->string n) (cond ((symbol? n) (let ((str (symbol->string n))) (s", +"tring-for-each (lambda (c) (when (or (char=? c #\\.) (char=? c #\\:)) (error \"elem", +"ents of library name may not contain '.' or ':'\" n))) str) str)) ((and (number? ", +"n) (exact? n) (<= 0 n)) (number->string n)) (else (error \"symbol or non-negative", +" integer is required\" n)))) (define (join strs delim) (let loop ((res (car strs)", +") (strs (cdr strs))) (if (null? strs) res (loop (string-append res delim (car st", +"rs)) (cdr strs))))) (if (symbol? name) name (string->symbol (join (map ->string ", +"name) \".\")))) (define current-library (make-parameter '(picrin base) mangle)) (d", +"efine *libraries* (make-dictionary)) (define (find-library name) (dictionary-has", +"? *libraries* (mangle name))) (define (make-library name) (let ((name (mangle na", +"me))) (let ((env (make-environment (string->symbol (string-append (symbol->strin", +"g name) \":\")))) (exports (make-dictionary))) (set-identifier! 'define-library 'd", +"efine-library env) (set-identifier! 'import 'import env) (set-identifier! 'expor", +"t 'export env) (set-identifier! 'cond-expand 'cond-expand env) (dictionary-set! ", +"*libraries* name `(,env unquote exports))))) (define (library-environment name) ", +"(car (dictionary-ref *libraries* (mangle name)))) (define (library-exports name)", +" (cdr (dictionary-ref *libraries* (mangle name)))) (define (library-import name ", +"sym alias) (let ((uid (dictionary-ref (library-exports name) sym))) (let ((env (", +"library-environment (current-library)))) (set-identifier! alias uid env)))) (def", +"ine (library-export sym alias) (let ((env (library-environment (current-library)", +")) (exports (library-exports (current-library)))) (dictionary-set! exports alias", +" (find-identifier sym env)))) (define-macro define-library (lambda (form _) (let", +" ((name (cadr form)) (body (cddr form))) (or (find-library name) (make-library n", +"ame)) (parameterize ((current-library name)) (for-each (lambda (expr) (eval expr", +" name)) body))))) (define-macro cond-expand (lambda (form _) (letrec ((test (lam", +"bda (form) (or (eq? form 'else) (and (symbol? form) (memq form (features))) (and", +" (pair? form) (case (car form) ((library) (find-library (cadr form))) ((not) (no", +"t (test (cadr form)))) ((and) (let loop ((form (cdr form))) (or (null? form) (an", +"d (test (car form)) (loop (cdr form)))))) ((or) (let loop ((form (cdr form))) (a", +"nd (pair? form) (or (test (car form)) (loop (cdr form)))))) (else #f))))))) (let", +" loop ((clauses (cdr form))) (if (null? clauses) #undefined (if (test (caar clau", +"ses)) `(,the-begin ,@(cdar clauses)) (loop (cdr clauses)))))))) (define-macro im", +"port (lambda (form _) (let ((caddr (lambda (x) (car (cdr (cdr x))))) (prefix (la", +"mbda (prefix symbol) (string->symbol (string-append (symbol->string prefix) (sym", +"bol->string symbol))))) (getlib (lambda (name) (if (find-library name) name (err", +"or \"library not found\" name))))) (letrec ((extract (lambda (spec) (case (car spe", +"c) ((only rename prefix except) (extract (cadr spec))) (else (getlib spec))))) (", +"collect (lambda (spec) (case (car spec) ((only) (let ((alist (collect (cadr spec", +")))) (map (lambda (var) (assq var alist)) (cddr spec)))) ((rename) (let ((alist ", +"(collect (cadr spec))) (renames (map (lambda (x) `(,(car x) unquote (cadr x))) (", +"cddr spec)))) (map (lambda (s) (or (assq (car s) renames) s)) alist))) ((prefix)", +" (let ((alist (collect (cadr spec)))) (map (lambda (s) (cons (prefix (caddr spec", +") (car s)) (cdr s))) alist))) ((except) (let ((alist (collect (cadr spec)))) (le", +"t loop ((alist alist)) (if (null? alist) '() (if (memq (caar alist) (cddr spec))", +" (loop (cdr alist)) (cons (car alist) (loop (cdr alist)))))))) (else (dictionary", +"-map (lambda (x) (cons x x)) (library-exports (getlib spec)))))))) (letrec ((imp", +"ort (lambda (spec) (let ((lib (extract spec)) (alist (collect spec))) (for-each ", +"(lambda (slot) (library-import lib (cdr slot) (car slot))) alist))))) (for-each ", +"import (cdr form))))))) (define-macro export (lambda (form _) (letrec ((collect ", +"(lambda (spec) (cond ((symbol? spec) `(,spec unquote spec)) ((and (list? spec) (", +"= (length spec) 3) (eq? (car spec) 'rename)) `(,(list-ref spec 1) unquote (list-", +"ref spec 2))) (else (error \"malformed export\"))))) (export (lambda (spec) (let (", +"(slot (collect spec))) (library-export (car slot) (cdr slot)))))) (for-each expo", +"rt (cdr form))))) (let () (make-library '(picrin base)) (set-car! (dictionary-re", +"f *libraries* (mangle '(picrin base))) default-environment) (let ((export-keywor", +"ds (lambda (keywords) (let ((env (library-environment '(picrin base))) (exports ", +"(library-exports '(picrin base)))) (for-each (lambda (keyword) (dictionary-set! ", +"exports keyword keyword)) keywords))))) (export-keywords '(define lambda quote s", +"et! if begin define-macro let let* letrec letrec* let-values let*-values define-", +"values quasiquote unquote unquote-splicing and or cond case else => do when unle", +"ss parameterize define-syntax syntax-quote syntax-unquote syntax-quasiquote synt", +"ax-unquote-splicing let-syntax letrec-syntax syntax-error)) (export-keywords '(f", +"eatures eq? eqv? equal? not boolean? boolean=? pair? cons car cdr null? set-car!", +" set-cdr! caar cadr cdar cddr list? make-list list length append reverse list-ta", +"il list-ref list-set! list-copy map for-each memq memv member assq assv assoc cu", +"rrent-input-port current-output-port current-error-port port? input-port? output", +"-port? port-open? close-port eof-object? eof-object read-u8 peek-u8 read-bytevec", +"tor! write-u8 write-bytevector flush-output-port open-input-bytevector open-outp", +"ut-bytevector get-output-bytevector number? exact? inexact? inexact exact = < > ", +"<= >= + - * / number->string string->number procedure? apply symbol? symbol=? sy", +"mbol->string string->symbol make-identifier identifier? identifier=? identifier-", +"base identifier-environment vector? vector make-vector vector-length vector-ref ", +"vector-set! vector-copy! vector-copy vector-append vector-fill! vector-map vecto", +"r-for-each list->vector vector->list string->vector vector->string bytevector? b", +"ytevector make-bytevector bytevector-length bytevector-u8-ref bytevector-u8-set!", +" bytevector-copy! bytevector-copy bytevector-append bytevector->list list->bytev", +"ector call-with-current-continuation call/cc values call-with-values char? char-", +">integer integer->char char=? char? char<=? char>=? current-exception-ha", +"ndlers with-exception-handler raise raise-continuable error error-object? error-", +"object-message error-object-irritants error-object-type string? string make-stri", +"ng string-length string-ref string-set! string-copy string-copy! string-fill! st", +"ring-append string-map string-for-each list->string string->list string=? string", +"? string<=? string>=? make-parameter with-dynamic-environment read mak", +"e-dictionary dictionary? dictionary dictionary-has? dictionary-ref dictionary-se", +"t! dictionary-delete! dictionary-size dictionary-map dictionary-for-each diction", +"ary->alist alist->dictionary dictionary->plist plist->dictionary make-record rec", +"ord? record-type record-datum default-environment make-environment find-identifi", +"er set-identifier! eval make-ephemeron-table write write-simple write-shared dis", +"play)) (export-keywords '(find-library make-library current-library))) (set! eva", +"l (let ((e eval)) (lambda (expr . lib) (let ((lib (if (null? lib) (current-libra", +"ry) (car lib)))) (e expr (library-environment lib)))))) (make-library '(picrin u", +"ser)) (current-library '(picrin user))) ", }; void diff --git a/lib/ext/eval.c b/lib/ext/eval.c index 8298a34f..9da69c51 100644 --- a/lib/ext/eval.c +++ b/lib/ext/eval.c @@ -1219,6 +1219,43 @@ pic_compile(pic_state *pic, pic_value obj) return pic_make_proc_irep(pic, irep, NULL); } +static pic_value +pic_eval_make_environment(pic_state *pic) +{ + pic_value name; + + pic_get_args(pic, "m", &name); + + return pic_make_env(pic, pic_sym_name(pic, name)); +} + +static pic_value +pic_eval_set_identifier(pic_state *pic) +{ + pic_value id, uid, env; + + pic_get_args(pic, "omo", &id, &uid, &env); + + TYPE_CHECK(pic, id, id); + TYPE_CHECK(pic, env, env); + + pic_set_identifier(pic, id, uid, env); + return pic_undef_value(pic); +} + +static pic_value +pic_eval_find_identifier(pic_state *pic) +{ + pic_value id, env; + + pic_get_args(pic, "oo", &id, &env); + + TYPE_CHECK(pic, id, id); + TYPE_CHECK(pic, env, env); + + return pic_find_identifier(pic, id, env); +} + static pic_value pic_eval_eval(pic_state *pic) { @@ -1253,5 +1290,8 @@ pic_init_eval(pic_state *pic) add_keyword("core#begin"); add_keyword("core#define-macro"); pic_define(pic, "default-environment", env); + pic_defun(pic, "make-environment", pic_eval_make_environment); + pic_defun(pic, "find-identifier", pic_eval_find_identifier); + pic_defun(pic, "set-identifier!", pic_eval_set_identifier); pic_defun(pic, "eval", pic_eval_eval); } diff --git a/lib/ext/lib.c b/lib/ext/lib.c index cbea525c..3f646c26 100644 --- a/lib/ext/lib.c +++ b/lib/ext/lib.c @@ -25,7 +25,7 @@ pic_in_library(pic_state *pic, const char *lib) } void -export(pic_state *pic, int n, ...) +pic_export(pic_state *pic, int n, ...) { size_t ai = pic_enter(pic); va_list ap; diff --git a/lib/include/picrin.h b/lib/include/picrin.h index e1a62c49..6dda3e81 100644 --- a/lib/include/picrin.h +++ b/lib/include/picrin.h @@ -115,7 +115,7 @@ pic_value pic_bool_value(pic_state *, bool); pic_value pic_true_value(pic_state *); pic_value pic_false_value(pic_state *); pic_value pic_str_value(pic_state *, const char *str, int len); -#define pic_cstr_value(pic, cstr) pic_str_value(pic, (cstr), strlen(cstr)) +pic_value pic_cstr_value(pic_state *, const char *str); #define pic_lit_value(pic, lit) pic_str_value(pic, "" lit, -((int)sizeof lit - 1)) pic_value pic_strf_value(pic_state *, const char *fmt, ...); pic_value pic_vstrf_value(pic_state *, const char *fmt, va_list ap); diff --git a/lib/state.c b/lib/state.c index 484bfa6b..bed2e830 100644 --- a/lib/state.c +++ b/lib/state.c @@ -274,7 +274,6 @@ pic_global_ref(pic_state *pic, pic_value sym) pic_value val; if (! pic_dict_has(pic, pic->globals, sym)) { - printf("%s\n", pic_str(pic, pic_sym_name(pic, sym), 0)); pic_error(pic, "undefined variable", 1, sym); } val = pic_dict_ref(pic, pic->globals, sym); diff --git a/lib/string.c b/lib/string.c index 8d2676a4..78379d1e 100644 --- a/lib/string.c +++ b/lib/string.c @@ -213,6 +213,12 @@ pic_str_value(pic_state *pic, const char *str, int len) return make_str(pic, r); } +pic_value +pic_cstr_value(pic_state *pic, const char *cstr) +{ + return pic_str_value(pic, cstr, strlen(cstr)); +} + pic_value pic_strf_value(pic_state *pic, const char *fmt, ...) { diff --git a/piclib/library.scm b/piclib/library.scm new file mode 100644 index 00000000..3b73c035 --- /dev/null +++ b/piclib/library.scm @@ -0,0 +1,271 @@ +;;; There are two ways to name a library: (foo bar) or foo.bar +;;; The former is normalized to the latter. + +(define (mangle name) + (when (null? name) + (error "library name should be a list of at least one symbols" name)) + + (define (->string n) + (cond + ((symbol? n) + (let ((str (symbol->string n))) + (string-for-each + (lambda (c) + (when (or (char=? c #\.) (char=? c #\:)) + (error "elements of library name may not contain '.' or ':'" n))) + str) + str)) + ((and (number? n) (exact? n) (<= 0 n)) + (number->string n)) + (else + (error "symbol or non-negative integer is required" n)))) + + (define (join strs delim) + (let loop ((res (car strs)) (strs (cdr strs))) + (if (null? strs) + res + (loop (string-append res delim (car strs)) (cdr strs))))) + + (if (symbol? name) + name ; TODO: check symbol names + (string->symbol (join (map ->string name) ".")))) + +(define current-library + (make-parameter '(picrin base) mangle)) + +(define *libraries* + (make-dictionary)) + +(define (find-library name) + (dictionary-has? *libraries* (mangle name))) + +(define (make-library name) + (let ((name (mangle name))) + (let ((env (make-environment + (string->symbol (string-append (symbol->string name) ":")))) + (exports (make-dictionary))) + ;; set up initial environment + (set-identifier! 'define-library 'define-library env) + (set-identifier! 'import 'import env) + (set-identifier! 'export 'export env) + (set-identifier! 'cond-expand 'cond-expand env) + (dictionary-set! *libraries* name `(,env . ,exports))))) + +(define (library-environment name) + (car (dictionary-ref *libraries* (mangle name)))) + +(define (library-exports name) + (cdr (dictionary-ref *libraries* (mangle name)))) + +(define (library-import name sym alias) + (let ((uid (dictionary-ref (library-exports name) sym))) + (let ((env (library-environment (current-library)))) + (set-identifier! alias uid env)))) + +(define (library-export sym alias) + (let ((env (library-environment (current-library))) + (exports (library-exports (current-library)))) + (dictionary-set! exports alias (find-identifier sym env)))) + + + +;;; R7RS library syntax + +(define-macro define-library + (lambda (form _) + (let ((name (cadr form)) + (body (cddr form))) + (or (find-library name) (make-library name)) + (parameterize ((current-library name)) + (for-each + (lambda (expr) + (eval expr name)) ; TODO parse library declarations + body))))) + +(define-macro cond-expand + (lambda (form _) + (letrec + ((test (lambda (form) + (or + (eq? form 'else) + (and (symbol? form) + (memq form (features))) + (and (pair? form) + (case (car form) + ((library) (find-library (cadr form))) + ((not) (not (test (cadr form)))) + ((and) (let loop ((form (cdr form))) + (or (null? form) + (and (test (car form)) (loop (cdr form)))))) + ((or) (let loop ((form (cdr form))) + (and (pair? form) + (or (test (car form)) (loop (cdr form)))))) + (else #f))))))) + (let loop ((clauses (cdr form))) + (if (null? clauses) + #undefined + (if (test (caar clauses)) + `(,the-begin ,@(cdar clauses)) + (loop (cdr clauses)))))))) + +(define-macro import + (lambda (form _) + (let ((caddr + (lambda (x) (car (cdr (cdr x))))) + (prefix + (lambda (prefix symbol) + (string->symbol + (string-append + (symbol->string prefix) + (symbol->string symbol))))) + (getlib + (lambda (name) + (if (find-library name) + name + (error "library not found" name))))) + (letrec + ((extract + (lambda (spec) + (case (car spec) + ((only rename prefix except) + (extract (cadr spec))) + (else + (getlib spec))))) + (collect + (lambda (spec) + (case (car spec) + ((only) + (let ((alist (collect (cadr spec)))) + (map (lambda (var) (assq var alist)) (cddr spec)))) + ((rename) + (let ((alist (collect (cadr spec))) + (renames (map (lambda (x) `(,(car x) . ,(cadr x))) (cddr spec)))) + (map (lambda (s) (or (assq (car s) renames) s)) alist))) + ((prefix) + (let ((alist (collect (cadr spec)))) + (map (lambda (s) (cons (prefix (caddr spec) (car s)) (cdr s))) alist))) + ((except) + (let ((alist (collect (cadr spec)))) + (let loop ((alist alist)) + (if (null? alist) + '() + (if (memq (caar alist) (cddr spec)) + (loop (cdr alist)) + (cons (car alist) (loop (cdr alist)))))))) + (else + (dictionary-map (lambda (x) (cons x x)) + (library-exports (getlib spec)))))))) + (letrec + ((import + (lambda (spec) + (let ((lib (extract spec)) + (alist (collect spec))) + (for-each + (lambda (slot) + (library-import lib (cdr slot) (car slot))) + alist))))) + (for-each import (cdr form))))))) + +(define-macro export + (lambda (form _) + (letrec + ((collect + (lambda (spec) + (cond + ((symbol? spec) + `(,spec . ,spec)) + ((and (list? spec) (= (length spec) 3) (eq? (car spec) 'rename)) + `(,(list-ref spec 1) . ,(list-ref spec 2))) + (else + (error "malformed export"))))) + (export + (lambda (spec) + (let ((slot (collect spec))) + (library-export (car slot) (cdr slot)))))) + (for-each export (cdr form))))) + + +;;; bootstrap... +(let () + (make-library '(picrin base)) + (set-car! (dictionary-ref *libraries* (mangle '(picrin base))) default-environment) + (let ((export-keywords + (lambda (keywords) + (let ((env (library-environment '(picrin base))) + (exports (library-exports '(picrin base)))) + (for-each + (lambda (keyword) + (dictionary-set! exports keyword keyword)) + keywords))))) + (export-keywords + '(define lambda quote set! if begin define-macro + let let* letrec letrec* + let-values let*-values define-values + quasiquote unquote unquote-splicing + and or + cond case else => + do when unless + parameterize + define-syntax + syntax-quote syntax-unquote + syntax-quasiquote syntax-unquote-splicing + let-syntax letrec-syntax + syntax-error)) + (export-keywords + '(features + eq? eqv? equal? not boolean? boolean=? + pair? cons car cdr null? set-car! set-cdr! + caar cadr cdar cddr + list? make-list list length append reverse + list-tail list-ref list-set! list-copy + map for-each memq memv member assq assv assoc + current-input-port current-output-port current-error-port + port? input-port? output-port? port-open? close-port + eof-object? eof-object + read-u8 peek-u8 read-bytevector! + write-u8 write-bytevector flush-output-port + open-input-bytevector open-output-bytevector get-output-bytevector + number? exact? inexact? inexact exact + = < > <= >= + - * / + number->string string->number + procedure? apply + symbol? symbol=? symbol->string string->symbol + make-identifier identifier? identifier=? identifier-base identifier-environment + vector? vector make-vector vector-length vector-ref vector-set! + vector-copy! vector-copy vector-append vector-fill! vector-map vector-for-each + list->vector vector->list string->vector vector->string + bytevector? bytevector make-bytevector + bytevector-length bytevector-u8-ref bytevector-u8-set! + bytevector-copy! bytevector-copy bytevector-append + bytevector->list list->bytevector + call-with-current-continuation call/cc values call-with-values + char? char->integer integer->char char=? char? char<=? char>=? + current-exception-handlers with-exception-handler + raise raise-continuable error + error-object? error-object-message error-object-irritants + error-object-type + string? string make-string string-length string-ref string-set! + string-copy string-copy! string-fill! string-append + string-map string-for-each list->string string->list + string=? string? string<=? string>=? + make-parameter with-dynamic-environment + read + make-dictionary dictionary? dictionary dictionary-has? + dictionary-ref dictionary-set! dictionary-delete! dictionary-size + dictionary-map dictionary-for-each + dictionary->alist alist->dictionary dictionary->plist plist->dictionary + make-record record? record-type record-datum + default-environment make-environment find-identifier set-identifier! + eval + make-ephemeron-table + write write-simple write-shared display)) + (export-keywords + '(find-library make-library current-library))) + (set! eval + (let ((e eval)) + (lambda (expr . lib) + (let ((lib (if (null? lib) (current-library) (car lib)))) + (e expr (library-environment lib)))))) + (make-library '(picrin user)) + (current-library '(picrin user))) +