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