1;;;
2;;; r7rs-setup - R7RS compatibility
3;;;
4;;;   Copyright (c) 2013-2020  Shiro Kawai  <shiro@acm.org>
5;;;
6;;;   Redistribution and use in source and binary forms, with or without
7;;;   modification, are permitted provided that the following conditions
8;;;   are met:
9;;;
10;;;   1. Redistributions of source code must retain the above copyright
11;;;      notice, this list of conditions and the following disclaimer.
12;;;
13;;;   2. Redistributions in binary form must reproduce the above copyright
14;;;      notice, this list of conditions and the following disclaimer in the
15;;;      documentation and/or other materials provided with the distribution.
16;;;
17;;;   3. Neither the name of the authors nor the names of its contributors
18;;;      may be used to endorse or promote products derived from this
19;;;      software without specific prior written permission.
20;;;
21;;;   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
22;;;   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
23;;;   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
24;;;   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
25;;;   OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
26;;;   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
27;;;   TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
28;;;   PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
29;;;   LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
30;;;   NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
31;;;   SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
32;;;
33
34;; This file sets up R7RS environment.
35;; This is not intended to be just 'use'-d.  The user program should
36;; import R7RS libraries, e.g. (import (scheme base)), instead of
37;; using this module directly.
38
39;; A dummy module to hide under-the-hood details
40(define-module r7rs-setup)
41
42;; r7rs.import - R7RS-style 'import'.
43;;
44;; We keep Gauche's traditional import as is, and introduce R7RS import
45;; in this module.
46(define-module r7rs.import
47  (use util.match)
48  (use srfi-1)
49  (export (rename import r7rs-import))
50
51  ;; A trick - must be replaced once we have explicit-renaming macro.
52  (define import.  ((with-module gauche.internal make-identifier)
53                    'import (find-module 'gauche) '()))
54  (define require. ((with-module gauche.internal make-identifier)
55                    'require (find-module 'gauche) '()))
56  (define begin.   ((with-module gauche.internal make-identifier)
57                    'begin (find-module 'gauche) '()))
58
59  (define-macro (r7rs-import . import-sets)
60    `(,begin. ,@(append-map %transfer-import-spec import-sets)))
61  (define-macro (require-if-module-doesnt-exist modname)
62    (if (find-module modname)
63      #f
64      `(,require. ,(module-name->path modname))))
65
66  (define require-if-module-doesnt-exist.
67    ((with-module gauche.internal make-identifier)
68     'require-if-module-doesnt-exist (current-module) '()))
69
70  (define (%transfer-import-spec import-set)
71    (define (rec import-set)
72      (match import-set
73        [('only import-set identifier ...)
74         `(,@(rec import-set) :only ,identifier)]
75        [('except import-set identifier ...)
76         `(,@(rec import-set) :except ,identifier)]
77        [('prefix import-set identifier)
78         `(,@(rec import-set) :prefix ,identifier)]
79        [('rename import-set mapping ...)
80         `(,@(rec import-set) :rename ,mapping)]
81        [else
82         ;; Kludge: Warn if a programmer say (import gauche).
83         (when (equal? import-set '(gauche))
84           (warn "(import (gauche)) does not import anything.  \
85                  If you intend to import Gauche's built-in bindings, \
86                  say (import (gauche base)).\n"))
87         (list (library-name->module-name import-set))]))
88    (let1 import-spec (rec import-set)
89      `((,require-if-module-doesnt-exist. ,(car import-spec))
90        (,import. ,import-spec)))))
91
92;; r7rs.library - R7RS define-library form
93(define-module r7rs.library
94  (export define-library)
95
96  ;; A trick - must be replaced once we have explicit-renaming macro.
97  (define (global-id sym) ((with-module gauche.internal make-identifier)
98                           sym (find-module 'gauche) '()))
99  (define global-id=?     (with-module gauche.internal global-identifier=?))
100  (define define-module.  (global-id 'define-module))
101  (define with-module.    (global-id 'with-module))
102  (define define-syntax.  (global-id 'define-syntax.))
103  (define extend.         (global-id 'extend))
104
105  (define export.         (global-id 'export))
106  (define begin.          (global-id 'begin))
107  (define include.        (global-id 'include))
108  (define include-ci.     (global-id 'include-ci))
109  (define cond-expand.    (global-id 'cond-expand))
110  (define r7rs-import.    ((with-module gauche.internal make-identifier)
111                           'r7rs-import (find-module 'r7rs.import) '()))
112  (define use.            (global-id 'use))
113
114  (define-macro (define-library name . decls)
115    `(,define-module. ,(library-name->module-name name)
116       (,extend.)
117       ,@(map transform-decl decls)))
118
119  (define (transform-decl decl)
120    ;; Since define-library can't be an output of macro, we can just
121    ;; compare symbols literally.
122    (case (car decl)
123      [(include-library-declarations)
124       (unless (string? (cadr decl))
125         (error "include-library-declarations needs a string argument, but got:"
126                (cadr decl)))
127       ;; We share file searching logic with 'include' form.
128       (call-with-port
129        ($ (with-module gauche.internal pass1/open-include-file)
130           (cadr decl)
131           (or (current-load-path) (sys-getcwd)))
132        (^p `(,begin. ,@(map transform-decl (port->sexp-list p)))))]
133      [(export)      `(,export. ,@(cdr decl))]
134      [(import)      `(,r7rs-import. ,@(cdr decl))]
135      [(begin)       `(,begin. ,@(cdr decl))]
136      [(include)     `(,include. ,@(cdr decl))]
137      [(include-ci)  `(,include-ci. ,@(cdr decl))]
138      [(cond-expand)
139       ;; cond-expand needs special handling.  The expansion logic is the
140       ;; same as srfi-0 cond-expand, but we have to treat the expanded
141       ;; form as library-declarations instead of ordinary Scheme expressions.
142       ;; The current implementation relies on how cond-expand constructs
143       ;; the output; if we change cond-expand, we may need to tweak this
144       ;; as well.
145       (let1 expanded (macroexpand `(,cond-expand. ,@(cdr decl)) #t)
146         (if (pair? expanded)
147           (if (global-id=? (car expanded) begin.)
148             `(,begin. ,@(map transform-decl (cdr expanded)))
149             (transform-decl expanded))
150           (error "cond-expand expands to non-list:" expanded)))]
151      [else
152       ;; cond-expand may insert use clause, so
153       (if (and (pair? decl) (global-id=? (car decl) use.))
154         decl
155         (error "Invalid library declaration:" decl))]))
156  )
157
158;;
159;; The 'r7rs.vanilla' module removes all bindings by an empty (extend), except
160;; 'import' and 'define-library'.
161;;
162(define-module r7rs.vanilla
163  (export define-library)
164  (define-syntax import         (with-module r7rs.import r7rs-import))
165  (define-syntax define-library (with-module r7rs.library define-library))
166  (extend))
167
168;;
169;; The 'r7rs.user' module is the default module when gosh is invoked in
170;; r7rs mode.
171;;
172(define-module r7rs.user
173  (extend r7rs.vanilla))
174
175;; R7RS-small standard libraries.  First I thought to make them have
176;; separate file for each, but most of its content is just a rebinding&
177;; reexporting, and most files are small except scheme/base.  For now
178;; I consolidate them here instead of cluttering the library directory.
179;; We don't want to executing these kind of things every time we fire
180;; up R7RS scripts, so I think eventually we should precompile the entire
181;; r7rs compatibility thingy.
182
183(define-module r7rs.aux
184  ;; Auxiliary utility module.  This provides two things:
185  ;;  Utility macro define+ to redefine from other module,
186  ;;  and make r7rs#define and r7rs#lambda visible as r7rs:define
187  ;;  and r7rs:lambda.
188  (use gauche.base :except (define lambda))
189  (extend null)
190  (export define+ (rename define r7rs:define) (rename lambda r7rs:lambda))
191  (define-macro (define+ sym module)
192    `(define-inline ,sym (with-module ,module ,sym)))
193  )
194
195(define-module scheme.base
196  (use gauche.uvector)
197  (use gauche.record)
198  (use gauche.unicode)
199  (use srfi-13)
200
201  (require "srfi-43")
202
203  (import r7rs.aux)
204  (export * + - ... / < <= = => > >= _ abs and append apply assoc assq
205          assv begin binary-port?  boolean=?  boolean?  bytevector
206          bytevector-append bytevector-copy bytevector-copy! bytevector-length
207          bytevector-u8-ref bytevector-u8-set!  bytevector?  caar cadr
208          call-with-current-continuation call-with-port call-with-values call/cc
209          car case cdar cddr cdr ceiling char->integer char-ready?  char<=?
210          char<?  char=?  char>=?  char>?  char?  close-input-port
211          close-output-port close-port complex?  cond cond-expand cons
212          current-error-port current-input-port current-output-port
213          (rename r7rs:define define)
214          define-record-type define-syntax define-values
215          denominator do
216          dynamic-wind else eof-object?  equal?  error error-object-message
217          even?  exact-integer-sqrt exact?  features floor floor-remainder
218          flush-output-port gcd get-output-string if include-ci inexact?
219          input-port?  integer?  lcm let let*-values let-values letrec* list
220          list->vector list-ref list-tail make-bytevector make-parameter
221          make-vector max memq min negative?  not number->string numerator
222          open-input-bytevector open-output-bytevector or output-port?
223          parameterize peek-u8 positive?  quasiquote quotient raise-continuable
224          rationalize read-bytevector!  read-error?  read-string real?  reverse
225          set!  set-cdr!  string string->number string->utf8 string-append
226          eof-object eq?  eqv?  error-object-irritants error-object?  exact
227          exact-integer?  expt file-error?  floor-quotient floor/ for-each
228          get-output-bytevector guard include inexact input-port-open?
229          integer->char (rename r7rs:lambda lambda) length let* let-syntax
230          letrec letrec-syntax
231          list->string list-copy list-set!  list?  make-list make-string map
232          member memv modulo newline null?  number?  odd?  open-input-string
233          open-output-string output-port-open?  pair?  peek-char port?
234          procedure?  quote (rename r7rs:raise raise)
235          rational?  read-bytevector read-char read-line
236          read-u8 remainder round set-car!  square string->list string->symbol
237          string->vector string-copy string-copy!  string-for-each string-map
238          string-set!  string<?  string>=?  string?  symbol->string symbol?
239          syntax-rules truncate truncate-remainder u8-ready?  unquote
240          utf8->string vector vector->string vector-copy vector-fill!
241          vector-length vector-ref vector?
242          (rename r7rs:with-exception-handler with-exception-handler)
243          write-char write-u8 string-fill!  string-length string-ref string<=?
244          string=?  string>?  substring symbol=?  syntax-error textual-port?
245          truncate-quotient truncate/ unless unquote-splicing values
246          vector->list vector-append vector-copy!  vector-for-each vector-map
247          vector-set!  when write-bytevector write-string zero?
248          )
249
250  (autoload gauche.vport
251            open-input-bytevector open-output-bytevector get-output-bytevector)
252
253  ;; 4.1 Primitive expression types
254  ;; quote, if, lambda, include, include-ci
255
256  ;; 4.2 Derived expression types
257  ;; cond case and or when unless cond-expand let let* letrec letrec*
258  ;; let-values let*-values begin do make-parameter parameterize
259  ;; guard quasiquote unquote unquote-splicing case-lambda
260
261  ;; 4.3 Macros
262  ;; let-syntax letrec-syntax syntax-rules syntax-error
263
264  ;; 5.3 Variable definitions
265  ;; define define-values
266
267  ;; 5.4 Syntax definitions
268  ;; define-syntax
269
270  ;; 5.5 Record type definitions
271  ;; define-record-type
272
273  ;; 6.1 Equivalence predicates
274  ;; eqv? eq? equal?
275
276  ;; 6.2 Numbers
277  ;; TODO: exact complex
278  ;; number? complex? real? rational? integer? exact? exact-integer?
279  ;; = < > <= >= zero? positive? negative? odd? even? max min + * - / abs
280  ;; floor/ floor-quotient floor-remainder
281  ;; truncate/ truncate-quotient truncate-remainder
282  ;; quotient modulo remainder gcd lcm numerator denominator
283  ;; floor ceiling truncate round rationalize square exact-integer-sqrt
284  ;; expt inexact exact number->string string->number
285
286  ;; 6.3 Booleans
287  ;; not boolean? boolean=?
288
289  ;; 6.4 Pairs and lists
290  ;; pair? cons car cdr set-car! set-cdr! caar cadr cdar cddr null? list?
291  ;; make-list list length append reverse list-tail list-ref list-set!
292  ;; memq memv member assq assv assoc list-copy
293
294  ;; 6.5 Symbols
295  ;; symbol? symbol=? symbol->string string->symbol
296
297  ;; 6.6 Characters
298  ;; char? char=? char<? char>? char<=? char>=?
299  ;; char->integer integer->char
300
301  ;; 6.7 Strings
302  ;; string? make-string string string-length string-ref string-set!
303  ;; string=? string<? string>? string<=? string>=? substring string-append
304  ;; string->list list->string string-copy string-copy! string-fill!
305
306  ;; 6.8 Vectors
307  ;; vector? make-vector vector vector-length vector-ref vector-set!
308  ;; vector->list list->vector vector->string string->vector
309  ;; vector-copy vector-copy! vector-append vector-fill!
310
311  ;; 6.9 Bytevectors
312  (define+ utf8->string  gauche.unicode)
313  (define+ string->utf8  gauche.unicode)
314
315  ;; 6.10 Control features
316  ;; procedure? apply map
317  ;; call-with-current-continuation call/cc values call-with-values dynamic-wind
318  (define+ vector-map gauche)
319  (define+ vector-for-each gauche)
320  (define+ string-map gauche)
321  (define+ string-for-each gauche)
322
323  ;; 6.11 Exceptions
324  ;; error - built-in
325
326  ;; NB: In Gauche, 'with-exception-handler' is srfi-18 version.
327  (define (r7rs:with-exception-handler handler thunk)
328    (let* ([old (current-exception-handler)]
329           [new (^[exc]
330                  (with-exception-handler
331                   old
332                   (^[]
333                     (if (condition-has-type? exc <serious-condition>)
334                       (begin
335                         (handler exc)
336                         (raise exc))
337                       (handler exc)))))])
338      (with-exception-handler new thunk)))
339
340  ;; NB: In Gauche, 'raise' is continuable as far as the thrown exception
341  ;; isn't fatal.
342  (define (raise-continuable c) (raise c))
343  (define (r7rs:raise c) ((with-module gauche.internal %raise) c #t))
344
345  (define (error-object? e) (condition-has-type? e <error>))
346  (define (error-object-message e)
347    (if (condition-has-type? e <message-condition>)
348      (condition-ref e 'message-prefix)
349      "")) ; for now, we take permissive stance.
350  (define (error-object-irritants e)
351    (if (condition-has-type? e <message-condition>)
352      (condition-ref e 'message-args)
353      '()))
354  (define (read-error? e) (condition-has-type? e <read-error>))
355  (define (file-error? e) ;TODO: have a distinct type <file-error>
356    ;; for the time being, we use heuristics
357    (and (condition-has-type? e <system-error>)
358         (boolean (memq (sys-errno->symbol (condition-ref e 'errno))
359                        `(EACCES EAGAIN EBADF EBADFD EEXIST EFBIG EIO
360                          EISDIR EISNAM ELNRNG ELOOP EMFILE EMLINK
361                          ENAMETOOLONG ENFILE ENOBUFS ENODEV ENOENT
362                          ENOSPC ENOTBLK ENOTDIR ENOTEMPTY ENXIO
363                          EPERM EPIPE ESPIPE ESTALE ETXTBSY EXDEV)))))
364
365  ;; 6.12 Environments and evaluation
366  ;; scheme-report-environment null-environment
367
368  ;; 6.13 Input and output
369  ;; input-port? output-port? port? current-input-port current-output-port
370  ;; current-error-port close-port close-input-port close-output-port
371  ;; open-input-string open-output-string get-output-string read-string
372  ;; read-char peek-char read-line eof-object? eof-object char-ready?
373  ;; newline write-char write-string u8-ready? read-u8 peek-u8 write-u8
374  ;; open-input-bytevector open-output-bytevector get-output-bytevector
375  ;; read-bytevector read-bytevector! write-bytevector
376  (define (textual-port? p) (port? p))    ; gauche's port can handle both
377  (define (binary-port? p) (port? p))     ; gauche's port can handle both
378  (define (input-port-open? p) (and (input-port? p) (not (port-closed? p))))
379  (define (output-port-open? p) (and (output-port? p) (not (port-closed? p))))
380  (define flush-output-port flush)
381
382  ;; 6.14 System interface
383  (define (features) (map car ((with-module gauche.internal cond-features))))
384
385  (provide "scheme/base"))
386
387(define-module scheme.case-lambda
388  (import r7rs.aux)
389  (export case-lambda)
390  (provide "scheme/case-lambda"))
391
392(define-module scheme.char
393  (use gauche.unicode)
394  (import r7rs.aux)
395  (export char-alphabetic? char-ci<=? char-ci<?
396          char-ci=? char-ci>=? char-ci>?
397          char-downcase char-foldcase
398          char-lower-case? char-numeric?
399          char-upcase char-upper-case?
400          char-whitespace? digit-value
401          string-ci<=? string-ci<?
402          string-ci=? string-ci>=?
403          string-ci>? string-downcase
404          string-foldcase string-upcase)
405  (define (digit-value c) (digit->integer c 10 #t))
406  (define+ string-ci=?  gauche.unicode)   ; not gauche's.
407  (define+ string-ci<?  gauche.unicode)   ; not gauche's.
408  (define+ string-ci>?  gauche.unicode)   ; not gauche's.
409  (define+ string-ci<=? gauche.unicode)   ; not gauche's.
410  (define+ string-ci>=? gauche.unicode)   ; not gauche's.
411  (define+ string-upcase gauche.unicode)   ; not srfi-13's.
412  (define+ string-downcase gauche.unicode) ; not srfi-13's.
413  (define+ string-foldcase gauche.unicode) ; not srfi-13's.
414  (provide "scheme/char"))
415
416(define-module scheme.complex
417  (import r7rs.aux)
418  (export angle imag-part magnitude make-polar make-rectangular real-part)
419  (provide "scheme/complex"))
420
421(define-module scheme.cxr
422  (import r7rs.aux)
423  (export caaar caadr cadar caddr cdaar cdadr cddar cdddr
424          caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr
425          cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr)
426  (provide "scheme/cxr"))
427
428(define-module scheme.eval
429  (import r7rs.aux)
430  (export environment eval)
431  (define (environment . import-lists)
432    (rlet1 m (make-module #f)
433      (eval '(extend r7rs.vanilla) m)
434      (eval `(import ,@import-lists) m)))
435  (provide "scheme/eval"))
436
437(define-module scheme.file
438  (import r7rs.aux)
439  (require "file/util")
440  (export call-with-input-file call-with-output-file
441          delete-file file-exists?
442          open-binary-input-file open-binary-output-file
443          open-input-file open-output-file
444          with-input-from-file with-output-to-file)
445  (define open-binary-input-file open-input-file)
446  (define open-binary-output-file open-output-file)
447  (define+ delete-file file.util)
448  (provide "scheme/file"))
449
450(define-module scheme.inexact
451  (import r7rs.aux)
452  (export acos asin atan cos exp finite? infinite? log nan? sin sqrt tan)
453  (provide "scheme/inexact"))
454
455(define-module scheme.lazy
456  (import r7rs.aux)
457  (export delay force delay-force promise? make-promise)
458  (define-syntax delay-force (with-module gauche lazy))
459  (define (make-promise obj) (if (promise? obj) obj (delay obj)))
460  (provide "scheme/lazy"))
461
462(define-module scheme.load
463  (export (rename r7rs-load load))
464  (define (r7rs-load file :optional (env (interaction-environment)))
465    (load file :environment env))
466  (provide "scheme/load"))
467
468(define-module scheme.process-context
469  (import r7rs.aux)
470  (export command-line emergency-exit exit
471          get-environment-variable get-environment-variables)
472  (define (emergency-exit :optional (obj 0)) (sys-exit obj))
473  (define get-environment-variable  sys-getenv)
474  (define get-environment-variables sys-environ->alist)
475  (provide "scheme/process-context"))
476
477(define-module scheme.read
478  (import r7rs.aux)
479  (export read)
480  (provide "scheme/read"))
481
482(define-module scheme.repl
483  (import r7rs.aux)
484  (export interaction-environment)
485  (provide "scheme/repl"))
486
487(define-module scheme.time
488  (export current-jiffy jiffies-per-second current-second)
489  (define-constant tai-utc 35) ; TAI is ahead of this amount as of 2014
490  (define-constant tai-off 8)  ; TAI epoch is ahead of this amount
491  ;; We reduce resolution in 32bit platform so that we have more time
492  ;; before current-jiffy falls out of fixnum range.  On 32bit machines,
493  ;; 100us resolution gives 53687 seconds before we get bignum.  On 64bit
494  ;; machines, we have enough bits with nanosec resolution.
495  (define-constant jiffy-resolution
496    (if (fixnum? (expt 2 32)) #e1e9 #e1e4))
497  ;; We use clock_gettime(CLOCK_MONOTONIC) for current-jiffy if possible,
498  ;; falling back to gettimeofday.
499  (define (%gettime)
500    (receive (sec nsec) (sys-clock-gettime-monotonic)
501      (if sec
502        (values sec nsec)
503        (receive (sec usec) (sys-gettimeofday)
504          (values (+ sec tai-utc) (* usec 1000))))))
505
506  (define-values (%epoch-sec %epoch-nsec) (%gettime))
507  (define (current-second)
508    (receive (sec usec) (sys-gettimeofday)
509      (+ sec (/. usec 1e6) (- tai-utc tai-off))))
510  (define current-jiffy
511    (if (fixnum? (expt 2 32))
512      (^[] (receive (sec nsec) (%gettime)
513             (+ (* (- sec %epoch-sec) jiffy-resolution)
514                (- nsec %epoch-nsec))))
515      (^[] (receive (sec nsec) (%gettime)
516             (+ (* (- sec %epoch-sec) jiffy-resolution)
517                (quotient (- nsec %epoch-nsec) (/ #e1e9 jiffy-resolution)))))))
518  (define (jiffies-per-second) jiffy-resolution)
519  (provide "scheme/time"))
520
521(define-module scheme.write
522  (export display write write-shared write-simple)
523  (provide "scheme/write"))
524
525(define-module scheme.r5rs
526  (import r7rs.aux)
527  (export * + - / < <= = > >= abs acos and angle append apply asin assoc assq
528          assv atan begin boolean? caaaar caaadr caaar caadar caaddr caadr
529          caar cadaar cadadr cadar caddar cadddr caddr cadr
530          call-with-current-continuation call-with-input-file
531          call-with-output-file call-with-values car case cdaaar cdaadr cdaar
532          cdadar cdaddr cdadr cdar cddaar cddadr cddar cdddar cddddr cdddr cddr
533          cdr ceiling char->integer char-alphabetic? char-ci<=? char-ci<?
534          char-ci=? char-ci>=? char-ci>? char-downcase char-lower-case?
535          char-numeric? char-ready? char-upcase char-upper-case? char-whitespace?
536          char<=? char<? char=? char>=? char>? char? close-input-port
537          close-output-port complex? cond cons cos current-input-port
538          current-output-port (rename r7rs:define define)
539          define-syntax delay denominator display
540          do dynamic-wind eof-object? eq? equal? eqv? eval even? exact->inexact
541          exact? exp expt floor for-each force gcd if imag-part inexact->exact
542          inexact? input-port? integer->char integer? interaction-environment
543          (rename r7rs:lambda lambda)
544          lcm length let let* let-syntax letrec letrec-syntax list
545          list->string list->vector list-ref list-tail list? load log magnitude
546          make-polar make-rectangular make-string make-vector map max member
547          memq memv min modulo negative? newline not null-environment null?
548          number->string number? numerator odd? open-input-file open-output-file
549          or output-port? pair? peek-char positive? procedure? quasiquote quote
550          quotient rational? rationalize read read-char real-part real? remainder
551          reverse round scheme-report-environment set! set-car! set-cdr! sin
552          sqrt string string->list string->number string->symbol string-append
553          string-ci<=? string-ci<? string-ci=? string-ci>=? string-ci>?
554          string-copy string-fill! string-length string-ref string-set!
555          string<=? string<? string=? string>=? string>? string? substring
556          symbol->string symbol? tan truncate values vector vector->list
557          vector-fill! vector-length vector-ref vector-set! vector?
558          with-input-from-file with-output-to-file write write-char zero?
559          ;; R7RS Errata #22
560          syntax-rules else ... => _
561          )
562  (provide "scheme/r5rs")
563  )
564
565;; A trick: 'define-library' in Gauche module is set to be autoloaded.
566;; When this module is loaded directly (not via autoload), however,
567;; we don't want to trigger autoload from gauche#define-library anymore,
568;; so we overwrite it.
569(with-module gauche
570  (define-syntax define-library (with-module r7rs.vanilla define-library)))
571
572(provide "r7rs-setup")
573