The big renaming to define-library in .sld, make it possible to pass

other version numbers than 7 to `scheme-report-environment`, providing
initial (scheme base) library.

doc/chibi-scheme.1

@@ -25,6 +25,12 @@ chibi-scheme \- a tiny Scheme interpreter
 [-p
 .I expr
 ]
+[-d
+.I image-file
+]
+[-i
+.I image-file
+]
 [--]
 [
 .I script argument ...
@@ -116,6 +122,17 @@ Evaluates the Scheme expression
 Evaluates the Scheme expression
 .I expr
 then prints the result to stdout.
+.TP
+.BI -d image-file
+Dumps the current Scheme heap to
+.I image-file
+and exits.  This feature is still experimental.
+.TP
+.BI -i image-file
+Loads the Scheme heap from
+.I image-file
+instead of compiling the init file on the fly.
+This feature is still experimental.
 
 .SH ENVIRONMENT
 .TP

doc/chibi.scrbl

@@ -409,7 +409,7 @@ core forms: @scheme{define}, @scheme{set!}, @scheme{lambda}, @scheme{if},
 @p{
 Loads the standard parameters for @var{env}, constructs the feature list from
 pre-compiled defaults, and loads the installed initialization file for
-@var{version}, which currently should be the value @var{SEXP_SEVEN}.
+@var{version}, which should be the value @var{SEXP_SEVEN}.
 Also creates an @scheme{interaction-environment} parameter
 and sets @var{env} itself to that.
 }}

eval.c

@@ -1885,6 +1885,8 @@ sexp sexp_load_standard_ports (sexp ctx, sexp env, FILE* in, FILE* out,
 }
 
 sexp sexp_load_standard_env (sexp ctx, sexp e, sexp version) {
+  int len;
+  char init_file[128];
   sexp_gc_var3(op, tmp, sym);
   sexp_gc_preserve3(ctx, op, tmp, sym);
   if (!e) e = sexp_context_env(ctx);
@@ -1930,18 +1932,23 @@ sexp sexp_load_standard_env (sexp ctx, sexp e, sexp version) {
   sexp_global(ctx, SEXP_G_ERR_HANDLER)
     = sexp_env_ref(e, sym=sexp_intern(ctx, "current-exception-handler", -1), SEXP_FALSE);
   /* load init.scm */
-  tmp = sexp_load_module_file(ctx, sexp_init_file, e);
+  len = strlen(sexp_init_file);
+  strncpy(init_file, sexp_init_file, len);
+  init_file[len] = sexp_unbox_fixnum(version) + '0';
+  strncpy(init_file + len + 1, sexp_init_file_suffix, strlen(sexp_init_file_suffix));
+  init_file[len + 1 + strlen(sexp_init_file_suffix)] = 0;
+  tmp = sexp_load_module_file(ctx, init_file, e);
   sexp_set_parameter(ctx, e, sexp_global(ctx, SEXP_G_INTERACTION_ENV_SYMBOL), e);
   /* load and bind config env */
 #if SEXP_USE_MODULES
   if (! sexp_exceptionp(tmp)) {
-    sym = sexp_intern(ctx, "*config-env*", -1);
+    sym = sexp_intern(ctx, "*meta-env*", -1);
-    if (! sexp_envp(tmp=sexp_global(ctx, SEXP_G_CONFIG_ENV))) {
+    if (! sexp_envp(tmp=sexp_global(ctx, SEXP_G_META_ENV))) {
       tmp = sexp_make_env(ctx);
       if (! sexp_exceptionp(tmp)) {
-        sexp_global(ctx, SEXP_G_CONFIG_ENV) = tmp;
+        sexp_global(ctx, SEXP_G_META_ENV) = tmp;
         sexp_env_parent(tmp) = e;
-        op = sexp_load_module_file(ctx, sexp_config_file, tmp);
+        op = sexp_load_module_file(ctx, sexp_meta_file, tmp);
         if (sexp_exceptionp(op))
           sexp_print_exception(ctx, op, sexp_current_error_port(ctx));
         sexp_env_define(ctx, tmp, sym, tmp);

include/chibi/eval.h

@@ -1,5 +1,5 @@
 /*  eval.h -- headers for eval library                        */
-/*  Copyright (c) 2009-2010 Alex Shinn.  All rights reserved. */
+/*  Copyright (c) 2009-2011 Alex Shinn.  All rights reserved. */
 /*  BSD-style license: http://synthcode.com/license.txt       */
 
 #ifndef SEXP_EVAL_H
@@ -13,8 +13,9 @@ extern "C" {
 
 /************************* additional types ***************************/
 
-#define sexp_init_file "init.scm"
+#define sexp_init_file "init-"
-#define sexp_config_file "config.scm"
+#define sexp_init_file_suffix ".scm"
+#define sexp_meta_file "meta.scm"
 
 enum sexp_core_form_names {
   SEXP_CORE_DEFINE = 1,

include/chibi/sexp.h

@@ -1018,7 +1018,7 @@ enum sexp_context_globals {
   SEXP_G_OOS_ERROR,             /* out of stack exception object */
   SEXP_G_OPTIMIZATIONS,
   SEXP_G_SIGNAL_HANDLERS,
-  SEXP_G_CONFIG_ENV,
+  SEXP_G_META_ENV,
   SEXP_G_MODULE_PATH,
   SEXP_G_QUOTE_SYMBOL,
   SEXP_G_QUASIQUOTE_SYMBOL,

lib/chibi/ast.sld

@@ -1,5 +1,5 @@
 
-(module (chibi ast)
+(define-library (chibi ast)
   (export
    analyze optimize env-cell ast->sexp macroexpand type-of
    Object Opcode Procedure Bytecode Macro Env

lib/chibi/base64.sld

@@ -1,5 +1,5 @@
 
-(module (chibi base64)
+(define-library (chibi base64)
   (export base64-encode base64-encode-string
           base64-decode base64-decode-string
           base64-encode-header)

lib/chibi/disasm.sld

@@ -4,7 +4,7 @@
 ;;> Write a human-readable disassembly for the procedure @var{f} to
 ;;> the port @var{out}, defaulting to @scheme{(current-output-port)}.
 
-(module (chibi disasm)
+(define-library (chibi disasm)
   (export disasm)
   (import (scheme))
   (include-shared "disasm"))

lib/chibi/equiv.sld

@@ -1,5 +1,5 @@
 
-(module (chibi equiv)
+(define-library (chibi equiv)
   (export equiv?)
   (import (scheme))
   (import (srfi 69))

lib/chibi/filesystem.sld

@@ -4,7 +4,7 @@
 ;;> integers, but may be replaced with opaque (and gc-managed)
 ;;> objects in a future release.
 
-(module (chibi filesystem)
+(define-library (chibi filesystem)
   (export open-input-file-descriptor open-output-file-descriptor
           duplicate-file-descriptor duplicate-file-descriptor-to
           close-file-descriptor renumber-file-descriptor

lib/chibi/generic.sld

@@ -1,7 +1,7 @@
 
 ;;> Simple generic function interface.
 
-(module (chibi generic)
+(define-library (chibi generic)
   (export define-generic define-method make-generic generic-add!)
   (import (scheme))
   (include "generic.scm"))

lib/chibi/heap-stats.sld

@@ -18,7 +18,7 @@
 
 ;;> These functions just return @scheme{'()} when using the Boehm GC.
 
-(module (chibi heap-stats)
+(define-library (chibi heap-stats)
   (export heap-stats heap-dump)
   (import (scheme))
   (include-shared "heap-stats"))

lib/chibi/highlight.sld

@@ -1,5 +1,5 @@
 
-(module (chibi highlight)
+(define-library (chibi highlight)
   (export highlight highlight-detect-language highlighter-for highlight-style
           highlight-scheme highlight-c highlight-assembly)
   (import (scheme) (srfi 1) (chibi io))

lib/chibi/io.sld

@@ -1,5 +1,5 @@
 
-(module (chibi io)
+(define-library (chibi io)
   (export read-string read-string! write-string read-line write-line
           port-fold port-fold-right port-map
           port->list port->string-list port->sexp-list port->string

lib/chibi/loop.sld

@@ -1,5 +1,5 @@
 
-(module (chibi loop)
+(define-library (chibi loop)
   (export loop in-list in-lists in-port in-file up-from down-from
           listing listing-reverse appending appending-reverse
           summing multiplying in-string in-string-reverse

lib/chibi/match.sld

@@ -1,5 +1,5 @@
 
-(module (chibi match)
+(define-library (chibi match)
   (export match match-lambda match-lambda* match-let match-letrec match-let*)
   (import (scheme))
   (include "match/match.scm"))

lib/chibi/mime.sld

@@ -1,5 +1,5 @@
 
-(define-module (chibi mime)
+(define-library (chibi mime)
   (export mime-ref assoc-ref mime-header-fold mime-headers->list
           mime-parse-content-type mime-decode-header
           mime-message-fold mime-message->sxml)

lib/chibi/modules.sld

@@ -1,9 +1,8 @@
 
-(module (chibi modules)
+(define-library (chibi modules)
   (export module-name module-dir module-includes module-shared-includes
           module-ast module-ast-set! module-ref module-contains?
           analyze-module containing-module load-module module-exports
           module-name->file procedure-analysis)
-  (import (scheme) (config))
+  (import (scheme) (config) (chibi ast))
-  (import (chibi ast))
   (include "modules.scm"))

lib/chibi/net.sld

@@ -1,5 +1,5 @@
 
-(module (chibi net)
+(define-library (chibi net)
   (export sockaddr? address-info? get-address-info make-address-info
           socket connect bind accept listen
           with-net-io open-net-io
@@ -8,8 +8,6 @@
           address-family/unix address-family/inet
           socket-type/stream socket-type/datagram socket-type/raw
           ip-proto/tcp ip-proto/udp)
-  (import (scheme))
+  (import (scheme) (chibi filesystem))
-  (import (chibi filesystem))
   (include-shared "net")
   (include "net.scm"))
-

lib/chibi/optimize.sld

@@ -1,5 +1,5 @@
 
-(module (chibi optimize)
+(define-library (chibi optimize)
   (import (scheme) (chibi ast) (chibi match) (srfi 1))
   (export register-lambda-optimization!
           replace-references

lib/chibi/optimize/profile.sld

@@ -1,5 +1,5 @@
 
-(module (chibi optimize profile)
+(define-library (chibi optimize profile)
   (export optimize-profile increment-cdr! profile-reset profile-report)
   (import (scheme) (srfi 1) (srfi 69) (srfi 95)
           (chibi ast) (chibi match) (chibi optimize))

lib/chibi/optimize/rest.sld

@@ -1,5 +1,5 @@
 
-(module (chibi optimize rest)
+(define-library (chibi optimize rest)
   (export optimize-rest rest-parameter-cdrs num-parameters local-ref)
   (import (scheme) (srfi 1) (chibi ast) (chibi match) (chibi optimize))
   (include-shared "rest")

lib/chibi/pathname.sld

@@ -1,5 +1,5 @@
 
-(module (chibi pathname)
+(define-library (chibi pathname)
   (export path-strip-directory path-directory ;; path-extension-pos
           path-extension path-strip-extension path-replace-extension
           path-absolute? path-relative? path-normalize make-path)

lib/chibi/process.sld

@@ -1,5 +1,5 @@
 
-(module (chibi process)
+(define-library (chibi process)
   (export exit sleep alarm fork kill execute waitpid system
           process-command-line  process-running?
           set-signal-action! make-signal-set signal-set-contains?
@@ -32,7 +32,8 @@
           (with-exception-handler
            (lambda (exn) (return #f))
            (lambda ()
-             (let ((file (string-append "/proc/" (number->string pid) "/cmdline")))
+             (let ((file
+                    (string-append "/proc/" (number->string pid) "/cmdline")))
                (call-with-input-file file
                  (lambda (in)
                    (let lp ((arg '()) (res '()))
@@ -40,7 +41,8 @@
                        (if (or (eof-object? ch) (eqv? (char->integer ch) 0))
                            (let ((res (cons (list->string (reverse arg)) res))
                                  (ch2 (peek-char in)))
-                             (if (or (eof-object? ch2) (eqv? (char->integer ch2) 0))
+                             (if (or (eof-object? ch2)
+                                     (eqv? (char->integer ch2) 0))
                                  (reverse res)
                                  (lp '() res)))
                            (lp (cons ch arg) res)))))))))))))))
@@ -51,4 +53,3 @@
             (or (null? o)
                 (not (car o))
                 (equal? (car o) (car cmdline))))))))
-

lib/chibi/quoted-printable.sld

@@ -1,5 +1,5 @@
 
-(module (chibi quoted-printable)
+(define-library (chibi quoted-printable)
   (export quoted-printable-encode quoted-printable-encode-string
           quoted-printable-encode-header
           quoted-printable-decode quoted-printable-decode-string)

lib/chibi/repl.module

@@ -1,12 +0,0 @@
-
-(module (chibi repl)
-  (export repl)
-  (import (scheme))
-  (import (chibi ast)
-          (chibi io)
-          (chibi process)
-          (chibi term edit-line)
-          (srfi 18)
-          (srfi 38)
-          (srfi 98))
-  (include "repl.scm"))

lib/chibi/repl.sld

@@ -0,0 +1,7 @@
+
+(define-library (chibi repl)
+  (export repl)
+  (import (scheme)
+          (chibi ast) (chibi io) (chibi process) (chibi term edit-line)
+          (srfi 18) (srfi 38) (srfi 98))
+  (include "repl.scm"))

lib/chibi/scribble.sld

@@ -1,5 +1,5 @@
 
-(module (chibi scribble)
+(define-library (chibi scribble)
   (export scribble-parse scribble-read)
   (import (scheme))
   (include "scribble.scm"))

lib/chibi/stty.sld

@@ -1,9 +1,8 @@
 
-(module (chibi stty)
+(define-library (chibi stty)
   (export stty with-stty with-raw-io
           get-terminal-width get-terminal-dimensions
           TCSANOW TCSADRAIN TCSAFLUSH)
   (import (scheme) (srfi 33) (srfi 69))
   (include-shared "stty")
   (include "stty.scm"))
-

lib/chibi/system.sld

@@ -1,5 +1,5 @@
 
-(module (chibi system)
+(define-library (chibi system)
   (export user-information user? user-name user-password
           user-id user-group-id user-gecos user-home user-shell
           current-user-id current-group-id

lib/chibi/test.sld

@@ -1,5 +1,5 @@
 
-(module (chibi test)
+(define-library (chibi test)
   (export
    test test-error test-assert test-not test-values
    test-group current-test-group

lib/chibi/time.sld

@@ -1,5 +1,5 @@
 
-(module (chibi time)
+(define-library (chibi time)
   (export current-seconds get-time-of-day set-time-of-day!
           seconds->time seconds->string time->seconds time->string
           make-timeval timeval-seconds timeval-microseconds
@@ -9,4 +9,3 @@
           tm? timeval? timezone?)
   (import (scheme))
   (include-shared "time"))
-

lib/chibi/type-inference.sld

@@ -1,5 +1,5 @@
 
-(define-module (chibi type-inference)
+(define-library (chibi type-inference)
   (export type-analyze-module type-analyze procedure-signature)
   (import (scheme) (srfi 1) (srfi 69) (chibi modules) (chibi ast) (chibi match))
   (include "type-inference.scm"))

lib/chibi/uri.sld

@@ -1,5 +1,5 @@
 
-(module (chibi uri)
+(define-library (chibi uri)
   (export uri? uri->string make-uri string->uri
           uri-scheme uri-user uri-host uri-port uri-path uri-query uri-fragment
           uri-with-scheme uri-with-user uri-with-host uri-with-path

lib/chibi/weak.sld

@@ -1,7 +1,7 @@
 
 ;;> Library for weak data structures.
 
-(module (chibi weak)
+(define-library (chibi weak)
   (export make-ephemeron ephemeron? ephemeron-broken?
           ephemeron-key ephemeron-value
           make-weak-vector weak-vector? weak-vector-length

lib/init-7.scm

@@ -99,7 +99,7 @@
         ((lambda (x) (if x x (anyn pred (map cdr lol))))
          (apply pred (map car lol)))
         #f))
-  (if (null? lol) (if (null? ls) #f (any1 pred ls)) (anyn pred (cons ls lol))))
+  (if (null? lol) (if (pair? ls) (any1 pred ls) #f) (anyn pred (cons ls lol))))
 
 (define (every pred ls . lol)
   (define (every1 pred ls)
@@ -107,7 +107,7 @@
         (pred (car ls))
         (if (pred (car ls)) (every1 pred (cdr ls)) #f)))
   (if (null? lol)
-      (if (null? ls) #t (every1 pred ls))
+      (if (pair? ls) (every1 pred ls) #t)
       (not (apply any (lambda (x) (not (pred x))) ls lol))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -204,7 +204,8 @@
           ((compare (rename 'quasiquote) (car x))
            (list (rename 'list) (list (rename 'quote) 'quasiquote)
                  (qq (cadr x) (+ d 1))))
-          ((and (<= d 0) (pair? (car x)) (compare (rename 'unquote-splicing) (caar x)))
+          ((and (<= d 0) (pair? (car x))
+                (compare (rename 'unquote-splicing) (caar x)))
            (if (null? (cdr x))
                (cadar x)
                (list (rename 'append) (cadar x) (qq (cdr x) d))))
@@ -312,6 +313,21 @@
    (lambda (expr rename compare)
      `(,(rename 'make-promise) (,(rename 'lambda) () ,(cadr expr))))))
 
+(define-syntax define-auxiliary-syntax
+  (er-macro-transformer
+   (lambda (expr rename compare)
+     `(,(rename 'define-syntax) ,(cadr expr)
+       (,(rename 'er-macro-transformer)
+        (,(rename 'lambda) (expr rename compare)
+         (,(rename 'error) "invalid use of auxiliary syntax" ',(cadr expr))))))))
+
+(define-auxiliary-syntax _)
+(define-auxiliary-syntax =>)
+(define-auxiliary-syntax ...)
+(define-auxiliary-syntax else)
+(define-auxiliary-syntax unquote)
+(define-auxiliary-syntax unquote-splicing)
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; library functions
 
@@ -569,7 +585,8 @@
            (_len (rename'len))             (_length (rename 'length))
            (_- (rename '-))   (_>= (rename '>=))   (_error (rename 'error))
            (_ls (rename 'ls)) (_res (rename 'res)) (_i (rename 'i))
-           (_reverse (rename 'reverse))    (_vector->list (rename 'vector->list))
+           (_reverse (rename 'reverse))
+           (_vector->list (rename 'vector->list))
            (_list->vector (rename 'list->vector)))
        (define ellipsis (rename (if ellipsis-specified? (cadr expr) '...)))
        (define lits (if ellipsis-specified? (caddr expr) (cadr expr)))
@@ -596,7 +613,7 @@
                     (list _let (list (list p v)) (k (cons (cons p dim) vars)))))
                ((ellipsis? p)
                 (cond
-                 ((not (null? (cddr p)))
+                 ((not (null? (cdr (cdr p))))
                   (cond
                    ((any (lambda (x) (and (identifier? x) (compare x ellipsis)))
                          (cddr p))
@@ -610,7 +627,8 @@
                                              (,_i (,_- ,_len ,len))
                                              (,_res (,_quote ())))
                                   (,_if (,_>= 0 ,_i)
-                                      ,(lp `(,(cddr p) (,(car p) ,(car (cdr p))))
+                                      ,(lp `(,(cddr p) 
+                                             (,(car p) ,(car (cdr p))))
                                            `(,_cons ,_ls
                                                     (,_cons (,_reverse ,_res)
                                                             (,_quote ())))
@@ -824,7 +842,7 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; modules
 
-(define *config-env* #f)
+(define *meta-env* #f)
 
 (define-syntax import
   (er-macro-transformer
@@ -834,13 +852,13 @@
         ((null? ls)
          (cons 'begin (reverse res)))
         (else
-         (let ((mod+imps (eval `(resolve-import ',(car ls)) *config-env*)))
+         (let ((mod+imps (eval `(resolve-import ',(car ls)) *meta-env*)))
            (if (pair? mod+imps)
                (lp (cdr ls)
                    (cons `(%import
                            #f
                            (vector-ref
-                            (eval '(load-module ',(car mod+imps)) *config-env*)
+                            (eval '(load-module ',(car mod+imps)) *meta-env*)
                             1)
                            ',(cdr mod+imps)
                            #f)

lib/meta.scm

@@ -1,4 +1,4 @@
-;; config.scm -- configuration module
+;; meta.scm -- meta langauge for describing modules
 ;; Copyright (c) 2009-2011 Alex Shinn.  All rights reserved.
 ;; BSD-style license: http://synthcode.com/license.txt
 
@@ -11,7 +11,6 @@
 (define (%module-exports mod) (vector-ref mod 0))
 (define (module-env mod) (vector-ref mod 1))
 (define (module-meta-data mod) (vector-ref mod 2))
-(define (module-env-set! mod env) (vector-set! mod 1 env))
 
 (define (module-exports mod)
   (or (%module-exports mod) (env-exports (module-env mod))))
@@ -27,7 +26,7 @@
 
 (define (module-name->file name)
   (string-concatenate
-   (reverse (cons ".module" (cdr (module-name->strings name '()))))))
+   (reverse (cons ".sld" (cdr (module-name->strings name '()))))))
 
 (define (module-name-prefix name)
   (string-concatenate (reverse (cdr (cdr (module-name->strings name '()))))))
@@ -35,7 +34,7 @@
 (define (load-module-definition name)
   (let* ((file (module-name->file name))
          (path (find-module-file file)))
-    (if path (load path *config-env*))))
+    (if path (load path *meta-env*))))
 
 (define (find-module name)
   (cond
@@ -138,7 +137,7 @@
 (define (load-module name)
   (let ((mod (find-module name)))
     (if (and mod (not (module-env mod)))
-        (module-env-set! mod (eval-module name mod)))
+        (vector-set! mod 1 (eval-module name mod)))
     mod))
 
 (define define-library-transformer
@@ -167,7 +166,6 @@
           (set! *this-module* tmp))))))
 
 (define-syntax define-library define-library-transformer)
-(define-syntax define-module define-library-transformer)
 (define-syntax module define-library-transformer)
 
 (define-syntax define-config-primitive
@@ -193,7 +191,4 @@
         (cons '(config) (make-module #f (current-environment) '()))
         (cons '(srfi 0) (make-module (list 'cond-expand)
                                      (current-environment)
-                                     (list (list 'export 'cond-expand))))
+                                     (list (list 'export 'cond-expand))))))
-        (cons '(srfi 46) (make-module (list 'syntax-rules)
-                                      (current-environment)
-                                      (list (list 'export 'syntax-rules))))))

lib/scheme/base.sld

@@ -0,0 +1,45 @@
+
+(define-library (scheme base)
+  (import (except (scheme) equal?)
+          (rename (chibi equiv) (equiv? equal?))
+          (chibi io)
+          (srfi 9) (srfi 11) (srfi 38) (srfi 39))
+  (export
+   * + - ... / < <= = => > >= _ abs and append apply assoc assq assv begin
+   binary-port?  boolean?  bytevector-copy bytevector-copy!
+   bytevector-copy-partial bytevector-copy-partial!  bytevector-length
+   bytevector-u8-ref bytevector-u8-set!  bytevector?  caar cadr
+   call-with-current-continuation call-with-port call-with-values
+   call/cc car case cdddar cddddr cdr ceiling char->integer char-ready?
+   char<=?  char<?  char=?  char>=?  char>?  char?  close-input-port
+   close-output-port close-port complex?  cond cond-expand cons
+   current-error-port current-input-port current-output-port define
+   define-record-type define-syntax define-values denominator do
+   dynamic-wind else eof-object?  eq?  equal?  eqv?  error
+   error-object-irritants error-object-message error-object?  even?
+   exact->inexact exact-integer-sqrt exact-integer?  exact?  expt floor
+   flush-output-port for-each gcd get-output-bytevector get-output-string
+   guard if import inexact->exact inexact?  input-port?  integer->char
+   integer?  lambda lcm length let let* let*-values let-syntax let-values
+   letrec letrec* letrec-syntax list list->string list->vector list-copy
+   list-ref list-set!  list-tail list?  make-bytevector make-list
+   make-parameter make-string make-vector map max member memq memv min
+   modulo negative?  newline not null?  number->string number?  numerator
+   odd?  open-input-bytevector open-input-string open-output-bytevector
+   open-output-string or output-port?  pair?  parameterize peek-char
+   peek-u8 port-open?  port?  positive?  procedure?  quasiquote quote
+   quotient raise raise-continuable rational?  rationalize read-bytevector
+   read-bytevector!  read-char read-line read-u8 real?  remainder
+   reverse round set!  set-car!  set-cdr!  string string->list
+   string->number string->symbol string->utf8 string->vector string-append
+   string-copy string-fill!  string-for-each string-length string-map
+   string-ref string-set!  string<=?  string<?  string=?  string>=?
+   string>?  string?  substring symbol->string symbol?  syntax-error
+   syntax-rules textual-port?  truncate u8-ready?  unless unquote
+   unquote-splicing utf8->string values vector vector->list vector->string
+   vector-copy vector-fill!  vector-for-each vector-length vector-map
+   vector-ref vector-set!  vector?  when with-exception-handler
+   write-bytevector write-char write-partial-bytevector write-u8 zero?)
+  (include "define-values.scm"
+           "extras.scm"
+           "misc-macros.scm"))

lib/scheme/define-values.scm

@@ -0,0 +1,38 @@
+
+(define-syntax define-values
+  (syntax-rules ()
+    ((define-values () expr)
+     (define dummy
+       (call-with-values (lambda () expr)
+         (lambda args #f))))
+    ((define-values (var) expr)
+     (define var expr))
+    ((define-values (var0 var1 ... varn) expr)
+     (begin
+       (define var0
+         (call-with-values (lambda () expr) list))
+       (define var1
+         (let ((v (cadr var0)))
+           (set-cdr! var0 (cddr var0))
+           v))
+       ...
+       (define varn
+         (let ((v (cadr var0)))
+           (set! var0 (car var0))
+           v))))
+    ((define-values (var0 var1 ... . var-dot) expr)
+     (begin
+       (define var0
+         (call-with-values (lambda () expr) list))
+       (define var1
+         (let ((v (cadr var0)))
+           (set-cdr! var0 (cddr var0))
+           v))
+       ...
+       (define var-dot
+         (let ((v (cdr var0)))
+           (set! var0 (car var0))
+           v))))
+    ((define-values var expr)
+     (define var
+       (call-with-values (lambda () expr) list)))))

lib/scheme/extras.scm

@@ -0,0 +1,54 @@
+
+(define call/cc call-with-current-continuation)
+
+(define flush-output-port flush-output)
+
+(define (close-port port)
+  ((if (input-port? port) close-input-port close-output-port) port))
+
+(define (call-with-port port proc)
+  (let ((res (proc port)))
+    (close-port port)
+    res))
+
+(define (make-list n . o)
+  (let ((init (and (pair? o) (car o))))
+    (let lp ((i 0) (res '()))
+      (if (>= i n) res (lp (+ i 1) (cons init res))))))
+
+(define (list-copy ls)
+  (reverse (reverse ls)))
+
+(define (list-set! ls k x)
+  (cond ((null? ls) (error "invalid list index"))
+        ((zero? k) (set-car! ls x))
+        (else (list-set! ls (- k 1) x))))
+
+(define (vector-map proc vec . lov)
+  (if (null? lov)
+      (let lp ((i (vector-length vec)) (res '()))
+        (if (zero? i)
+            (list->vector res)
+            (lp (- i 1) (cons (proc (vector-ref vec i)) res))))
+      (list->vector (apply map proc (map vector->list (cons vec lov))))))
+
+(define (vector-for-each proc vec . lov)
+  (if (null? lov)
+      (let ((len (vector-length vec)))
+        (let lp ((i 0))
+          (cond ((< i len)
+                 (proc (vector-ref vec i))
+                 (lp (+ i 1))))))
+      (apply for-each proc (map vector->list (cons vec lov)))))
+
+(define (vector-copy vec)
+  (let* ((len (vector-length vec))
+         (res (make-vector len)))
+    (do ((i 0 (+ i 1))) ((>= i len) res)
+      (vector-set! res i (vector-ref vec i)))))
+
+(define (vector->string vec)
+  (list->string (vector->list vec)))
+
+(define (string->vector vec)
+  (list->vector (string->list vec)))

lib/scheme/misc-macros.scm

@@ -0,0 +1,10 @@
+
+(define-syntax when
+  (syntax-rules ()
+    ((when test . body)
+     (if test (begin . body)))))
+
+(define-syntax unless
+  (syntax-rules ()
+    ((unless test . body)
+     (when (not test) . body))))

lib/srfi/1.sld

@@ -1,5 +1,5 @@
 
-(module (srfi 1)
+(define-library (srfi 1)
   (export
    xcons cons* make-list list-tabulate list-copy circular-list iota
    proper-list? circular-list? dotted-list? not-pair? null-list? list=

lib/srfi/11.sld

@@ -1,5 +1,5 @@
 
-(module (srfi 11)
+(define-library (srfi 11)
   (export let-values let*-values)
   (import (scheme))
   (begin

lib/srfi/16.sld

@@ -1,5 +1,5 @@
 
-(module (srfi 16)
+(define-library (srfi 16)
   (export case-lambda)
   (import (scheme))
   (begin

lib/srfi/18.sld

@@ -1,5 +1,5 @@
 
-(module (srfi 18)
+(define-library (srfi 18)
   (export
    current-thread thread? make-thread thread-name
    thread-specific thread-specific-set! thread-start!

lib/srfi/2.sld

@@ -1,5 +1,5 @@
 
-(module (srfi 2)
+(define-library (srfi 2)
   (export and-let*)
   (import (scheme))
   (begin

lib/srfi/26.sld

@@ -1,5 +1,5 @@
 
-(module (srfi 26)
+(define-library (srfi 26)
   (export cut cute)
   (import (scheme))
   (begin

lib/srfi/27.sld

@@ -1,5 +1,5 @@
 
-(module (srfi 27)
+(define-library (srfi 27)
   (export random-integer random-real default-random-source
           make-random-source random-source?
           random-source-state-ref random-source-state-set!

lib/srfi/33.sld

@@ -1,5 +1,5 @@
 
-(module (srfi 33)
+(define-library (srfi 33)
   (export bitwise-not
           bitwise-and   bitwise-ior 
           bitwise-xor   bitwise-eqv

lib/srfi/38.sld

@@ -1,5 +1,5 @@
 
-(module (srfi 38)
+(define-library (srfi 38)
   (import (scheme))
   (export write-with-shared-structure write/ss
           read-with-shared-structure read/ss)

lib/srfi/39.sld

@@ -1,5 +1,5 @@
 
-(module (srfi 39)
+(define-library (srfi 39)
   (export make-parameter parameterize)
   (import (scheme))
   (include-shared "39/param")

lib/srfi/55.sld

@@ -1,5 +1,5 @@
 
-(module (srfi 55)
+(define-library (srfi 55)
   (export require-extension)
   (import (scheme))
   (begin

lib/srfi/6.sld

@@ -1,4 +1,4 @@
 
-(module (srfi 6)
+(define-library (srfi 6)
   (export open-input-string open-output-string get-output-string)
   (import (scheme)))

lib/srfi/69.sld

@@ -1,5 +1,5 @@
 
-(module (srfi 69)
+(define-library (srfi 69)
   (export
    make-hash-table hash-table? alist->hash-table
    hash-table-equivalence-function hash-table-hash-function

lib/srfi/8.sld

@@ -1,5 +1,5 @@
 
-(module (srfi 8)
+(define-library (srfi 8)
   (export receive)
   (import (scheme))
   (body

lib/srfi/9.sld

@@ -1,5 +1,5 @@
 
-(module (srfi 9)
+(define-library (srfi 9)
   (export define-record-type)
   (import (scheme))
   (include "9.scm"))

lib/srfi/95.sld

@@ -1,5 +1,5 @@
 
-(module (srfi 95)
+(define-library (srfi 95)
   (export sorted? merge merge! sort sort! object-cmp)
   (import (scheme))
   (include-shared "95/qsort")

lib/srfi/98.sld

@@ -1,4 +1,4 @@
 
-(module (srfi 98)
+(define-library (srfi 98)
   (export get-environment-variable get-environment-variables)
   (include-shared "98/env"))

lib/srfi/99.sld

@@ -1,5 +1,5 @@
 
-(module (srfi 99)
+(define-library (srfi 99)
   (import (srfi 99 records))
   (export make-rtd rtd? rtd-constructor rtd-predicate rtd-accessor rtd-mutator
           record? record-rtd rtd-name rtd-parent

lib/srfi/99/records.sld

@@ -1,5 +1,5 @@
 
-(module (srfi 99 records)
+(define-library (srfi 99 records)
   (import (srfi 99 records procedural)
           (srfi 99 records inspection)
           (srfi 99 records syntactic))

lib/srfi/99/records/inspection.sld

@@ -1,5 +1,5 @@
 
-(module (srfi 99 records inspection)
+(define-library (srfi 99 records inspection)
   (export record? record-rtd rtd-name rtd-parent
           rtd-field-names rtd-all-field-names rtd-field-mutable?)
   (import (scheme) (chibi ast))

lib/srfi/99/records/procedural.sld

@@ -1,5 +1,5 @@
 
-(module (srfi 99 records procedural)
+(define-library (srfi 99 records procedural)
   (export make-rtd rtd? rtd-constructor rtd-predicate rtd-accessor rtd-mutator)
   (import (scheme) (chibi ast) (srfi 99 records inspection))
   (include "procedural.scm"))

lib/srfi/99/records/syntactic.sld

@@ -1,5 +1,5 @@
 
-(module (srfi 99 records syntactic)
+(define-library (srfi 99 records syntactic)
   (export define-record-type)
   (import (scheme) (srfi 99 records inspection))
   (include "syntactic.scm"))