library is now a non-first-class object

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);
 }

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);

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))

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

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);

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);
 }

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);

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);

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);

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);
 }

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);

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);

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);

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);
 }

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))))))))))

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)

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,15 +596,21 @@ 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)
               (case (car spec)
                 ((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",
 "",
 ""
 };