From 561c350a1239bbe29ed90bfbd980b143599e4a84 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Thu, 18 Feb 2016 17:39:32 +0900 Subject: [PATCH] library is now a non-first-class object --- contrib/10.callcc/callcc.c | 6 +- contrib/10.math/math.c | 2 +- contrib/20.r7rs/scheme/eval.scm | 11 +- contrib/20.r7rs/scheme/r5rs.scm | 4 +- contrib/20.r7rs/src/file.c | 2 +- contrib/20.r7rs/src/load.c | 2 +- contrib/20.r7rs/src/mutable-string.c | 2 +- contrib/20.r7rs/src/system.c | 2 +- contrib/20.r7rs/src/time.c | 2 +- contrib/30.random/src/random.c | 2 +- contrib/30.readline/src/readline.c | 4 +- contrib/30.regexp/src/regexp.c | 2 +- contrib/40.srfi/src/106.c | 6 +- contrib/60.repl/repl.c | 2 +- contrib/60.repl/repl.scm | 4 +- contrib/70.main/main.scm | 2 +- extlib/benz/boot.c | 126 +++++++++++-------- extlib/benz/eval.c | 24 ++-- extlib/benz/gc.c | 25 ++-- extlib/benz/include/picrin.h | 33 ++--- extlib/benz/include/picrin/khash.h | 9 ++ extlib/benz/include/picrin/lib.h | 26 ---- extlib/benz/include/picrin/macro.h | 2 +- extlib/benz/include/picrin/state.h | 14 ++- extlib/benz/include/picrin/type.h | 4 - extlib/benz/lib.c | 176 +++++++++++++++------------ extlib/benz/load.c | 2 +- extlib/benz/macro.c | 8 +- extlib/benz/port.c | 2 +- extlib/benz/proc.c | 54 ++++---- extlib/benz/state.c | 17 +-- extlib/benz/string.c | 4 +- extlib/benz/vector.c | 4 +- src/main.c | 5 +- 34 files changed, 308 insertions(+), 282 deletions(-) delete mode 100644 extlib/benz/include/picrin/lib.h diff --git a/contrib/10.callcc/callcc.c b/contrib/10.callcc/callcc.c index f4a82670..51327757 100644 --- a/contrib/10.callcc/callcc.c +++ b/contrib/10.callcc/callcc.c @@ -282,8 +282,6 @@ pic_callcc_callcc(pic_state *pic) void pic_init_callcc(pic_state *pic) { - 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, "picrin.base", "call-with-current-continuation", pic_callcc_callcc); + pic_redefun(pic, "picrin.base", "call/cc", pic_callcc_callcc); } diff --git a/contrib/10.math/math.c b/contrib/10.math/math.c index 84584caf..81c04927 100644 --- a/contrib/10.math/math.c +++ b/contrib/10.math/math.c @@ -284,7 +284,7 @@ pic_number_expt(pic_state *pic) void 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); diff --git a/contrib/20.r7rs/scheme/eval.scm b/contrib/20.r7rs/scheme/eval.scm index c914ad7d..598d99b8 100644 --- a/contrib/20.r7rs/scheme/eval.scm +++ b/contrib/20.r7rs/scheme/eval.scm @@ -6,14 +6,11 @@ (define-syntax (inc! n) #`(set! #,n (+ #,n 1))) - (define (number->symbol n) - (string->symbol (number->string n))) - (define (environment . specs) - (let ((library-name `(picrin @@my-environment ,(number->symbol counter)))) + (let ((lib (string-append "picrin.@@my-environment." (number->string counter)))) (inc! counter) - (let ((lib (make-library library-name))) - (eval `(import ,@specs) lib) - lib))) + (make-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 7d557027..a9f20eb2 100644 --- a/contrib/20.r7rs/scheme/r5rs.scm +++ b/contrib/20.r7rs/scheme/r5rs.scm @@ -28,12 +28,12 @@ (define (null-environment n) (if (not (= n 5)) (error "unsupported environment version" n) - (find-library '(scheme null)))) + "scheme.null")) (define (scheme-report-environment n) (if (not (= n 5)) (error "unsupported environment version" n) - (find-library '(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 609592ea..d6a1135b 100644 --- a/contrib/20.r7rs/src/file.c +++ b/contrib/20.r7rs/src/file.c @@ -93,7 +93,7 @@ pic_file_delete(pic_state *pic) void 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); diff --git a/contrib/20.r7rs/src/load.c b/contrib/20.r7rs/src/load.c index 58a48c3c..aed45506 100644 --- a/contrib/20.r7rs/src/load.c +++ b/contrib/20.r7rs/src/load.c @@ -25,7 +25,7 @@ pic_load_load(pic_state *pic) void pic_init_load(pic_state *pic) { - pic_deflibrary(pic, "(scheme load)"); + pic_deflibrary(pic, "scheme.load"); pic_defun(pic, "load", pic_load_load); } diff --git a/contrib/20.r7rs/src/mutable-string.c b/contrib/20.r7rs/src/mutable-string.c index 6d12deea..2d360c6c 100644 --- a/contrib/20.r7rs/src/mutable-string.c +++ b/contrib/20.r7rs/src/mutable-string.c @@ -85,7 +85,7 @@ pic_str_string_fill_ip(pic_state *pic) void 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); diff --git a/contrib/20.r7rs/src/system.c b/contrib/20.r7rs/src/system.c index 0ec818fd..53acc81f 100644 --- a/contrib/20.r7rs/src/system.c +++ b/contrib/20.r7rs/src/system.c @@ -127,7 +127,7 @@ pic_system_getenvs(pic_state *pic) void 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); diff --git a/contrib/20.r7rs/src/time.c b/contrib/20.r7rs/src/time.c index 4cab8aca..ba34d4eb 100644 --- a/contrib/20.r7rs/src/time.c +++ b/contrib/20.r7rs/src/time.c @@ -41,7 +41,7 @@ pic_jiffies_per_second(pic_state *pic) void 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); diff --git a/contrib/30.random/src/random.c b/contrib/30.random/src/random.c index 61e33633..6eb2ee11 100644 --- a/contrib/30.random/src/random.c +++ b/contrib/30.random/src/random.c @@ -13,7 +13,7 @@ pic_random_real(pic_state *pic) void pic_init_random(pic_state *pic) { - pic_deflibrary(pic, "(srfi 27)"); + pic_deflibrary(pic, "srfi.27"); pic_defun(pic, "random-real", pic_random_real); } diff --git a/contrib/30.readline/src/readline.c b/contrib/30.readline/src/readline.c index 26df7c82..9b95e2ad 100644 --- a/contrib/30.readline/src/readline.c +++ b/contrib/30.readline/src/readline.c @@ -247,11 +247,11 @@ void pic_init_readline(pic_state *pic){ using_history(); - pic_deflibrary(pic, "(picrin readline)"); + pic_deflibrary(pic, "picrin.readline"); pic_defun(pic, "readline", pic_rl_readline); - pic_deflibrary(pic, "(picrin readline history)"); + pic_deflibrary(pic, "picrin.readline.history"); /* pic_defun(pic, "history-offset", pic_rl_history_offset); */ pic_defun(pic, "history-length", pic_rl_history_length); diff --git a/contrib/30.regexp/src/regexp.c b/contrib/30.regexp/src/regexp.c index fd88e290..5cfc1ccb 100644 --- a/contrib/30.regexp/src/regexp.c +++ b/contrib/30.regexp/src/regexp.c @@ -178,7 +178,7 @@ pic_regexp_regexp_replace(pic_state *pic) void 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); diff --git a/contrib/40.srfi/src/106.c b/contrib/40.srfi/src/106.c index 42349d68..d6598d9a 100644 --- a/contrib/40.srfi/src/106.c +++ b/contrib/40.srfi/src/106.c @@ -399,10 +399,10 @@ pic_socket_call_with_socket(pic_state *pic) void 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_define_(pic, name, v) pic_define(pic, pic->lib, name, v) + pic_deflibrary(pic, "srfi.106"); - pic_deflibrary(pic, "(srfi 106)"); +#define pic_defun_(pic, name, f) pic_define(pic, "srfi.106", name, pic_obj_value(pic_make_proc(pic, f, 0, NULL))) +#define pic_define_(pic, name, v) pic_define(pic, "srfi.106", name, v) pic_defun_(pic, "socket?", pic_socket_socket_p); pic_defun_(pic, "make-socket", pic_socket_make_socket); diff --git a/contrib/60.repl/repl.c b/contrib/60.repl/repl.c index 1084618b..cea0ed22 100644 --- a/contrib/60.repl/repl.c +++ b/contrib/60.repl/repl.c @@ -15,7 +15,7 @@ pic_repl_tty_p(pic_state *pic) void pic_init_repl(pic_state *pic) { - pic_deflibrary(pic, "(picrin repl)"); + pic_deflibrary(pic, "picrin.repl"); pic_defun(pic, "tty?", pic_repl_tty_p); } diff --git a/contrib/60.repl/repl.scm b/contrib/60.repl/repl.scm index 742bdaa7..698c77c5 100644 --- a/contrib/60.repl/repl.scm +++ b/contrib/60.repl/repl.scm @@ -34,7 +34,7 @@ (scheme eval) (scheme r5rs) (picrin macro)) - (find-library '(picrin user)))) + "picrin.user")) (define (repl) (init-env) @@ -65,7 +65,7 @@ (lambda (port) (let next ((expr (read port))) (unless (eof-object? expr) - (write (eval expr (find-library '(picrin user)))) + (write (eval expr "picrin.user")) (newline) (set! str "") (next (read port)))))))))) diff --git a/contrib/70.main/main.scm b/contrib/70.main/main.scm index f0e48e9c..27e800b3 100644 --- a/contrib/70.main/main.scm +++ b/contrib/70.main/main.scm @@ -41,7 +41,7 @@ (lambda (in) (let loop ((expr (read in))) (unless (eof-object? expr) - (eval expr (find-library '(picrin user))) + (eval expr (find-library "picrin.user")) (loop (read in))))))) (define (main) diff --git a/extlib/benz/boot.c b/extlib/benz/boot.c index 8dff52fe..9ad798e3 100644 --- a/extlib/benz/boot.c +++ b/extlib/benz/boot.c @@ -542,12 +542,24 @@ my $src = <<'EOL'; ;;; library primitives +(define (mangle name) + (define (->string n) + (if (symbol? n) + (symbol->string n) + (number->string 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))))) + (join (map ->string name) ".")) + (define-macro define-library (lambda (form _) - (let ((name (cadr form)) + (let ((lib (mangle (cadr form))) (body (cddr form))) - (let ((new-library (or (find-library name) (make-library name)))) - (for-each (lambda (expr) (eval expr new-library)) body))))) + (or (find-library lib) (make-library lib)) + (for-each (lambda (expr) (eval expr lib)) body)))) (define-macro cond-expand (lambda (form _) @@ -559,7 +571,7 @@ my $src = <<'EOL'; (memq form (features))) (and (pair? form) (case (car form) - ((library) (find-library (cadr form))) + ((library) (find-library (mangle (cadr form)))) ((not) (not (test (cadr form)))) ((and) (let loop ((form (cdr form))) (or (null? form) @@ -584,7 +596,13 @@ my $src = <<'EOL'; (string->symbol (string-append (symbol->string prefix) - (symbol->string symbol)))))) + (symbol->string symbol))))) + (getlib + (lambda (name) + (let ((lib (mangle name))) + (if (find-library lib) + lib + (error "library not found" name)))))) (letrec ((extract (lambda (spec) @@ -592,7 +610,7 @@ my $src = <<'EOL'; ((only rename prefix except) (extract (cadr spec))) (else - (or (find-library spec) (error "library not found" spec)))))) + (getlib spec))))) (collect (lambda (spec) (case (car spec) @@ -615,8 +633,7 @@ my $src = <<'EOL'; (loop (cdr alist)) (cons (car alist) (loop (cdr alist)))))))) (else - (let ((lib (or (find-library spec) (error "library not found" spec)))) - (map (lambda (x) (cons x x)) (library-exports lib)))))))) + (map (lambda (x) (cons x x)) (library-exports (getlib spec)))))))) (letrec ((import (lambda (spec) @@ -948,31 +965,37 @@ const char pic_boot[][80] = { "rm))))\n `(let ()\n ,@(map (lambda (x)\n `(,(the 'def", "ine-syntax) ,(car x) ,(cadr x)))\n formal)\n ,@body))))\n\n(d", "efine-macro let-syntax\n (lambda (form env)\n `(,(the 'letrec-syntax) ,@(cdr f", -"orm))))\n\n\n;;; library primitives\n\n(define-macro define-library\n (lambda (form _", -")\n (let ((name (cadr form))\n (body (cddr form)))\n (let ((new-li", -"brary (or (find-library name) (make-library name))))\n (for-each (lambda (", -"expr) (eval expr new-library)) body)))))\n\n(define-macro cond-expand\n (lambda (f", -"orm _)\n (letrec\n ((test (lambda (form)\n (or\n ", -" (eq? form 'else)\n (and (symbol? form)\n ", -" (memq form (features)))\n (and (pair? form)\n ", -" (case (car form)\n ((library) (find-library (cad", -"r form)))\n ((not) (not (test (cadr form))))\n ", -" ((and) (let loop ((form (cdr form)))\n ", -" (or (null? form)\n (and (test (car form)", -") (loop (cdr form))))))\n ((or) (let loop ((form (cdr for", -"m)))\n (and (pair? form)\n ", -" (or (test (car form)) (loop (cdr form))))))\n ", -" (else #f)))))))\n (let loop ((clauses (cdr form)))\n (if (null? cla", -"uses)\n #undefined\n (if (test (caar clauses))\n ", -" `(,the-begin ,@(cdar clauses))\n (loop (cdr clauses))))))))\n\n(d", -"efine-macro import\n (lambda (form _)\n (let ((caddr\n (lambda (x) (c", -"ar (cdr (cdr x)))))\n (prefix\n (lambda (prefix symbol)\n ", -" (string->symbol\n (string-append\n (symbol->strin", -"g prefix)\n (symbol->string symbol))))))\n (letrec\n ((", -"extract\n (lambda (spec)\n (case (car spec)\n ", -" ((only rename prefix except)\n (extract (cadr spec)))\n ", -" (else\n (or (find-library spec) (error \"library not found\"", -" spec))))))\n (collect\n (lambda (spec)\n (case (", +"orm))))\n\n\n;;; library primitives\n\n(define (mangle name)\n (define (->string n)\n ", +" (if (symbol? n)\n (symbol->string n)\n (number->string n)))\n (de", +"fine (join strs delim)\n (let loop ((res (car strs)) (strs (cdr strs)))\n ", +"(if (null? strs)\n res\n (loop (string-append res delim (car str", +"s)) (cdr strs)))))\n (join (map ->string name) \".\"))\n\n(define-macro define-libra", +"ry\n (lambda (form _)\n (let ((lib (mangle (cadr form)))\n (body (cddr", +" form)))\n (or (find-library lib) (make-library lib))\n (for-each (lambd", +"a (expr) (eval expr lib)) body))))\n\n(define-macro cond-expand\n (lambda (form _)", +"\n (letrec\n ((test (lambda (form)\n (or\n ", +" (eq? form 'else)\n (and (symbol? form)\n ", +"(memq form (features)))\n (and (pair? form)\n ", +" (case (car form)\n ((library) (find-library (mangle (c", +"adr form))))\n ((not) (not (test (cadr form))))\n ", +" ((and) (let loop ((form (cdr form)))\n ", +" (or (null? form)\n (and (test (car fo", +"rm)) (loop (cdr form))))))\n ((or) (let loop ((form (cdr ", +"form)))\n (and (pair? form)\n ", +" (or (test (car form)) (loop (cdr form))))))\n ", +" (else #f)))))))\n (let loop ((clauses (cdr form)))\n (if (null? ", +"clauses)\n #undefined\n (if (test (caar clauses))\n ", +" `(,the-begin ,@(cdar clauses))\n (loop (cdr clauses))))))))\n", +"\n(define-macro import\n (lambda (form _)\n (let ((caddr\n (lambda (x)", +" (car (cdr (cdr x)))))\n (prefix\n (lambda (prefix symbol)\n ", +" (string->symbol\n (string-append\n (symbol->st", +"ring prefix)\n (symbol->string symbol)))))\n (getlib\n ", +" (lambda (name)\n (let ((lib (mangle name)))\n (if (", +"find-library lib)\n lib\n (error \"library not ", +"found\" name))))))\n (letrec\n ((extract\n (lambda (spec)\n ", +" (case (car spec)\n ((only rename prefix except)\n ", +" (extract (cadr spec)))\n (else\n (getli", +"b spec)))))\n (collect\n (lambda (spec)\n (case (", "car spec)\n ((only)\n (let ((alist (collect (cadr s", "pec))))\n (map (lambda (var) (assq var alist)) (cddr spec))))\n ", " ((rename)\n (let ((alist (collect (cadr spec)))\n ", @@ -985,25 +1008,24 @@ const char pic_boot[][80] = { "f (null? alist)\n '()\n (if (memq ", "(caar alist) (cddr spec))\n (loop (cdr alist))\n ", " (cons (car alist) (loop (cdr alist))))))))\n ", -" (else\n (let ((lib (or (find-library spec) (error \"library not ", -"found\" spec))))\n (map (lambda (x) (cons x x)) (library-exports", -" lib))))))))\n (letrec\n ((import\n (lambda (spec)\n", -" (let ((lib (extract spec))\n (alist (colle", -"ct spec)))\n (for-each\n (lambda (slot)\n ", -" (library-import lib (cdr slot) (car slot)))\n ", -" alist)))))\n (for-each import (cdr form)))))))\n\n(define-macro export\n ", -"(lambda (form _)\n (letrec\n ((collect\n (lambda (spec)\n ", -" (cond\n ((symbol? spec)\n `(,spec . ,spec))\n ", -" ((and (list? spec) (= (length spec) 3) (eq? (car spec) 'rename))\n ", -" `(,(list-ref spec 1) . ,(list-ref spec 2)))\n (else\n ", -"(error \"malformed export\")))))\n (export\n (lambda (spec)\n ", -" (let ((slot (collect spec)))\n (library-export (car slot) (c", -"dr slot))))))\n (for-each export (cdr form)))))\n\n(export define lambda quote", -" set! if begin define-macro\n let let* letrec letrec*\n let-values l", -"et*-values define-values\n quasiquote unquote unquote-splicing\n and", -" or\n cond case else =>\n do when unless\n parameterize\n ", -" define-syntax\n syntax-quote syntax-unquote\n syntax-quasiquote sy", -"ntax-unquote-splicing\n let-syntax letrec-syntax\n syntax-error)\n\n\n", +" (else\n (map (lambda (x) (cons x x)) (library-exports (getlib s", +"pec))))))))\n (letrec\n ((import\n (lambda (spec)\n ", +" (let ((lib (extract spec))\n (alist (collec", +"t spec)))\n (for-each\n (lambda (slot)\n ", +" (library-import lib (cdr slot) (car slot)))\n ", +"alist)))))\n (for-each import (cdr form)))))))\n\n(define-macro export\n (", +"lambda (form _)\n (letrec\n ((collect\n (lambda (spec)\n ", +" (cond\n ((symbol? spec)\n `(,spec . ,spec))\n ", +" ((and (list? spec) (= (length spec) 3) (eq? (car spec) 'rename))\n ", +" `(,(list-ref spec 1) . ,(list-ref spec 2)))\n (else\n (", +"error \"malformed export\")))))\n (export\n (lambda (spec)\n ", +" (let ((slot (collect spec)))\n (library-export (car slot) (cd", +"r slot))))))\n (for-each export (cdr form)))))\n\n(export define lambda quote ", +"set! if begin define-macro\n let let* letrec letrec*\n let-values le", +"t*-values define-values\n quasiquote unquote unquote-splicing\n and ", +"or\n cond case else =>\n do when unless\n parameterize\n ", +" define-syntax\n syntax-quote syntax-unquote\n syntax-quasiquote syn", +"tax-unquote-splicing\n let-syntax letrec-syntax\n syntax-error)\n\n\n", "", "" }; diff --git a/extlib/benz/eval.c b/extlib/benz/eval.c index b825e077..80799d47 100644 --- a/extlib/benz/eval.c +++ b/extlib/benz/eval.c @@ -885,20 +885,23 @@ pic_compile(pic_state *pic, pic_value obj) } pic_value -pic_eval(pic_state *pic, pic_value program, struct pic_lib *lib) +pic_eval(pic_state *pic, pic_value program, const char *lib) { - struct pic_lib *prev_lib = pic->lib; + const char *prev_lib = pic_current_library(pic); + struct pic_env *env; pic_value r; - pic->lib = lib; + env = pic_library_environment(pic, lib); + + pic_in_library(pic, lib); pic_try { - r = pic_call(pic, pic_compile(pic, pic_expand(pic, program, lib->env)), 0); + r = pic_call(pic, pic_compile(pic, pic_expand(pic, program, env)), 0); } pic_catch { - pic->lib = prev_lib; + pic_in_library(pic, prev_lib); pic_raise(pic, pic->err); } - pic->lib = prev_lib; + pic_in_library(pic, prev_lib); return r; } @@ -906,13 +909,12 @@ pic_eval(pic_state *pic, pic_value program, struct pic_lib *lib) static pic_value pic_eval_eval(pic_state *pic) { - pic_value program, lib; + pic_value program; + const char *str; - pic_get_args(pic, "oo", &program, &lib); + pic_get_args(pic, "oz", &program, &str); - pic_assert_type(pic, lib, lib); - - return pic_eval(pic, program, pic_lib_ptr(lib)); + return pic_eval(pic, program, str); } void diff --git a/extlib/benz/gc.c b/extlib/benz/gc.c index 1305ea79..558bcf82 100644 --- a/extlib/benz/gc.c +++ b/extlib/benz/gc.c @@ -34,7 +34,6 @@ struct pic_object { struct pic_context cxt; struct pic_port port; struct pic_error err; - struct pic_lib lib; struct pic_checkpoint cp; } u; }; @@ -347,20 +346,11 @@ gc_mark_object(pic_state *pic, struct pic_object *obj) gc_mark_object(pic, (struct pic_object *)kh_val(h, it)); } } - if (obj->u.env.prefix) { - gc_mark_object(pic, (struct pic_object *)obj->u.env.prefix); - } if (obj->u.env.up) { LOOP(obj->u.env.up); } break; } - case PIC_TT_LIB: { - gc_mark(pic, obj->u.lib.name); - gc_mark_object(pic, (struct pic_object *)obj->u.lib.env); - LOOP(obj->u.lib.exports); - break; - } case PIC_TT_DATA: { if (obj->u.data.type->mark) { obj->u.data.type->mark(pic, obj->u.data.data, gc_mark); @@ -428,6 +418,7 @@ gc_mark_phase(pic_state *pic) pic_callinfo *ci; struct pic_proc **xhandler; struct pic_list *list; + khiter_t it; size_t j; assert(pic->heap->weaks == NULL); @@ -492,12 +483,19 @@ gc_mark_phase(pic_state *pic) /* features */ gc_mark(pic, pic->features); - /* library table */ - gc_mark(pic, pic->libs); - /* parameter table */ gc_mark(pic, pic->ptable); + /* library table */ + for (it = kh_begin(&pic->ltable); it != kh_end(&pic->ltable); ++it) { + if (! kh_exist(&pic->ltable, it)) { + continue; + } + gc_mark_object(pic, (struct pic_object *)kh_val(&pic->ltable, it).name); + gc_mark_object(pic, (struct pic_object *)kh_val(&pic->ltable, it).env); + gc_mark_object(pic, (struct pic_object *)kh_val(&pic->ltable, it).exports); + } + /* weak maps */ do { struct pic_object *key; @@ -580,7 +578,6 @@ gc_finalize_object(pic_state *pic, struct pic_object *obj) case PIC_TT_PORT: case PIC_TT_ERROR: case PIC_TT_ID: - case PIC_TT_LIB: case PIC_TT_RECORD: case PIC_TT_CP: break; diff --git a/extlib/benz/include/picrin.h b/extlib/benz/include/picrin.h index 632418d2..b9931736 100644 --- a/extlib/benz/include/picrin.h +++ b/extlib/benz/include/picrin.h @@ -63,17 +63,18 @@ void pic_add_feature(pic_state *, const char *); void pic_defun(pic_state *, const char *, pic_func_t); void pic_defvar(pic_state *, const char *, pic_value, struct pic_proc *); -void pic_define(pic_state *, struct pic_lib *, const char *, pic_value); -pic_value pic_ref(pic_state *, struct pic_lib *, const char *); -void pic_set(pic_state *, struct pic_lib *, const char *, pic_value); +void pic_define(pic_state *, const char *, const char *, pic_value); +pic_value pic_ref(pic_state *, const char *, const char *); +void pic_set(pic_state *, const char *, const char *, pic_value); pic_value pic_closure_ref(pic_state *, int); void pic_closure_set(pic_state *, int, pic_value); -pic_value pic_funcall(pic_state *pic, struct pic_lib *, const char *, int, ...); +pic_value pic_funcall(pic_state *pic, const char *, const char *, int, ...); -struct pic_lib *pic_make_library(pic_state *, pic_value); -void pic_in_library(pic_state *, pic_value); -struct pic_lib *pic_find_library(pic_state *, pic_value); -void pic_import(pic_state *, struct pic_lib *); +void pic_make_library(pic_state *, const char *); +void pic_in_library(pic_state *, const char *); +bool pic_find_library(pic_state *, const char *); +const char *pic_current_library(pic_state *); +void pic_import(pic_state *, const char *); void pic_export(pic_state *, pic_sym *); PIC_NORETURN void pic_panic(pic_state *, const char *); @@ -186,7 +187,6 @@ int pic_str_hash(pic_state *, struct pic_string *); #include "picrin/data.h" #include "picrin/dict.h" #include "picrin/error.h" -#include "picrin/lib.h" #include "picrin/macro.h" #include "picrin/pair.h" #include "picrin/port.h" @@ -215,16 +215,15 @@ pic_value pic_read_cstr(pic_state *, const char *); void pic_load(pic_state *, struct pic_port *); void pic_load_cstr(pic_state *, const char *); -pic_value pic_eval(pic_state *, pic_value, struct pic_lib *); +pic_value pic_eval(pic_state *, pic_value, const char *); struct pic_proc *pic_make_var(pic_state *, pic_value, struct pic_proc *); -#define pic_deflibrary(pic, spec) do { \ - pic_value libname = pic_read_cstr(pic, spec); \ - if (pic_find_library(pic, libname) == NULL) { \ - pic_make_library(pic, libname); \ - } \ - pic_in_library(pic, libname); \ +#define pic_deflibrary(pic, lib) do { \ + if (! pic_find_library(pic, lib)) { \ + pic_make_library(pic, lib); \ + } \ + pic_in_library(pic, lib); \ } while (0) void pic_warnf(pic_state *, const char *, ...); @@ -242,6 +241,8 @@ void pic_fprintf(pic_state *, struct pic_port *, const char *, ...); pic_value pic_display(pic_state *, pic_value); pic_value pic_fdisplay(pic_state *, pic_value, xFILE *); +struct pic_env *pic_library_environment(pic_state *, const char *); + #if DEBUG # define pic_debug(pic,obj) pic_fwrite(pic,obj,xstderr) # define pic_fdebug(pic,obj,file) pic_fwrite(pic,obj,file) diff --git a/extlib/benz/include/picrin/khash.h b/extlib/benz/include/picrin/khash.h index 157926ee..a75a5cec 100644 --- a/extlib/benz/include/picrin/khash.h +++ b/extlib/benz/include/picrin/khash.h @@ -206,6 +206,15 @@ typedef khint_t khiter_t; #define kh_ptr_hash_equal(a, b) ((a) == (b)) #define kh_int_hash_func(key) (int)(key) #define kh_int_hash_equal(a, b) ((a) == (b)) +PIC_INLINE int kh_str_hash_func(const char *s) { + int h = 0; + while (*s) { + h = (h << 5) - h + *s++; + } + return h; +} +#define kh_str_cmp_func(a, b) (strcmp((a), (b)) == 0) + /* --- END OF HASH FUNCTIONS --- */ diff --git a/extlib/benz/include/picrin/lib.h b/extlib/benz/include/picrin/lib.h deleted file mode 100644 index 50cd45fe..00000000 --- a/extlib/benz/include/picrin/lib.h +++ /dev/null @@ -1,26 +0,0 @@ -/** - * See Copyright Notice in picrin.h - */ - -#ifndef PICRIN_LIB_H -#define PICRIN_LIB_H - -#if defined(__cplusplus) -extern "C" { -#endif - -struct pic_lib { - PIC_OBJECT_HEADER - pic_value name; - struct pic_env *env; - struct pic_dict *exports; -}; - -#define pic_lib_p(o) (pic_type(o) == PIC_TT_LIB) -#define pic_lib_ptr(o) ((struct pic_lib *)pic_ptr(o)) - -#if defined(__cplusplus) -} -#endif - -#endif diff --git a/extlib/benz/include/picrin/macro.h b/extlib/benz/include/picrin/macro.h index 8a79ecae..0d4c6a40 100644 --- a/extlib/benz/include/picrin/macro.h +++ b/extlib/benz/include/picrin/macro.h @@ -15,7 +15,7 @@ struct pic_env { PIC_OBJECT_HEADER khash_t(env) map; struct pic_env *up; - struct pic_string *prefix; + struct pic_string *lib; }; #define pic_env_p(v) (pic_type(v) == PIC_TT_ENV) diff --git a/extlib/benz/include/picrin/state.h b/extlib/benz/include/picrin/state.h index 1778b8ed..c5590788 100644 --- a/extlib/benz/include/picrin/state.h +++ b/extlib/benz/include/picrin/state.h @@ -16,7 +16,11 @@ extern "C" { #include "picrin/read.h" #include "picrin/gc.h" -KHASH_DECLARE(oblist, struct pic_string *, pic_sym *) +struct pic_lib { + struct pic_string *name; + struct pic_env *env; + struct pic_dict *exports; +}; typedef struct pic_checkpoint { PIC_OBJECT_HEADER @@ -37,6 +41,9 @@ typedef struct { struct pic_context *up; } pic_callinfo; +KHASH_DECLARE(oblist, struct pic_string *, pic_sym *) +KHASH_DECLARE(ltable, const char *, struct pic_lib) + struct pic_state { pic_allocf allocf; void *userdata; @@ -68,16 +75,13 @@ struct pic_state { pic_sym *sCONS, *sCAR, *sCDR, *sNILP, *sSYMBOLP, *sPAIRP; pic_sym *sADD, *sSUB, *sMUL, *sDIV, *sEQ, *sLT, *sLE, *sGT, *sGE, *sNOT; - struct pic_lib *PICRIN_BASE; - struct pic_lib *PICRIN_USER; - pic_value features; khash_t(oblist) oblist; /* string to symbol */ int ucnt; struct pic_weak *globals; struct pic_weak *macros; - pic_value libs; + khash_t(ltable) ltable; struct pic_list ireps; /* chain */ pic_reader reader; diff --git a/extlib/benz/include/picrin/type.h b/extlib/benz/include/picrin/type.h index 25bc9a4c..de8e174f 100644 --- a/extlib/benz/include/picrin/type.h +++ b/extlib/benz/include/picrin/type.h @@ -169,7 +169,6 @@ enum pic_tt { PIC_TT_ERROR, PIC_TT_ID, PIC_TT_ENV, - PIC_TT_LIB, PIC_TT_DATA, PIC_TT_DICT, PIC_TT_WEAK, @@ -197,7 +196,6 @@ struct pic_proc; struct pic_port; struct pic_error; struct pic_env; -struct pic_lib; /* set aliases to basic types */ typedef struct pic_symbol pic_sym; @@ -298,8 +296,6 @@ pic_type_repr(enum pic_tt tt) return "proc"; case PIC_TT_ENV: return "env"; - case PIC_TT_LIB: - return "lib"; case PIC_TT_DATA: return "data"; case PIC_TT_DICT: diff --git a/extlib/benz/lib.c b/extlib/benz/lib.c index deae6cab..ffccffd0 100644 --- a/extlib/benz/lib.c +++ b/extlib/benz/lib.c @@ -4,22 +4,38 @@ #include "picrin.h" +KHASH_DEFINE(ltable, const char *, struct pic_lib, kh_str_hash_func, kh_str_cmp_func) + +static struct pic_lib * +get_library_opt(pic_state *pic, const char *lib) +{ + khash_t(ltable) *h = &pic->ltable; + khiter_t it; + + it = kh_get(ltable, h, lib); + if (it == kh_end(h)) { + return NULL; + } + return &kh_val(h, it); +} + +static struct pic_lib * +get_library(pic_state *pic, const char *lib) +{ + struct pic_lib *libp; + + if ((libp = get_library_opt(pic, lib)) == NULL) { + pic_errorf(pic, "library not found: %s", lib); + } + return libp; +} + static struct pic_env * -make_library_env(pic_state *pic, pic_value name) +make_library_env(pic_state *pic, struct pic_string *name) { struct pic_env *env; - pic_value dir, it; - struct pic_string *prefix = NULL; - pic_for_each (dir, name, it) { - if (prefix == NULL) { - prefix = pic_format(pic, "~a", dir); - } else { - prefix = pic_format(pic, "~a.~a", pic_obj_value(prefix), dir); - } - } - - env = pic_make_topenv(pic, prefix); + env = pic_make_topenv(pic, name); /* set up default environment */ pic_put_identifier(pic, (pic_id *)pic->sDEFINE_LIBRARY, pic->sDEFINE_LIBRARY, env); @@ -30,64 +46,76 @@ make_library_env(pic_state *pic, pic_value name) return env; } -struct pic_lib * -pic_make_library(pic_state *pic, pic_value name) +void +pic_make_library(pic_state *pic, const char *lib) { - struct pic_lib *lib; + khash_t(ltable) *h = &pic->ltable; + const char *old_lib; + struct pic_string *name; struct pic_env *env; struct pic_dict *exports; + khiter_t it; + int ret; - if ((lib = pic_find_library(pic, name)) != NULL) { - pic_errorf(pic, "library name already in use: ~s", name); + if (pic->lib) { + old_lib = pic_current_library(pic); } + name = pic_make_cstr(pic, lib); env = make_library_env(pic, name); exports = pic_make_dict(pic); - lib = (struct pic_lib *)pic_obj_alloc(pic, sizeof(struct pic_lib), PIC_TT_LIB); - lib->name = name; - lib->env = env; - lib->exports = exports; + it = kh_put(ltable, h, pic_str_cstr(pic, name), &ret); + if (ret == 0) { /* if exists */ + pic_errorf(pic, "library name already in use: %s", lib); + } - /* register! */ - pic->libs = pic_acons(pic, name, pic_obj_value(lib), pic->libs); + kh_val(h, it).name = name; + kh_val(h, it).env = env; + kh_val(h, it).exports = exports; - return lib; + if (pic->lib) { + pic->lib = get_library(pic, old_lib); /* ltable might be rehashed */ + } } void -pic_in_library(pic_state *pic, pic_value name) +pic_in_library(pic_state *pic, const char *lib) { - struct pic_lib *lib; - - if ((lib = pic_find_library(pic, name)) == NULL) { - pic_errorf(pic, "library not found ~s", name); - } - pic->lib = lib; + pic->lib = get_library(pic, lib); } -struct pic_lib * -pic_find_library(pic_state *pic, pic_value spec) +bool +pic_find_library(pic_state *pic, const char *lib) { - pic_value v; + return get_library_opt(pic, lib) != NULL; +} - v = pic_assoc(pic, spec, pic->libs, NULL); - if (pic_false_p(v)) { - return NULL; - } - return pic_lib_ptr(pic_cdr(pic, v)); +const char * +pic_current_library(pic_state *pic) +{ + return pic_str_cstr(pic, pic->lib->name); +} + +struct pic_env * +pic_library_environment(pic_state *pic, const char *lib) +{ + return get_library(pic, lib)->env; } void -pic_import(pic_state *pic, struct pic_lib *lib) +pic_import(pic_state *pic, const char *lib) { pic_sym *name, *realname, *uid; khiter_t it; + struct pic_lib *libp; - pic_dict_for_each (name, lib->exports, it) { - realname = pic_sym_ptr(pic_dict_ref(pic, lib->exports, name)); + libp = get_library(pic, lib); - if ((uid = pic_find_identifier(pic, (pic_id *)realname, lib->env)) == NULL) { + pic_dict_for_each (name, libp->exports, it) { + realname = pic_sym_ptr(pic_dict_ref(pic, libp->exports, name)); + + if ((uid = pic_find_identifier(pic, (pic_id *)realname, libp->env)) == NULL) { pic_errorf(pic, "attempted to export undefined variable '~s'", pic_obj_value(realname)); } pic_put_identifier(pic, (pic_id *)name, uid, pic->lib->env); @@ -103,42 +131,38 @@ pic_export(pic_state *pic, pic_sym *name) static pic_value pic_lib_make_library(pic_state *pic) { - pic_value name; + const char *lib; - pic_get_args(pic, "o", &name); + pic_get_args(pic, "z", &lib); - return pic_obj_value(pic_make_library(pic, name)); + pic_make_library(pic, lib); + + return pic_undef_value(); } static pic_value pic_lib_find_library(pic_state *pic) { - pic_value name; - struct pic_lib *lib; + const char *lib; - pic_get_args(pic, "o", &name); + pic_get_args(pic, "z", &lib); - if ((lib = pic_find_library(pic, name)) == NULL) { - return pic_false_value(); - } - return pic_obj_value(lib); + return pic_bool_value(pic_find_library(pic, lib)); } static pic_value pic_lib_current_library(pic_state *pic) { - pic_value lib; + const char *lib; int n; - n = pic_get_args(pic, "|o", &lib); + n = pic_get_args(pic, "|z", &lib); if (n == 0) { - return pic_obj_value(pic->lib); + return pic_obj_value(pic->lib->name); } else { - pic_assert_type(pic, lib, lib); - - pic->lib = pic_lib_ptr(lib); + pic_in_library(pic, lib); return pic_undef_value(); } @@ -147,27 +171,25 @@ pic_lib_current_library(pic_state *pic) static pic_value pic_lib_library_import(pic_state *pic) { - pic_value lib_opt; + const char *lib; pic_sym *name, *realname, *uid, *alias = NULL; - struct pic_lib *lib; + struct pic_lib *libp; - pic_get_args(pic, "om|m", &lib_opt, &name, &alias); - - pic_assert_type(pic, lib_opt, lib); + pic_get_args(pic, "zm|m", &lib, &name, &alias); if (alias == NULL) { alias = name; } - lib = pic_lib_ptr(lib_opt); + libp = get_library(pic, lib); - if (! pic_dict_has(pic, lib->exports, name)) { + if (! pic_dict_has(pic, libp->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)); + realname = pic_sym_ptr(pic_dict_ref(pic, libp->exports, name)); } - if ((uid = pic_find_identifier(pic, (pic_id *)realname, lib->env)) == NULL) { + if ((uid = pic_find_identifier(pic, (pic_id *)realname, libp->env)) == NULL) { pic_errorf(pic, "attempted to export undefined variable '~s'", pic_obj_value(realname)); } else { pic_put_identifier(pic, (pic_id *)alias, uid, pic->lib->env); @@ -195,15 +217,17 @@ pic_lib_library_export(pic_state *pic) static pic_value pic_lib_library_exports(pic_state *pic) { - pic_value lib, exports = pic_nil_value(); + const char *lib; + pic_value exports = pic_nil_value(); pic_sym *sym; khiter_t it; + struct pic_lib *libp; - pic_get_args(pic, "o", &lib); + pic_get_args(pic, "z", &lib); - pic_assert_type(pic, lib, lib); + libp = get_library(pic, lib); - pic_dict_for_each (sym, pic_lib_ptr(lib)->exports, it) { + pic_dict_for_each (sym, libp->exports, it) { pic_push(pic, pic_obj_value(sym), exports); } @@ -213,13 +237,11 @@ pic_lib_library_exports(pic_state *pic) static pic_value pic_lib_library_environment(pic_state *pic) { - pic_value lib; + const char *lib; - pic_get_args(pic, "o", &lib); + pic_get_args(pic, "z", &lib); - pic_assert_type(pic, lib, lib); - - return pic_obj_value(pic_lib_ptr(lib)->env); + return pic_obj_value(get_library(pic, lib)->env); } void diff --git a/extlib/benz/load.c b/extlib/benz/load.c index e07b70d3..f58ce1be 100644 --- a/extlib/benz/load.c +++ b/extlib/benz/load.c @@ -11,7 +11,7 @@ pic_load(pic_state *pic, struct pic_port *port) size_t ai = pic_gc_arena_preserve(pic); while (! pic_eof_p(form = pic_read(pic, port))) { - pic_eval(pic, form, pic->lib); + pic_eval(pic, form, pic_current_library(pic)); pic_gc_arena_restore(pic, ai); } diff --git a/extlib/benz/macro.c b/extlib/benz/macro.c index 17cad2c2..50a6b9ac 100644 --- a/extlib/benz/macro.c +++ b/extlib/benz/macro.c @@ -15,19 +15,19 @@ pic_make_env(pic_state *pic, struct pic_env *up) env = (struct pic_env *)pic_obj_alloc(pic, sizeof(struct pic_env), PIC_TT_ENV); env->up = up; - env->prefix = NULL; + env->lib = NULL; kh_init(env, &env->map); return env; } struct pic_env * -pic_make_topenv(pic_state *pic, struct pic_string *prefix) +pic_make_topenv(pic_state *pic, struct pic_string *lib) { struct pic_env *env; env = (struct pic_env *)pic_obj_alloc(pic, sizeof(struct pic_env), PIC_TT_ENV); env->up = NULL; - env->prefix = prefix; + env->lib = lib; kh_init(env, &env->map); return env; } @@ -42,7 +42,7 @@ pic_add_identifier(pic_state *pic, pic_id *id, struct pic_env *env) name = pic_identifier_name(pic, id); if (env->up == NULL && pic_sym_p(pic_obj_value(id))) { /* toplevel & public */ - str = pic_format(pic, "%s/%s", pic_str_cstr(pic, env->prefix), name); + str = pic_format(pic, "%s/%s", pic_str_cstr(pic, env->lib), name); } else { str = pic_format(pic, ".%s.%d", name, pic->ucnt++); } diff --git a/extlib/benz/port.c b/extlib/benz/port.c index 1cad0ed8..ed92381b 100644 --- a/extlib/benz/port.c +++ b/extlib/benz/port.c @@ -172,7 +172,7 @@ pic_define_standard_port(pic_state *pic, const char *name, xFILE *file, int dir) { \ pic_value obj; \ \ - obj = pic_funcall(pic, pic->PICRIN_BASE, var, 0); \ + obj = pic_funcall(pic, "picrin.base", var, 0); \ \ return pic_port_ptr(obj); \ } diff --git a/extlib/benz/proc.c b/extlib/benz/proc.c index 55a770eb..4fc209ca 100644 --- a/extlib/benz/proc.c +++ b/extlib/benz/proc.c @@ -856,14 +856,30 @@ pic_vlambda(pic_state *pic, pic_func_t f, int n, va_list ap) } void -pic_define(pic_state *pic, struct pic_lib *lib, const char *name, pic_value val) +pic_defun(pic_state *pic, const char *name, pic_func_t f) +{ + pic_define(pic, pic_current_library(pic), name, pic_obj_value(pic_make_proc(pic, f, 0, NULL))); + pic_export(pic, pic_intern_cstr(pic, name)); +} + +void +pic_defvar(pic_state *pic, const char *name, pic_value init, struct pic_proc *conv) +{ + pic_define(pic, pic_current_library(pic), name, pic_obj_value(pic_make_var(pic, init, conv))); + pic_export(pic, pic_intern_cstr(pic, name)); +} + +void +pic_define(pic_state *pic, const char *lib, const char *name, pic_value val) { pic_sym *sym, *uid; + struct pic_env *env; sym = pic_intern_cstr(pic, name); - if ((uid = pic_find_identifier(pic, (pic_id *)sym, lib->env)) == NULL) { - uid = pic_add_identifier(pic, (pic_id *)sym, lib->env); + env = pic_library_environment(pic, lib); + if ((uid = pic_find_identifier(pic, (pic_id *)sym, env)) == NULL) { + uid = pic_add_identifier(pic, (pic_id *)sym, env); } else { if (pic_weak_has(pic, pic->globals, uid)) { pic_warnf(pic, "redefining variable: ~s", pic_obj_value(uid)); @@ -873,43 +889,33 @@ pic_define(pic_state *pic, struct pic_lib *lib, const char *name, pic_value val) pic_set(pic, lib, name, val); } -void -pic_defun(pic_state *pic, const char *name, pic_func_t f) -{ - pic_define(pic, pic->lib, name, pic_obj_value(pic_make_proc(pic, f, 0, NULL))); - pic_export(pic, pic_intern_cstr(pic, name)); -} - -void -pic_defvar(pic_state *pic, const char *name, pic_value init, struct pic_proc *conv) -{ - pic_define(pic, pic->lib, name, pic_obj_value(pic_make_var(pic, init, conv))); - pic_export(pic, pic_intern_cstr(pic, name)); -} - pic_value -pic_ref(pic_state *pic, struct pic_lib *lib, const char *name) +pic_ref(pic_state *pic, const char *lib, const char *name) { pic_sym *sym, *uid; + struct pic_env *env; sym = pic_intern_cstr(pic, name); - if ((uid = pic_find_identifier(pic, (pic_id *)sym, lib->env)) == NULL) { - pic_errorf(pic, "symbol \"%s\" not defined in library ~s", name, lib->name); + env = pic_library_environment(pic, lib); + if ((uid = pic_find_identifier(pic, (pic_id *)sym, env)) == NULL) { + pic_errorf(pic, "symbol \"%s\" not defined in library %s", name, lib); } return vm_gref(pic, uid); } void -pic_set(pic_state *pic, struct pic_lib *lib, const char *name, pic_value val) +pic_set(pic_state *pic, const char *lib, const char *name, pic_value val) { pic_sym *sym, *uid; + struct pic_env *env; sym = pic_intern_cstr(pic, name); - if ((uid = pic_find_identifier(pic, (pic_id *)sym, lib->env)) == NULL) { - pic_errorf(pic, "symbol \"%s\" not defined in library ~s", name, lib->name); + env = pic_library_environment(pic, lib); + if ((uid = pic_find_identifier(pic, (pic_id *)sym, env)) == NULL) { + pic_errorf(pic, "symbol \"%s\" not defined in library %s", name, lib); } vm_gset(pic, uid, val); @@ -946,7 +952,7 @@ pic_closure_set(pic_state *pic, int n, pic_value v) } pic_value -pic_funcall(pic_state *pic, struct pic_lib *lib, const char *name, int n, ...) +pic_funcall(pic_state *pic, const char *lib, const char *name, int n, ...) { pic_value proc, r; va_list ap; diff --git a/extlib/benz/state.c b/extlib/benz/state.c index c3ce33b3..72c0604c 100644 --- a/extlib/benz/state.c +++ b/extlib/benz/state.c @@ -120,7 +120,7 @@ pic_init_core(pic_state *pic) pic_init_features(pic); - pic_deflibrary(pic, "(picrin base)"); + pic_deflibrary(pic, "picrin.base"); ai = pic_gc_arena_preserve(pic); @@ -268,7 +268,7 @@ pic_open(pic_allocf allocf, void *userdata) pic->features = pic_nil_value(); /* libraries */ - pic->libs = pic_nil_value(); + kh_init(ltable, &pic->ltable); pic->lib = NULL; /* ireps */ @@ -346,9 +346,8 @@ pic_open(pic_allocf allocf, void *userdata) pic->ptable = pic_cons(pic, pic_obj_value(pic_make_weak(pic)), pic->ptable); /* standard libraries */ - 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->lib = pic->PICRIN_USER; + pic_make_library(pic, "picrin.user"); + pic_in_library(pic, "picrin.user"); pic_gc_arena_restore(pic, ai); @@ -376,7 +375,6 @@ pic_open(pic_allocf allocf, void *userdata) void pic_close(pic_state *pic) { - khash_t(oblist) *h = &pic->oblist; pic_allocf allocf = pic->allocf; /* clear out root objects */ @@ -388,7 +386,9 @@ pic_close(pic_state *pic) pic->globals = NULL; pic->macros = NULL; pic->features = pic_nil_value(); - pic->libs = pic_nil_value(); + + /* free all libraries */ + kh_clear(ltable, &pic->ltable); /* free all heap objects */ pic_gc(pic); @@ -420,7 +420,8 @@ pic_close(pic_state *pic) allocf(pic->userdata, pic->xpbase, 0); /* free global stacks */ - kh_destroy(oblist, h); + kh_destroy(oblist, &pic->oblist); + kh_destroy(ltable, &pic->ltable); /* free GC arena */ allocf(pic->userdata, pic->arena, 0); diff --git a/extlib/benz/string.c b/extlib/benz/string.c index c838fa6a..0a836f24 100644 --- a/extlib/benz/string.c +++ b/extlib/benz/string.c @@ -578,7 +578,7 @@ pic_str_string_map(pic_state *pic) for (j = 0; j < argc; ++j) { pic_push(pic, pic_char_value(pic_str_ref(pic, pic_str_ptr(argv[j]), i)), vals); } - val = pic_funcall(pic, pic->PICRIN_BASE, "apply", 2, pic_obj_value(proc), vals); + val = pic_funcall(pic, "picrin.base", "apply", 2, pic_obj_value(proc), vals); pic_assert_type(pic, val, char); buf[i] = pic_char(val); @@ -623,7 +623,7 @@ pic_str_string_for_each(pic_state *pic) for (j = 0; j < argc; ++j) { pic_push(pic, pic_char_value(pic_str_ref(pic, pic_str_ptr(argv[j]), i)), vals); } - pic_funcall(pic, pic->PICRIN_BASE, "apply", 2, pic_obj_value(proc), vals); + pic_funcall(pic, "picrin.base", "apply", 2, pic_obj_value(proc), vals); } return pic_undef_value(); diff --git a/extlib/benz/vector.c b/extlib/benz/vector.c index 582c9d63..4e986ae3 100644 --- a/extlib/benz/vector.c +++ b/extlib/benz/vector.c @@ -240,7 +240,7 @@ pic_vec_vector_map(pic_state *pic) for (j = 0; j < argc; ++j) { pic_push(pic, pic_vec_ptr(argv[j])->data[i], vals); } - vec->data[i] = pic_funcall(pic, pic->PICRIN_BASE, "apply", 2, pic_obj_value(proc), vals); + vec->data[i] = pic_funcall(pic, "picrin.base", "apply", 2, pic_obj_value(proc), vals); } return pic_obj_value(vec); @@ -269,7 +269,7 @@ pic_vec_vector_for_each(pic_state *pic) for (j = 0; j < argc; ++j) { pic_push(pic, pic_vec_ptr(argv[j])->data[i], vals); } - pic_funcall(pic, pic->PICRIN_BASE, "apply", 2, pic_obj_value(proc), vals); + pic_funcall(pic, "picrin.base", "apply", 2, pic_obj_value(proc), vals); } return pic_undef_value(); diff --git a/src/main.c b/src/main.c index 5168b502..35d627dd 100644 --- a/src/main.c +++ b/src/main.c @@ -22,7 +22,6 @@ int main(int argc, char *argv[], char **envp) { pic_state *pic; - struct pic_lib *PICRIN_MAIN; int status; pic = pic_open(pic_default_allocf, NULL); @@ -34,9 +33,7 @@ main(int argc, char *argv[], char **envp) pic_try { pic_init_picrin(pic); - PICRIN_MAIN = pic_find_library(pic, pic_read_cstr(pic, "(picrin main)")); - - pic_funcall(pic, PICRIN_MAIN, "main", 0); + pic_funcall(pic, "picrin.main", "main", 0); status = 0; }