Support R7RS.

* module/Makefile.am: Add r7rs-libraries.scm as dependency for boot-9.go.
  (SOURCES): Add $(R7RS_SOURCES).
  (R7RS_SOURCES): New variable.
  (NOCOMP_SOURCES): Add ice-9/r7rs-libraries.scm.

* module/ice-9/boot-9.scm: Include r7rs-libraries.scm.
  (%cond-expand-features): Add r7rs, exact-closed, ieee-float,
  full-unicode, and ratios.  Add TODO comments.
  (%cond-expand): New procedure, derived from code in 'cond-expand'.
  (cond-expand): Reimplement in terms of '%cond-expand'.

* module/ice-9/r7rs-libraries.scm:
  module/scheme/base.scm:
  module/scheme/case-lambda.scm:
  module/scheme/char.scm:
  module/scheme/complex.scm:
  module/scheme/cxr.scm:
  module/scheme/eval.scm:
  module/scheme/file.scm:
  module/scheme/inexact.scm:
  module/scheme/lazy.scm:
  module/scheme/load.scm:
  module/scheme/process-context.scm:
  module/scheme/r5rs.scm:
  module/scheme/read.scm:
  module/scheme/repl.scm:
  module/scheme/time.scm:
  module/scheme/write.scm: New files.

module/scheme/base.scm

@@ -0,0 +1,465 @@
+;;; base.scm --- The R7RS base library
+
+;;      Copyright (C) 2013, 2014 Free Software Foundation, Inc.
+;;
+;; This library is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU Lesser General Public
+;; License as published by the Free Software Foundation; either
+;; version 3 of the License, or (at your option) any later version.
+;;
+;; This library 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
+;; Lesser General Public License for more details.
+;;
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this library; if not, write to the Free Software
+;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+
+(define-library (scheme base)
+  (export + * - / = < > <= >=
+
+          (rename serious-condition? error-object?)
+          (rename condition-message error-object-message)
+          (rename condition-irritants error-object-irritants)
+
+          read-error?
+          file-error?
+
+          (rename truncate-quotient quotient)
+          (rename truncate-remainder remainder)
+          (rename floor-remainder modulo)
+
+          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
+          even? exact-integer-sqrt exact-integer? exact exact?
+          expt features 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
+          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 raise raise-continuable rational? rationalize
+          read-bytevector read-bytevector! read-char read-line read-string
+          read-u8 real? 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?)
+
+  (import (rename (rnrs base)
+                  (error r6rs-error)
+                  (map r6rs-map)
+                  (for-each r6rs-for-each)
+                  (vector-map r6rs-vector-map)
+                  (vector-for-each r6rs-vector-for-each)
+                  (string-for-each r6rs-string-for-each)
+                  (vector->list r6rs-vector->list)
+                  (vector-fill! r6rs-vector-fill!))
+          (rename (srfi srfi-1)
+                  (map srfi-1-map))
+          (rnrs control)
+          (rnrs exceptions)
+          (rnrs conditions)
+          (srfi srfi-6)
+          (srfi srfi-9)
+          (srfi srfi-11)
+          (srfi srfi-39)
+          (rnrs io simple)
+
+          (only (srfi srfi-43)
+                vector-append
+                vector-copy
+                vector-copy!
+                vector-fill!
+                vector->list)
+
+          (rename (rnrs io ports)
+                  (flush-output-port r6rs-flush-output-port)
+                  (binary-port? r6rs-binary-port?)
+                  (textual-port? r6rs-textual-port?))
+
+          (rename (rnrs bytevectors)
+                  (utf8->string      r6rs-utf8->string)
+                  (string->utf8      r6rs-string->utf8)
+                  (bytevector-copy   r6rs-bytevector-copy)
+                  (bytevector-copy!  r6rs-bytevector-copy!))
+
+          (rename (srfi srfi-13)
+                  (string-map srfi-13-string-map)
+                  (string-for-each srfi-13-string-for-each))
+
+          (rename (only (guile)
+                        case-lambda
+                        define-values
+                        define*
+                        list-set!
+                        exact-integer?
+                        floor/
+                        floor-quotient
+                        floor-remainder
+                        truncate/
+                        truncate-quotient
+                        truncate-remainder
+                        syntax-error
+                        port-closed?
+                        char-ready?
+                        %set-port-property!
+                        %port-property
+                        %cond-expand-features
+                        scm-error)
+                  ;; guile's char-ready? actually does the job of u8-ready?
+                  (char-ready?  u8-ready?))
+
+          (only (ice-9 rdelim) read-line))
+
+  (begin
+    (define (features)
+      %cond-expand-features)     ; XXX also include per-module features?
+
+    (define (error msg . objs)
+      (apply r6rs-error #f msg objs))
+
+    (define (square z)
+      (* z z))
+
+    ;; XXX FIXME When Guile's 'char-ready?' is fixed, this will need
+    ;; adjustment.
+    (define char-ready? u8-ready?)
+
+    ;; We cannot use the versions of 'map' from Guile core or SRFI-1,
+    ;; because this map needs to (1) use 'reverse' instead of 'reverse!'
+    ;; and (2) support lists of differing lengths.
+    (define map
+      (let ()
+        (define (check-procedure f)
+          (if (not (procedure? f))
+              (scm-error 'wrong-type-arg "map"
+                         "Not a procedure: ~S" (list f) #f)))
+
+        (define (no-finite-list-error ls)
+          (scm-error 'wrong-type-arg "map"
+                     "No finite list: ~S" ls #f))
+
+        ;; 'min*' is like 'min', but treats #f as an exact infinity,
+        ;; for purposes of finding the minimum length of the
+        ;; possibly-circular lists.
+        (define (min* a b)
+          (cond ((not a) b)
+                ((not b) a)
+                (else (min a b))))
+
+        (case-lambda
+          ((f l)
+           (check-procedure f)
+           (if (not (length+ l))
+               (no-finite-list-error (list l)))
+           (let map1 ((l l) (out '()))
+             (if (pair? l)
+                 (map1 (cdr l) (cons (f (car l)) out))
+                 (reverse out))))
+
+          ((f l1 l2)
+           (check-procedure f)
+           (let ((len (min* (length+ l1) (length+ l2))))
+             (if (not len)
+                 (no-finite-list-error (list l1 l2)))
+             (let map2 ((len len) (l1 l1) (l2 l2) (out '()))
+               (if (zero? len)
+                   (reverse out)
+                   (map2 (- len 1) (cdr l1) (cdr l2)
+                         (cons (f (car l1) (car l2))
+                               out))))))
+
+          ((f . ls)
+           (check-procedure f)
+           (let ((len (reduce min* #f (map length+ ls))))
+             (if (not len)
+                 (no-finite-list-error ls))
+             (let mapn ((len len) (ls ls) (out '()))
+               (if (zero? len)
+                   (reverse out)
+                   (mapn (- len 1) (map cdr ls)
+                         (cons (apply f (map car ls)) out)))))))))
+
+    (define* (vector->string v #:optional (start 0) (end (vector-length v)))
+      (string-tabulate (lambda (i)
+                         (vector-ref v (+ i start)))
+                       (- end start)))
+
+    (define* (string->vector s #:optional (start 0) (end (string-length s)))
+      (let ((v (make-vector (- end start))))
+        (let loop ((i 0) (j start))
+          (when (< j end)
+            (vector-set! v i (string-ref s j))
+            (loop (+ i 1) (+ j 1))))
+        v))
+
+    (define string-map
+      (case-lambda
+        ((proc s) (srfi-13-string-map proc s))
+        ((proc s1 s2)
+         (let* ((len (min (string-length s1)
+                          (string-length s2)))
+                (result (make-string len)))
+           (let loop ((i 0))
+             (when (< i len)
+               (string-set! result i
+                            (proc (string-ref s1 i)
+                                  (string-ref s2 i)))
+               (loop (+ i 1))))
+           result))
+        ((proc . strings)
+         (let* ((len (apply min (map string-length strings)))
+                (result (make-string len)))
+           (let loop ((i 0))
+             (when (< i len)
+               (string-set! result i
+                            (apply proc (map (lambda (s)
+                                               (string-ref s i))
+                                             strings)))
+               (loop (+ i 1))))
+           result))))
+
+    (define string-for-each
+      (case-lambda
+        ((proc s) (srfi-13-string-for-each proc s))
+        ((proc s1 s2)
+         (let ((len (min (string-length s1)
+                         (string-length s2))))
+           (let loop ((i 0))
+             (when (< i len)
+               (proc (string-ref s1 i)
+                     (string-ref s2 i))
+               (loop (+ i 1))))))
+        ((proc . strings)
+         (let ((len (apply min (map string-length strings))))
+           (let loop ((i 0))
+             (when (< i len)
+               (apply proc (map (lambda (s)
+                                  (string-ref s i))
+                                strings))
+               (loop (+ i 1))))))))
+
+    (define vector-map
+      (case-lambda
+        ((proc v) (r6rs-vector-map proc v))
+        ((proc v1 v2)
+         (let* ((len (min (vector-length v1)
+                          (vector-length v2)))
+                (result (make-vector len)))
+           (let loop ((i 0))
+             (when (< i len)
+               (vector-set! result i
+                            (proc (vector-ref v1 i)
+                                  (vector-ref v2 i)))
+               (loop (+ i 1))))
+           result))
+        ((proc . vs)
+         (let* ((len (apply min (map vector-length vs)))
+                (result (make-vector len)))
+           (let loop ((i 0))
+             (when (< i len)
+               (vector-set! result i
+                            (apply proc (map (lambda (v)
+                                               (vector-ref v i))
+                                             vs)))
+               (loop (+ i 1))))
+           result))))
+
+    (define vector-for-each
+      (case-lambda
+        ((proc v) (r6rs-vector-for-each proc v))
+        ((proc v1 v2)
+         (let ((len (min (vector-length v1)
+                         (vector-length v2))))
+           (let loop ((i 0))
+             (when (< i len)
+               (proc (vector-ref v1 i)
+                     (vector-ref v2 i))
+               (loop (+ i 1))))))
+        ((proc . vs)
+         (let ((len (apply min (map vector-length vs))))
+           (let loop ((i 0))
+             (when (< i len)
+               (apply proc (map (lambda (v)
+                                  (vector-ref v i))
+                                vs))
+               (loop (+ i 1))))))))
+
+    (define (bytevector . u8-list)
+      (u8-list->bytevector u8-list))
+
+    (define (bytevector-append . bvs)
+      (let* ((total-len (apply + (map bytevector-length bvs)))
+             (result (make-bytevector total-len)))
+        (let loop ((i 0) (bvs bvs))
+          (when (not (null? bvs))
+            (let* ((bv (car bvs))
+                   (len (bytevector-length bv)))
+              (r6rs-bytevector-copy! bv 0 result i len)
+              (loop (+ i len) (cdr bvs)))))
+        result))
+
+    (define bytevector-copy
+      (case-lambda
+        ((bv)
+         (r6rs-bytevector-copy bv))
+        ((bv start)
+         (let* ((len (- (bytevector-length bv) start))
+                (result (make-bytevector len)))
+           (r6rs-bytevector-copy! bv start result 0 len)
+           result))
+        ((bv start end)
+         (let* ((len (- end start))
+                (result (make-bytevector len)))
+           (r6rs-bytevector-copy! bv start result 0 len)
+           result))))
+
+    (define bytevector-copy!
+      (case-lambda
+        ((to at from)
+         (r6rs-bytevector-copy! from 0 to at
+                                (bytevector-length from)))
+        ((to at from start)
+         (r6rs-bytevector-copy! from start to at
+                                (- (bytevector-length from) start)))
+        ((to at from start end)
+         (r6rs-bytevector-copy! from start to at
+                                (- end start)))))
+
+    (define utf8->string
+      (case-lambda
+        ((bv) (r6rs-utf8->string bv))
+        ((bv start)
+         (r6rs-utf8->string (bytevector-copy bv start)))
+        ((bv start end)
+         (r6rs-utf8->string (bytevector-copy bv start end)))))
+
+    (define string->utf8
+      (case-lambda
+        ((s) (r6rs-string->utf8 s))
+        ((s start)
+         (r6rs-string->utf8 (substring s start)))
+        ((s start end)
+         (r6rs-string->utf8 (substring s start end)))))
+
+    (define (binary-port? obj)
+      (and (port? obj) (r6rs-binary-port? obj)))
+
+    (define (textual-port? obj)
+      (and (port? obj) (r6rs-textual-port? obj)))
+
+    (define* (flush-output-port #:optional (port (current-output-port)))
+      (r6rs-flush-output-port port))
+
+    (define (open-input-bytevector bv)
+      (open-bytevector-input-port bv))
+
+    (define (open-output-bytevector)
+      (call-with-values
+          (lambda () (open-bytevector-output-port))
+        (lambda (port proc)
+          (%set-port-property! port 'get-output-bytevector proc)
+          port)))
+
+    (define (get-output-bytevector port)
+      (let ((proc (%port-property port 'get-output-bytevector)))
+        (unless proc
+          (error "get-output-bytevector: port not created by open-output-bytevector"))
+        (proc)))
+
+    (define* (peek-u8 #:optional (port (current-input-port)))
+      (lookahead-u8 port))
+
+    (define* (read-u8 #:optional (port (current-input-port)))
+      (get-u8 port))
+
+    (define* (write-u8 byte #:optional (port (current-output-port)))
+      (put-u8 port byte))
+
+    (define* (read-bytevector k #:optional (port (current-input-port)))
+      (get-bytevector-n port k))
+
+    (define* (read-bytevector! bv
+                               #:optional
+                               (port (current-input-port))
+                               (start 0)
+                               (end (bytevector-length bv)))
+      (get-bytevector-n! port bv start (- end start)))
+
+    (define* (write-bytevector bv
+                               #:optional
+                               (port (current-output-port))
+                               (start 0)
+                               (end (bytevector-length bv)))
+      (put-bytevector port bv start (- end start)))
+
+    (define read-string
+      (case-lambda
+        ((k) (get-string-n (current-input-port) k))
+        ((k port) (get-string-n port k))))
+
+    (define write-string
+      (case-lambda
+        ((s) (put-string (current-output-port) s))
+        ((s port)
+         (put-string port s))
+        ((s port start)
+         (put-string port s start))
+        ((s port start end)
+         (put-string port s start (- end start)))))
+
+    (define write-bytevector
+      (case-lambda
+        ((bv) (put-bytevector (current-output-port) bv))
+        ((bv port)
+         (put-bytevector port bv))
+        ((bv port start)
+         (put-bytevector port bv start))
+        ((bv port start end)
+         (put-bytevector port bv start (- end start)))))
+
+    (define (input-port-open? port)
+      (unless (input-port? port)
+        (error "input-port-open?: not an input port" port))
+      (not (port-closed? port)))
+
+    (define (output-port-open? port)
+      (unless (output-port? port)
+        (error "output-port-open?: not an output port" port))
+      (not (port-closed? port)))
+
+    (define (read-error? obj)
+      (or (lexical-violation? obj)
+          (i/o-read-error? obj)))
+
+    (define (file-error? obj)
+      (or (i/o-file-protection-error? obj)
+          (i/o-file-is-read-only-error? obj)
+          (i/o-file-already-exists-error? obj)
+          (i/o-file-does-not-exist-error? obj)
+          (i/o-filename-error? obj)))))  ; XXX is this needed?