Add definitions of standard libraries.

diff --git a/src/runtime/library-database.scm b/src/runtime/library-database.scm
new file mode 100644 (file)
index 0000000..4e53551
--- /dev/null
+++ b/src/runtime/library-database.scm
@@ -0,0 +1,60 @@
+#| -*-Scheme-*-
+
+Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
+    1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
+    2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016,
+    2017 Massachusetts Institute of Technology
+
+This file is part of MIT/GNU Scheme.
+
+MIT/GNU Scheme is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at
+your option) any later version.
+
+MIT/GNU Scheme is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with MIT/GNU Scheme; if not, write to the Free Software
+Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
+USA.
+
+|#
+
+;;;; R7RS libraries: database abstraction
+;;; package: (runtime library database)
+
+(declare (usual-integrations))
+\f
+(define (make-library-db)
+  (let ((table (make-equal-hash-table)))
+
+    (define (has? name)
+      (hash-table-exists? table name))
+
+    (define (get name #!optional default-value)
+      (if (default-object? default-value)
+         (hash-table-ref table name)
+         (hash-table-ref/default table name default-value)))
+
+    (define (put! name value)
+      (hash-table-set! table name value))
+
+    (define (delete! key)
+      (hash-table-delete! table key))
+
+    (define (get-alist)
+      (hash-table->alist table))
+
+    (define (put-alist! alist*)
+      (for-each (lambda (p)
+                 (put! (car p) (cdr p)))
+               alist*))
+
+    (bundle library-db? has? get put! delete! get-alist put-alist!)))
+
+(define library-db?
+  (make-bundle-predicate 'library-database))
\ No newline at end of file

diff --git a/src/runtime/library-standard.scm b/src/runtime/library-standard.scm
new file mode 100644 (file)
index 0000000..9f32e7a
--- /dev/null
+++ b/src/runtime/library-standard.scm
@@ -0,0 +1,633 @@
+#| -*-Scheme-*-
+
+Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
+    1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
+    2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016,
+    2017 Massachusetts Institute of Technology
+
+This file is part of MIT/GNU Scheme.
+
+MIT/GNU Scheme is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at
+your option) any later version.
+
+MIT/GNU Scheme is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with MIT/GNU Scheme; if not, write to the Free Software
+Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
+USA.
+
+|#
+
+;;;; R7RS libraries: standard libraries
+;;; package: (runtime library standard)
+
+(declare (usual-integrations))
+\f
+(define-deferred standard-libraries
+  (make-library-db))
+
+(define (define-standard-library name exports)
+  (add-boot-init!
+   (lambda ()
+     (standard-libraries 'put!
+                        name
+                        (make-parsed-library name
+                                             (map (lambda (id)
+                                                    (cons id id))
+                                                  exports)
+                                             '()
+                                             '())))))
+
+(define-standard-library '(scheme base)
+  '(*
+    +
+    -
+    ...
+    /
+    <
+    <=
+    =
+    =>
+    >
+    >=
+    _
+    abs
+    and
+    append
+    apply
+    assoc
+    assq
+    assv
+    begin
+    binary-port?
+    boolean=?
+    boolean?
+    bytevector
+    bytevector-append
+    bytevector-copy
+    bytevector-copy!
+    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
+    cdar
+    cddr
+    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
+    eof-object?
+    eq?
+    equal?
+    eqv?
+    error
+    error-object-irritants
+    error-object-message
+    error-object?
+    even?
+    exact
+    exact-integer-sqrt
+    exact-integer?
+    exact?
+    expt
+    features
+    file-error?
+    floor
+    floor-quotient
+    floor-remainder
+    floor/
+    flush-output-port
+    for-each
+    gcd
+    get-output-bytevector
+    get-output-string
+    guard
+    if
+    include
+    include-ci
+    inexact
+    inexact?
+    input-port-open?
+    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-open?
+    output-port?
+    pair?
+    parameterize
+    peek-char
+    peek-u8
+    port?
+    positive?
+    procedure?
+    quasiquote
+    quote
+    quotient
+    raise
+    raise-continuable
+    rational?
+    rationalize
+    read-bytevector
+    read-bytevector!
+    read-char
+    read-error?
+    read-line
+    read-string
+    read-u8
+    real?
+    remainder
+    reverse
+    round
+    set!
+    set-car!
+    set-cdr!
+    square
+    string
+    string->list
+    string->number
+    string->symbol
+    string->utf8
+    string->vector
+    string-append
+    string-copy
+    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=?
+    symbol?
+    syntax-error
+    syntax-rules
+    textual-port?
+    truncate
+    truncate-quotient
+    truncate-remainder
+    truncate/
+    u8-ready?
+    unless
+    unquote
+    unquote-splicing
+    utf8->string
+    values
+    vector
+    vector->list
+    vector->string
+    vector-append
+    vector-copy
+    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-string
+    write-u8
+    zero?))
+
+(define-standard-library '(scheme case-lambda)
+  '(case-lambda))
+
+(define-standard-library '(scheme char)
+  '(char-alphabetic?
+    char-ci<=?
+    char-ci<?
+    char-ci=?
+    char-ci>=?
+    char-ci>?
+    char-downcase
+    char-foldcase
+    char-lower-case?
+    char-numeric?
+    char-upcase
+    char-upper-case?
+    char-whitespace?
+    digit-value
+    string-ci<=?
+    string-ci<?
+    string-ci=?
+    string-ci>=?
+    string-ci>?
+    string-downcase
+    string-foldcase
+    string-upcase))
+
+(define-standard-library '(scheme complex)
+  '(angle
+    imag-part
+    magnitude
+    make-polar
+    make-rectangular
+    real-part))
+
+(define-standard-library '(scheme cxr)
+  '(caaaar
+    caaadr
+    caaar
+    caadar
+    caaddr
+    caadr
+    cadaar
+    cadadr
+    cadar
+    caddar
+    cadddr
+    caddr
+    cdaaar
+    cdaadr
+    cdaar
+    cdadar
+    cdaddr
+    cdadr
+    cddaar
+    cddadr
+    cddar
+    cdddar
+    cddddr
+    cdddr))
+
+(define-standard-library '(scheme eval)
+  '(environment
+    eval))
+
+(define-standard-library '(scheme file)
+  '(call-with-input-file
+       call-with-output-file
+     delete-file
+     file-exists?
+     open-binary-input-file
+     open-binary-output-file
+     open-input-file
+     open-output-file
+     with-input-from-file
+     with-output-to-file))
+
+(define-standard-library '(scheme inexact)
+  '(acos
+    asin
+    atan
+    cos
+    exp
+    finite?
+    infinite?
+    log
+    nan?
+    sin
+    sqrt
+    tan))
+
+(define-standard-library '(scheme lazy)
+  '(delay
+     delay-force
+     force
+     make-promise
+     promise?))
+
+(define-standard-library '(scheme load)
+  '(load))
+
+(define-standard-library '(scheme process-context)
+  '(command-line
+    emergency-exit
+    exit
+    get-environment-variable
+    get-environment-variables))
+
+(define-standard-library '(scheme read)
+  '(read))
+
+(define-standard-library '(scheme repl)
+  '(interaction-environment))
+
+(define-standard-library '(scheme time)
+  '(current-jiffy
+    current-second
+    jiffies-per-second))
+
+(define-standard-library '(scheme write)
+  '(display
+    write
+    write-shared
+    write-simple))
+
+(define-standard-library '(scheme r5rs)
+  '(*
+    +
+    -
+    ...
+    /
+    <
+    <=
+    =
+    =>
+    >
+    >=
+    _
+    abs
+    acos
+    and
+    angle
+    append
+    apply
+    asin
+    assoc
+    assq
+    assv
+    atan
+    begin
+    boolean?
+    caaaar
+    caaadr
+    caaar
+    caadar
+    caaddr
+    caadr
+    caar
+    cadaar
+    cadadr
+    cadar
+    caddar
+    cadddr
+    caddr
+    cadr
+    call-with-current-continuation
+    call-with-input-file
+    call-with-output-file
+    call-with-values
+    car
+    case
+    cdaaar
+    cdaadr
+    cdaar
+    cdadar
+    cdaddr
+    cdadr
+    cdar
+    cddaar
+    cddadr
+    cddar
+    cdddar
+    cddddr
+    cdddr
+    cddr
+    cdr
+    ceiling
+    char->integer
+    char-alphabetic?
+    char-ci<=?
+    char-ci<?
+    char-ci=?
+    char-ci>=?
+    char-ci>?
+    char-downcase
+    char-lower-case?
+    char-numeric?
+    char-ready?
+    char-upcase
+    char-upper-case?
+    char-whitespace?
+    char<=?
+    char<?
+    char=?
+    char>=?
+    char>?
+    char?
+    close-input-port
+    close-output-port
+    complex?
+    cond
+    cons
+    cos
+    current-input-port
+    current-output-port
+    define
+    define-syntax
+    delay
+    denominator
+    display
+    do
+    dynamic-wind
+    else
+    eof-object?
+    eq?
+    equal?
+    eqv?
+    eval
+    even?
+    exact->inexact
+    exact?
+    exp
+    expt
+    floor
+    for-each
+    force
+    gcd
+    if
+    imag-part
+    inexact->exact
+    inexact?
+    input-port?
+    integer->char
+    integer?
+    interaction-environment lambda
+    lcm
+    length
+    let
+    let*
+    let-syntax
+    letrec
+    letrec-syntax
+    list
+    list->string
+    list->vector
+    list-ref
+    list-tail
+    list?
+    load
+    log
+    magnitude
+    make-polar
+    make-rectangular
+    make-string
+    make-vector
+    map
+    max
+    member
+    memq
+    memv
+    min
+    modulo
+    negative?
+    newline
+    not
+    null-environment
+    null?
+    number->string
+    number?
+    numerator
+    odd?
+    open-input-file
+    open-output-file
+    or
+    output-port?
+    pair?
+    peek-char
+    positive?
+    procedure?
+    quasiquote
+    quote
+    quotient
+    rational?
+    rationalize
+    read
+    read-char
+    real-part
+    real?
+    remainder
+    reverse
+    round
+    scheme-report-environment
+    set!
+    set-car!
+    set-cdr!
+    sin
+    sqrt
+    string
+    string->list
+    string->number
+    string->symbol
+    string-append
+    string-ci<=?
+    string-ci<?
+    string-ci=?
+    string-ci>=?
+    string-ci>?
+    string-copy
+    string-fill!
+    string-length
+    string-ref
+    string-set!
+    string<=?
+    string<?
+    string=?
+    string>=?
+    string>?
+    string?
+    substring
+    symbol->string
+    symbol?
+    syntax-rules
+    tan
+    truncate
+    values
+    vector
+    vector->list
+    vector-fill!
+    vector-length
+    vector-ref
+    vector-set!
+    vector?
+    with-input-from-file
+    with-output-to-file
+    write
+    write-char
+    zero?))
\ No newline at end of file

diff --git a/src/runtime/make.scm b/src/runtime/make.scm
index 4c7643943f82c7549e41447977c7f78dc40dcfbc..49f0ca1b4cd6773900f06b3425b7a38d0d1cc059 100644 (file)
--- a/src/runtime/make.scm
+++ b/src/runtime/make.scm
@@ -531,6 +531,8 @@ USA.
    (runtime syntax rename)
    (runtime syntax top-level)
    (runtime syntax parser)
+   ;; R7RS Libraries
+   (runtime library standard)
    ;; REP Loops
    (runtime interrupt-handler)
    (runtime gc-statistics)

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 3485888413ec651a2d1a374f53e6e104cdc48a32..a00a914c27b68f1bb22769be813bbe9f059033db 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -5816,6 +5816,7 @@ USA.
   (parent (runtime))
   (export (runtime)
          library-name?
+         make-parsed-library
          parse-define-library-form
          parse-import-form
          parse-import-set
@@ -5823,4 +5824,17 @@ USA.
          parsed-library-exports
          parsed-library-imports
          parsed-library-name
-         parsed-library?))
\ No newline at end of file
+         parsed-library?))
+
+(define-package (runtime library database)
+  (files "library-database")
+  (parent (runtime))
+  (export (runtime)
+         library-db?
+         make-library-db))
+
+(define-package (runtime library standard)
+  (files "library-standard")
+  (parent (runtime))
+  (export (runtime)
+         standard-libraries))
\ No newline at end of file