mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-02 21:10:27 +02:00
Code Activity

Support R7RS.

Browse source 
* 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.
This commit is contained in:
Mark H Weaver 2013-12-21 02:56:33 -05:00
parent b1bc025224
commit 2d76447bda
19 changed files with 1587 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

22
module/Makefile.am
View file

@ -33,7 +33,7 @@ nobase_ccache_DATA += ice-9/eval.go
EXTRA_DIST += ice-9/eval.scm EXTRA_DIST += ice-9/eval.scm
ETAGS_ARGS += ice-9/eval.scm ETAGS_ARGS += ice-9/eval.scm
ice-9/boot-9.go: ice-9/boot-9.scm ice-9/quasisyntax.scm ice-9/r6rs-libraries.scm ice-9/boot-9.go: ice-9/boot-9.scm ice-9/quasisyntax.scm ice-9/r6rs-libraries.scm ice-9/r7rs-libraries.scm
ice-9/match.go: ice-9/match.scm ice-9/match.upstream.scm ice-9/match.go: ice-9/match.scm ice-9/match.upstream.scm
# We can compile these in any order, but it's fastest if we compile # We can compile these in any order, but it's fastest if we compile
@ -62,6 +62,7 @@ SOURCES = \
$(ICE_9_SOURCES) \ $(ICE_9_SOURCES) \
$(SRFI_SOURCES) \ $(SRFI_SOURCES) \
$(RNRS_SOURCES) \ $(RNRS_SOURCES) \
$(R7RS_SOURCES) \
$(OOP_SOURCES) \ $(OOP_SOURCES) \
$(SYSTEM_SOURCES) \ $(SYSTEM_SOURCES) \
$(SCRIPTS_SOURCES) \ $(SCRIPTS_SOURCES) \
@ -323,6 +324,24 @@ RNRS_SOURCES = \
rnrs/records/syntactic.scm \ rnrs/records/syntactic.scm \
rnrs.scm rnrs.scm
R7RS_SOURCES = \
scheme/base.scm \
scheme/case-lambda.scm \
scheme/char.scm \
scheme/complex.scm \
scheme/cxr.scm \
scheme/eval.scm \
scheme/file.scm \
scheme/inexact.scm \
scheme/lazy.scm \
scheme/load.scm \
scheme/process-context.scm \
scheme/r5rs.scm \
scheme/read.scm \
scheme/repl.scm \
scheme/time.scm \
scheme/write.scm
EXTRA_DIST += scripts/ChangeLog-2008 EXTRA_DIST += scripts/ChangeLog-2008
EXTRA_DIST += scripts/README EXTRA_DIST += scripts/README
@ -396,6 +415,7 @@ NOCOMP_SOURCES = \
ice-9/match.upstream.scm \ ice-9/match.upstream.scm \
ice-9/psyntax.scm \ ice-9/psyntax.scm \
ice-9/r6rs-libraries.scm \ ice-9/r6rs-libraries.scm \
ice-9/r7rs-libraries.scm \
ice-9/quasisyntax.scm \ ice-9/quasisyntax.scm \
srfi/srfi-42/ec.scm \ srfi/srfi-42/ec.scm \
srfi/srfi-64/testing.scm \ srfi/srfi-64/testing.scm \

25
module/ice-9/boot-9.scm
View file

@ -3653,6 +3653,7 @@ CONV is not applied to the initial value."
(use-modules spec ...))) (use-modules spec ...)))
(include-from-path "ice-9/r6rs-libraries") (include-from-path "ice-9/r6rs-libraries")
(include-from-path "ice-9/r7rs-libraries")
(define-syntax-rule (define-private foo bar) (define-syntax-rule (define-private foo bar)
(define foo bar)) (define foo bar))
@ -4104,6 +4105,19 @@ when none is available, reading FILE-NAME with READER."
'(guile '(guile
guile-2 guile-2
r5rs r5rs
r7rs
exact-closed
ieee-float ; XXX might not always be true
full-unicode
ratios
;; XXX TODO where appropriate, add 'posix', 'windows', 'unix',
;; 'darwin', 'gnu-linux', 'bsd', 'freebsd', 'solaris', per R7RS.
;; XXX TODO where appropriate, add 'i386', 'x86-64', 'ppc',
;; 'sparc', etc, per R7RS.
;; XXX TODO where appropriate, add 'ilp32', 'lp64', 'ilp64', etc, per R7RS.
;; XXX TODO add 'little-endian' or 'big-endian', per R7RS
srfi-0 ;; cond-expand itself srfi-0 ;; cond-expand itself
srfi-4 ;; homogeneous numeric vectors srfi-4 ;; homogeneous numeric vectors
;; We omit srfi-6 because the 'open-input-string' etc in Guile ;; We omit srfi-6 because the 'open-input-string' etc in Guile
@ -4137,7 +4151,7 @@ when none is available, reading FILE-NAME with READER."
(append (hashq-ref %cond-expand-table mod '()) (append (hashq-ref %cond-expand-table mod '())
features))))) features)))))
(define-syntax cond-expand (define %cond-expand
(lambda (x) (lambda (x)
(define (module-has-feature? mod sym) (define (module-has-feature? mod sym)
(or-map (lambda (mod) (or-map (lambda (mod)
@ -4152,6 +4166,7 @@ when none is available, reading FILE-NAME with READER."
(or-map condition-matches? #'(c ...))) (or-map condition-matches? #'(c ...)))
((not c) ((not c)
(if (condition-matches? #'c) #f #t)) (if (condition-matches? #'c) #f #t))
;; XXX FIXME: Implement (library <library-name>) clause per R7RS
(c (c
(identifier? #'c) (identifier? #'c)
(let ((sym (syntax->datum #'c))) (let ((sym (syntax->datum #'c)))
@ -4163,7 +4178,7 @@ when none is available, reading FILE-NAME with READER."
(syntax-case clauses () (syntax-case clauses ()
(((condition form ...) . rest) (((condition form ...) . rest)
(if (condition-matches? #'condition) (if (condition-matches? #'condition)
#'(begin form ...) #'(form ...)
(match #'rest alternate))) (match #'rest alternate)))
(() (alternate)))) (() (alternate))))
@ -4171,12 +4186,16 @@ when none is available, reading FILE-NAME with READER."
((_ clause ... (else form ...)) ((_ clause ... (else form ...))
(match #'(clause ...) (match #'(clause ...)
(lambda () (lambda ()
#'(begin form ...)))) #'(form ...))))
((_ clause ...) ((_ clause ...)
(match #'(clause ...) (match #'(clause ...)
(lambda () (lambda ()
(syntax-violation 'cond-expand "unfulfilled cond-expand" x))))))) (syntax-violation 'cond-expand "unfulfilled cond-expand" x)))))))
(define-syntax cond-expand
(lambda (x)
#`(begin #,@(%cond-expand x))))
;; This procedure gets called from the startup code with a list of ;; This procedure gets called from the startup code with a list of
;; numbers, which are the numbers of the SRFIs to be loaded on startup. ;; numbers, which are the numbers of the SRFIs to be loaded on startup.
;; ;;

96
module/ice-9/r7rs-libraries.scm Normal file
View file

@ -0,0 +1,96 @@
;;; r7rs-libraries.scm --- Support for the R7RS `define-library' form
;; Copyright (C) 2013 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
;; This file is included from boot-9.scm and assumes the existence of
;; (and expands into) procedures and syntactic forms defined therein.
(define-syntax define-library
(lambda (form)
(syntax-case form ()
((_ (module-name ...) (decl-type . decl-args) ...)
(and-map (lambda (x)
(or (identifier? x)
(exact-integer? (syntax->datum x)))) ; XXX FIXME handle exact integers properly
#'(module-name ...))
(let loop ((decls #'((decl-type . decl-args) ...))
(imports '())
(exports '())
(bodies '()))
(if (null? decls)
#`(library (module-name ...)
(export #,@(reverse exports))
(import #,@(reverse imports))
#,@(reverse bodies))
(let ((decl (car decls)))
(define (splice-in xs)
(loop (append xs (cdr decls)) imports exports bodies))
(define (new-imports specs)
(loop (cdr decls) (append (reverse specs) imports) exports bodies))
(define (new-exports specs)
(loop (cdr decls) imports (append (reverse specs) exports) bodies))
(define (new-bodies xs)
(loop (cdr decls) imports exports (append (reverse xs) bodies)))
(syntax-case decl (export
import
begin
include
include-ci
include-library-declarations
cond-expand)
((export spec ...)
(let ()
(define (convert-spec spec)
(syntax-case spec (rename)
((rename id1 id2)
(and (identifier? #'id1)
(identifier? #'id2))
#'(rename (id1 id2)))
(id
(identifier? #'id)
#'id)
(_ (syntax-violation 'export "invalid export spec"
decl spec))))
(new-exports (map convert-spec #'(spec ...)))))
((import set ...)
(new-imports #'(set ...)))
((begin cmd-or-defn ...)
(new-bodies #'(cmd-or-defn ...)))
((include filename1 filename2 ...)
(and-map (lambda (fn)
(string? (syntax->datum fn)))
#'(filename1 filename2 ...))
(new-bodies (%read-files-for-include #'(filename1 filename2 ...)
#f
decl)))
((include-ci filename1 filename2 ...)
(and-map (lambda (fn)
(string? (syntax->datum fn)))
#'(filename1 filename2 ...))
(new-bodies (%read-files-for-include #'(filename1 filename2 ...)
#t
decl)))
((include-library-declarations filename1 filename2 ...)
(and-map (lambda (fn)
(string? (syntax->datum fn)))
#'(filename1 filename2 ...))
(splice-in (%read-files-for-include #'(filename1 filename2 ...)
#f
decl)))
((cond-expand clause1 clause2 ...)
(splice-in (%cond-expand decl)))))))))))

465
module/scheme/base.scm Normal file
View file

@ -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?

22
module/scheme/case-lambda.scm Normal file
View file

@ -0,0 +1,22 @@
;;; case-lambda.scm --- The R7RS case-lambda library
;; Copyright (C) 2013 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 case-lambda)
(export case-lambda)
(import (only (guile) case-lambda)))

521
module/scheme/char.scm Normal file
View file

@ -0,0 +1,521 @@
;;; char.scm --- The R7RS char library
;; Copyright (C) 2013 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 char)
(export char-alphabetic?
char-ci<?
char-ci>=?
char-downcase
char-lower-case?
char-upcase
char-whitespace?
string-ci<=?
string-ci=?
string-ci>?
string-foldcase
char-ci<=?
char-ci=?
char-ci>?
char-foldcase
char-numeric?
char-upper-case?
digit-value
string-ci<?
string-ci>=?
string-downcase
string-upcase)
(import (scheme base)
(rnrs unicode))
(begin
(define digit-value
(let* ((digit-table
;; Derived from http://www.unicode.org/Public/6.3.0/ucd/extracted/DerivedNumericValues.txt
#((#x00030 . 0) ; DIGIT ZERO
(#x00031 . 1) ; DIGIT ONE
(#x00032 . 2) ; DIGIT TWO
(#x00033 . 3) ; DIGIT THREE
(#x00034 . 4) ; DIGIT FOUR
(#x00035 . 5) ; DIGIT FIVE
(#x00036 . 6) ; DIGIT SIX
(#x00037 . 7) ; DIGIT SEVEN
(#x00038 . 8) ; DIGIT EIGHT
(#x00039 . 9) ; DIGIT NINE
(#x00660 . 0) ; ARABIC-INDIC DIGIT ZERO
(#x00661 . 1) ; ARABIC-INDIC DIGIT ONE
(#x00662 . 2) ; ARABIC-INDIC DIGIT TWO
(#x00663 . 3) ; ARABIC-INDIC DIGIT THREE
(#x00664 . 4) ; ARABIC-INDIC DIGIT FOUR
(#x00665 . 5) ; ARABIC-INDIC DIGIT FIVE
(#x00666 . 6) ; ARABIC-INDIC DIGIT SIX
(#x00667 . 7) ; ARABIC-INDIC DIGIT SEVEN
(#x00668 . 8) ; ARABIC-INDIC DIGIT EIGHT
(#x00669 . 9) ; ARABIC-INDIC DIGIT NINE
(#x006F0 . 0) ; EXTENDED ARABIC-INDIC DIGIT ZERO
(#x006F1 . 1) ; EXTENDED ARABIC-INDIC DIGIT ONE
(#x006F2 . 2) ; EXTENDED ARABIC-INDIC DIGIT TWO
(#x006F3 . 3) ; EXTENDED ARABIC-INDIC DIGIT THREE
(#x006F4 . 4) ; EXTENDED ARABIC-INDIC DIGIT FOUR
(#x006F5 . 5) ; EXTENDED ARABIC-INDIC DIGIT FIVE
(#x006F6 . 6) ; EXTENDED ARABIC-INDIC DIGIT SIX
(#x006F7 . 7) ; EXTENDED ARABIC-INDIC DIGIT SEVEN
(#x006F8 . 8) ; EXTENDED ARABIC-INDIC DIGIT EIGHT
(#x006F9 . 9) ; EXTENDED ARABIC-INDIC DIGIT NINE
(#x007C0 . 0) ; NKO DIGIT ZERO
(#x007C1 . 1) ; NKO DIGIT ONE
(#x007C2 . 2) ; NKO DIGIT TWO
(#x007C3 . 3) ; NKO DIGIT THREE
(#x007C4 . 4) ; NKO DIGIT FOUR
(#x007C5 . 5) ; NKO DIGIT FIVE
(#x007C6 . 6) ; NKO DIGIT SIX
(#x007C7 . 7) ; NKO DIGIT SEVEN
(#x007C8 . 8) ; NKO DIGIT EIGHT
(#x007C9 . 9) ; NKO DIGIT NINE
(#x00966 . 0) ; DEVANAGARI DIGIT ZERO
(#x00967 . 1) ; DEVANAGARI DIGIT ONE
(#x00968 . 2) ; DEVANAGARI DIGIT TWO
(#x00969 . 3) ; DEVANAGARI DIGIT THREE
(#x0096A . 4) ; DEVANAGARI DIGIT FOUR
(#x0096B . 5) ; DEVANAGARI DIGIT FIVE
(#x0096C . 6) ; DEVANAGARI DIGIT SIX
(#x0096D . 7) ; DEVANAGARI DIGIT SEVEN
(#x0096E . 8) ; DEVANAGARI DIGIT EIGHT
(#x0096F . 9) ; DEVANAGARI DIGIT NINE
(#x009E6 . 0) ; BENGALI DIGIT ZERO
(#x009E7 . 1) ; BENGALI DIGIT ONE
(#x009E8 . 2) ; BENGALI DIGIT TWO
(#x009E9 . 3) ; BENGALI DIGIT THREE
(#x009EA . 4) ; BENGALI DIGIT FOUR
(#x009EB . 5) ; BENGALI DIGIT FIVE
(#x009EC . 6) ; BENGALI DIGIT SIX
(#x009ED . 7) ; BENGALI DIGIT SEVEN
(#x009EE . 8) ; BENGALI DIGIT EIGHT
(#x009EF . 9) ; BENGALI DIGIT NINE
(#x00A66 . 0) ; GURMUKHI DIGIT ZERO
(#x00A67 . 1) ; GURMUKHI DIGIT ONE
(#x00A68 . 2) ; GURMUKHI DIGIT TWO
(#x00A69 . 3) ; GURMUKHI DIGIT THREE
(#x00A6A . 4) ; GURMUKHI DIGIT FOUR
(#x00A6B . 5) ; GURMUKHI DIGIT FIVE
(#x00A6C . 6) ; GURMUKHI DIGIT SIX
(#x00A6D . 7) ; GURMUKHI DIGIT SEVEN
(#x00A6E . 8) ; GURMUKHI DIGIT EIGHT
(#x00A6F . 9) ; GURMUKHI DIGIT NINE
(#x00AE6 . 0) ; GUJARATI DIGIT ZERO
(#x00AE7 . 1) ; GUJARATI DIGIT ONE
(#x00AE8 . 2) ; GUJARATI DIGIT TWO
(#x00AE9 . 3) ; GUJARATI DIGIT THREE
(#x00AEA . 4) ; GUJARATI DIGIT FOUR
(#x00AEB . 5) ; GUJARATI DIGIT FIVE
(#x00AEC . 6) ; GUJARATI DIGIT SIX
(#x00AED . 7) ; GUJARATI DIGIT SEVEN
(#x00AEE . 8) ; GUJARATI DIGIT EIGHT
(#x00AEF . 9) ; GUJARATI DIGIT NINE
(#x00B66 . 0) ; ORIYA DIGIT ZERO
(#x00B67 . 1) ; ORIYA DIGIT ONE
(#x00B68 . 2) ; ORIYA DIGIT TWO
(#x00B69 . 3) ; ORIYA DIGIT THREE
(#x00B6A . 4) ; ORIYA DIGIT FOUR
(#x00B6B . 5) ; ORIYA DIGIT FIVE
(#x00B6C . 6) ; ORIYA DIGIT SIX
(#x00B6D . 7) ; ORIYA DIGIT SEVEN
(#x00B6E . 8) ; ORIYA DIGIT EIGHT
(#x00B6F . 9) ; ORIYA DIGIT NINE
(#x00BE6 . 0) ; TAMIL DIGIT ZERO
(#x00BE7 . 1) ; TAMIL DIGIT ONE
(#x00BE8 . 2) ; TAMIL DIGIT TWO
(#x00BE9 . 3) ; TAMIL DIGIT THREE
(#x00BEA . 4) ; TAMIL DIGIT FOUR
(#x00BEB . 5) ; TAMIL DIGIT FIVE
(#x00BEC . 6) ; TAMIL DIGIT SIX
(#x00BED . 7) ; TAMIL DIGIT SEVEN
(#x00BEE . 8) ; TAMIL DIGIT EIGHT
(#x00BEF . 9) ; TAMIL DIGIT NINE
(#x00C66 . 0) ; TELUGU DIGIT ZERO
(#x00C67 . 1) ; TELUGU DIGIT ONE
(#x00C68 . 2) ; TELUGU DIGIT TWO
(#x00C69 . 3) ; TELUGU DIGIT THREE
(#x00C6A . 4) ; TELUGU DIGIT FOUR
(#x00C6B . 5) ; TELUGU DIGIT FIVE
(#x00C6C . 6) ; TELUGU DIGIT SIX
(#x00C6D . 7) ; TELUGU DIGIT SEVEN
(#x00C6E . 8) ; TELUGU DIGIT EIGHT
(#x00C6F . 9) ; TELUGU DIGIT NINE
(#x00CE6 . 0) ; KANNADA DIGIT ZERO
(#x00CE7 . 1) ; KANNADA DIGIT ONE
(#x00CE8 . 2) ; KANNADA DIGIT TWO
(#x00CE9 . 3) ; KANNADA DIGIT THREE
(#x00CEA . 4) ; KANNADA DIGIT FOUR
(#x00CEB . 5) ; KANNADA DIGIT FIVE
(#x00CEC . 6) ; KANNADA DIGIT SIX
(#x00CED . 7) ; KANNADA DIGIT SEVEN
(#x00CEE . 8) ; KANNADA DIGIT EIGHT
(#x00CEF . 9) ; KANNADA DIGIT NINE
(#x00D66 . 0) ; MALAYALAM DIGIT ZERO
(#x00D67 . 1) ; MALAYALAM DIGIT ONE
(#x00D68 . 2) ; MALAYALAM DIGIT TWO
(#x00D69 . 3) ; MALAYALAM DIGIT THREE
(#x00D6A . 4) ; MALAYALAM DIGIT FOUR
(#x00D6B . 5) ; MALAYALAM DIGIT FIVE
(#x00D6C . 6) ; MALAYALAM DIGIT SIX
(#x00D6D . 7) ; MALAYALAM DIGIT SEVEN
(#x00D6E . 8) ; MALAYALAM DIGIT EIGHT
(#x00D6F . 9) ; MALAYALAM DIGIT NINE
(#x00E50 . 0) ; THAI DIGIT ZERO
(#x00E51 . 1) ; THAI DIGIT ONE
(#x00E52 . 2) ; THAI DIGIT TWO
(#x00E53 . 3) ; THAI DIGIT THREE
(#x00E54 . 4) ; THAI DIGIT FOUR
(#x00E55 . 5) ; THAI DIGIT FIVE
(#x00E56 . 6) ; THAI DIGIT SIX
(#x00E57 . 7) ; THAI DIGIT SEVEN
(#x00E58 . 8) ; THAI DIGIT EIGHT
(#x00E59 . 9) ; THAI DIGIT NINE
(#x00ED0 . 0) ; LAO DIGIT ZERO
(#x00ED1 . 1) ; LAO DIGIT ONE
(#x00ED2 . 2) ; LAO DIGIT TWO
(#x00ED3 . 3) ; LAO DIGIT THREE
(#x00ED4 . 4) ; LAO DIGIT FOUR
(#x00ED5 . 5) ; LAO DIGIT FIVE
(#x00ED6 . 6) ; LAO DIGIT SIX
(#x00ED7 . 7) ; LAO DIGIT SEVEN
(#x00ED8 . 8) ; LAO DIGIT EIGHT
(#x00ED9 . 9) ; LAO DIGIT NINE
(#x00F20 . 0) ; TIBETAN DIGIT ZERO
(#x00F21 . 1) ; TIBETAN DIGIT ONE
(#x00F22 . 2) ; TIBETAN DIGIT TWO
(#x00F23 . 3) ; TIBETAN DIGIT THREE
(#x00F24 . 4) ; TIBETAN DIGIT FOUR
(#x00F25 . 5) ; TIBETAN DIGIT FIVE
(#x00F26 . 6) ; TIBETAN DIGIT SIX
(#x00F27 . 7) ; TIBETAN DIGIT SEVEN
(#x00F28 . 8) ; TIBETAN DIGIT EIGHT
(#x00F29 . 9) ; TIBETAN DIGIT NINE
(#x01040 . 0) ; MYANMAR DIGIT ZERO
(#x01041 . 1) ; MYANMAR DIGIT ONE
(#x01042 . 2) ; MYANMAR DIGIT TWO
(#x01043 . 3) ; MYANMAR DIGIT THREE
(#x01044 . 4) ; MYANMAR DIGIT FOUR
(#x01045 . 5) ; MYANMAR DIGIT FIVE
(#x01046 . 6) ; MYANMAR DIGIT SIX
(#x01047 . 7) ; MYANMAR DIGIT SEVEN
(#x01048 . 8) ; MYANMAR DIGIT EIGHT
(#x01049 . 9) ; MYANMAR DIGIT NINE
(#x01090 . 0) ; MYANMAR SHAN DIGIT ZERO
(#x01091 . 1) ; MYANMAR SHAN DIGIT ONE
(#x01092 . 2) ; MYANMAR SHAN DIGIT TWO
(#x01093 . 3) ; MYANMAR SHAN DIGIT THREE
(#x01094 . 4) ; MYANMAR SHAN DIGIT FOUR
(#x01095 . 5) ; MYANMAR SHAN DIGIT FIVE
(#x01096 . 6) ; MYANMAR SHAN DIGIT SIX
(#x01097 . 7) ; MYANMAR SHAN DIGIT SEVEN
(#x01098 . 8) ; MYANMAR SHAN DIGIT EIGHT
(#x01099 . 9) ; MYANMAR SHAN DIGIT NINE
(#x017E0 . 0) ; KHMER DIGIT ZERO
(#x017E1 . 1) ; KHMER DIGIT ONE
(#x017E2 . 2) ; KHMER DIGIT TWO
(#x017E3 . 3) ; KHMER DIGIT THREE
(#x017E4 . 4) ; KHMER DIGIT FOUR
(#x017E5 . 5) ; KHMER DIGIT FIVE
(#x017E6 . 6) ; KHMER DIGIT SIX
(#x017E7 . 7) ; KHMER DIGIT SEVEN
(#x017E8 . 8) ; KHMER DIGIT EIGHT
(#x017E9 . 9) ; KHMER DIGIT NINE
(#x01810 . 0) ; MONGOLIAN DIGIT ZERO
(#x01811 . 1) ; MONGOLIAN DIGIT ONE
(#x01812 . 2) ; MONGOLIAN DIGIT TWO
(#x01813 . 3) ; MONGOLIAN DIGIT THREE
(#x01814 . 4) ; MONGOLIAN DIGIT FOUR
(#x01815 . 5) ; MONGOLIAN DIGIT FIVE
(#x01816 . 6) ; MONGOLIAN DIGIT SIX
(#x01817 . 7) ; MONGOLIAN DIGIT SEVEN
(#x01818 . 8) ; MONGOLIAN DIGIT EIGHT
(#x01819 . 9) ; MONGOLIAN DIGIT NINE
(#x01946 . 0) ; LIMBU DIGIT ZERO
(#x01947 . 1) ; LIMBU DIGIT ONE
(#x01948 . 2) ; LIMBU DIGIT TWO
(#x01949 . 3) ; LIMBU DIGIT THREE
(#x0194A . 4) ; LIMBU DIGIT FOUR
(#x0194B . 5) ; LIMBU DIGIT FIVE
(#x0194C . 6) ; LIMBU DIGIT SIX
(#x0194D . 7) ; LIMBU DIGIT SEVEN
(#x0194E . 8) ; LIMBU DIGIT EIGHT
(#x0194F . 9) ; LIMBU DIGIT NINE
(#x019D0 . 0) ; NEW TAI LUE DIGIT ZERO
(#x019D1 . 1) ; NEW TAI LUE DIGIT ONE
(#x019D2 . 2) ; NEW TAI LUE DIGIT TWO
(#x019D3 . 3) ; NEW TAI LUE DIGIT THREE
(#x019D4 . 4) ; NEW TAI LUE DIGIT FOUR
(#x019D5 . 5) ; NEW TAI LUE DIGIT FIVE
(#x019D6 . 6) ; NEW TAI LUE DIGIT SIX
(#x019D7 . 7) ; NEW TAI LUE DIGIT SEVEN
(#x019D8 . 8) ; NEW TAI LUE DIGIT EIGHT
(#x019D9 . 9) ; NEW TAI LUE DIGIT NINE
(#x01A80 . 0) ; TAI THAM HORA DIGIT ZERO
(#x01A81 . 1) ; TAI THAM HORA DIGIT ONE
(#x01A82 . 2) ; TAI THAM HORA DIGIT TWO
(#x01A83 . 3) ; TAI THAM HORA DIGIT THREE
(#x01A84 . 4) ; TAI THAM HORA DIGIT FOUR
(#x01A85 . 5) ; TAI THAM HORA DIGIT FIVE
(#x01A86 . 6) ; TAI THAM HORA DIGIT SIX
(#x01A87 . 7) ; TAI THAM HORA DIGIT SEVEN
(#x01A88 . 8) ; TAI THAM HORA DIGIT EIGHT
(#x01A89 . 9) ; TAI THAM HORA DIGIT NINE
(#x01A90 . 0) ; TAI THAM THAM DIGIT ZERO
(#x01A91 . 1) ; TAI THAM THAM DIGIT ONE
(#x01A92 . 2) ; TAI THAM THAM DIGIT TWO
(#x01A93 . 3) ; TAI THAM THAM DIGIT THREE
(#x01A94 . 4) ; TAI THAM THAM DIGIT FOUR
(#x01A95 . 5) ; TAI THAM THAM DIGIT FIVE
(#x01A96 . 6) ; TAI THAM THAM DIGIT SIX
(#x01A97 . 7) ; TAI THAM THAM DIGIT SEVEN
(#x01A98 . 8) ; TAI THAM THAM DIGIT EIGHT
(#x01A99 . 9) ; TAI THAM THAM DIGIT NINE
(#x01B50 . 0) ; BALINESE DIGIT ZERO
(#x01B51 . 1) ; BALINESE DIGIT ONE
(#x01B52 . 2) ; BALINESE DIGIT TWO
(#x01B53 . 3) ; BALINESE DIGIT THREE
(#x01B54 . 4) ; BALINESE DIGIT FOUR
(#x01B55 . 5) ; BALINESE DIGIT FIVE
(#x01B56 . 6) ; BALINESE DIGIT SIX
(#x01B57 . 7) ; BALINESE DIGIT SEVEN
(#x01B58 . 8) ; BALINESE DIGIT EIGHT
(#x01B59 . 9) ; BALINESE DIGIT NINE
(#x01BB0 . 0) ; SUNDANESE DIGIT ZERO
(#x01BB1 . 1) ; SUNDANESE DIGIT ONE
(#x01BB2 . 2) ; SUNDANESE DIGIT TWO
(#x01BB3 . 3) ; SUNDANESE DIGIT THREE
(#x01BB4 . 4) ; SUNDANESE DIGIT FOUR
(#x01BB5 . 5) ; SUNDANESE DIGIT FIVE
(#x01BB6 . 6) ; SUNDANESE DIGIT SIX
(#x01BB7 . 7) ; SUNDANESE DIGIT SEVEN
(#x01BB8 . 8) ; SUNDANESE DIGIT EIGHT
(#x01BB9 . 9) ; SUNDANESE DIGIT NINE
(#x01C40 . 0) ; LEPCHA DIGIT ZERO
(#x01C41 . 1) ; LEPCHA DIGIT ONE
(#x01C42 . 2) ; LEPCHA DIGIT TWO
(#x01C43 . 3) ; LEPCHA DIGIT THREE
(#x01C44 . 4) ; LEPCHA DIGIT FOUR
(#x01C45 . 5) ; LEPCHA DIGIT FIVE
(#x01C46 . 6) ; LEPCHA DIGIT SIX
(#x01C47 . 7) ; LEPCHA DIGIT SEVEN
(#x01C48 . 8) ; LEPCHA DIGIT EIGHT
(#x01C49 . 9) ; LEPCHA DIGIT NINE
(#x01C50 . 0) ; OL CHIKI DIGIT ZERO
(#x01C51 . 1) ; OL CHIKI DIGIT ONE
(#x01C52 . 2) ; OL CHIKI DIGIT TWO
(#x01C53 . 3) ; OL CHIKI DIGIT THREE
(#x01C54 . 4) ; OL CHIKI DIGIT FOUR
(#x01C55 . 5) ; OL CHIKI DIGIT FIVE
(#x01C56 . 6) ; OL CHIKI DIGIT SIX
(#x01C57 . 7) ; OL CHIKI DIGIT SEVEN
(#x01C58 . 8) ; OL CHIKI DIGIT EIGHT
(#x01C59 . 9) ; OL CHIKI DIGIT NINE
(#x0A620 . 0) ; VAI DIGIT ZERO
(#x0A621 . 1) ; VAI DIGIT ONE
(#x0A622 . 2) ; VAI DIGIT TWO
(#x0A623 . 3) ; VAI DIGIT THREE
(#x0A624 . 4) ; VAI DIGIT FOUR
(#x0A625 . 5) ; VAI DIGIT FIVE
(#x0A626 . 6) ; VAI DIGIT SIX
(#x0A627 . 7) ; VAI DIGIT SEVEN
(#x0A628 . 8) ; VAI DIGIT EIGHT
(#x0A629 . 9) ; VAI DIGIT NINE
(#x0A8D0 . 0) ; SAURASHTRA DIGIT ZERO
(#x0A8D1 . 1) ; SAURASHTRA DIGIT ONE
(#x0A8D2 . 2) ; SAURASHTRA DIGIT TWO
(#x0A8D3 . 3) ; SAURASHTRA DIGIT THREE
(#x0A8D4 . 4) ; SAURASHTRA DIGIT FOUR
(#x0A8D5 . 5) ; SAURASHTRA DIGIT FIVE
(#x0A8D6 . 6) ; SAURASHTRA DIGIT SIX
(#x0A8D7 . 7) ; SAURASHTRA DIGIT SEVEN
(#x0A8D8 . 8) ; SAURASHTRA DIGIT EIGHT
(#x0A8D9 . 9) ; SAURASHTRA DIGIT NINE
(#x0A900 . 0) ; KAYAH LI DIGIT ZERO
(#x0A901 . 1) ; KAYAH LI DIGIT ONE
(#x0A902 . 2) ; KAYAH LI DIGIT TWO
(#x0A903 . 3) ; KAYAH LI DIGIT THREE
(#x0A904 . 4) ; KAYAH LI DIGIT FOUR
(#x0A905 . 5) ; KAYAH LI DIGIT FIVE
(#x0A906 . 6) ; KAYAH LI DIGIT SIX
(#x0A907 . 7) ; KAYAH LI DIGIT SEVEN
(#x0A908 . 8) ; KAYAH LI DIGIT EIGHT
(#x0A909 . 9) ; KAYAH LI DIGIT NINE
(#x0A9D0 . 0) ; JAVANESE DIGIT ZERO
(#x0A9D1 . 1) ; JAVANESE DIGIT ONE
(#x0A9D2 . 2) ; JAVANESE DIGIT TWO
(#x0A9D3 . 3) ; JAVANESE DIGIT THREE
(#x0A9D4 . 4) ; JAVANESE DIGIT FOUR
(#x0A9D5 . 5) ; JAVANESE DIGIT FIVE
(#x0A9D6 . 6) ; JAVANESE DIGIT SIX
(#x0A9D7 . 7) ; JAVANESE DIGIT SEVEN
(#x0A9D8 . 8) ; JAVANESE DIGIT EIGHT
(#x0A9D9 . 9) ; JAVANESE DIGIT NINE
(#x0AA50 . 0) ; CHAM DIGIT ZERO
(#x0AA51 . 1) ; CHAM DIGIT ONE
(#x0AA52 . 2) ; CHAM DIGIT TWO
(#x0AA53 . 3) ; CHAM DIGIT THREE
(#x0AA54 . 4) ; CHAM DIGIT FOUR
(#x0AA55 . 5) ; CHAM DIGIT FIVE
(#x0AA56 . 6) ; CHAM DIGIT SIX
(#x0AA57 . 7) ; CHAM DIGIT SEVEN
(#x0AA58 . 8) ; CHAM DIGIT EIGHT
(#x0AA59 . 9) ; CHAM DIGIT NINE
(#x0ABF0 . 0) ; MEETEI MAYEK DIGIT ZERO
(#x0ABF1 . 1) ; MEETEI MAYEK DIGIT ONE
(#x0ABF2 . 2) ; MEETEI MAYEK DIGIT TWO
(#x0ABF3 . 3) ; MEETEI MAYEK DIGIT THREE
(#x0ABF4 . 4) ; MEETEI MAYEK DIGIT FOUR
(#x0ABF5 . 5) ; MEETEI MAYEK DIGIT FIVE
(#x0ABF6 . 6) ; MEETEI MAYEK DIGIT SIX
(#x0ABF7 . 7) ; MEETEI MAYEK DIGIT SEVEN
(#x0ABF8 . 8) ; MEETEI MAYEK DIGIT EIGHT
(#x0ABF9 . 9) ; MEETEI MAYEK DIGIT NINE
(#x0FF10 . 0) ; FULLWIDTH DIGIT ZERO
(#x0FF11 . 1) ; FULLWIDTH DIGIT ONE
(#x0FF12 . 2) ; FULLWIDTH DIGIT TWO
(#x0FF13 . 3) ; FULLWIDTH DIGIT THREE
(#x0FF14 . 4) ; FULLWIDTH DIGIT FOUR
(#x0FF15 . 5) ; FULLWIDTH DIGIT FIVE
(#x0FF16 . 6) ; FULLWIDTH DIGIT SIX
(#x0FF17 . 7) ; FULLWIDTH DIGIT SEVEN
(#x0FF18 . 8) ; FULLWIDTH DIGIT EIGHT
(#x0FF19 . 9) ; FULLWIDTH DIGIT NINE
(#x104A0 . 0) ; OSMANYA DIGIT ZERO
(#x104A1 . 1) ; OSMANYA DIGIT ONE
(#x104A2 . 2) ; OSMANYA DIGIT TWO
(#x104A3 . 3) ; OSMANYA DIGIT THREE
(#x104A4 . 4) ; OSMANYA DIGIT FOUR
(#x104A5 . 5) ; OSMANYA DIGIT FIVE
(#x104A6 . 6) ; OSMANYA DIGIT SIX
(#x104A7 . 7) ; OSMANYA DIGIT SEVEN
(#x104A8 . 8) ; OSMANYA DIGIT EIGHT
(#x104A9 . 9) ; OSMANYA DIGIT NINE
(#x11066 . 0) ; BRAHMI DIGIT ZERO
(#x11067 . 1) ; BRAHMI DIGIT ONE
(#x11068 . 2) ; BRAHMI DIGIT TWO
(#x11069 . 3) ; BRAHMI DIGIT THREE
(#x1106A . 4) ; BRAHMI DIGIT FOUR
(#x1106B . 5) ; BRAHMI DIGIT FIVE
(#x1106C . 6) ; BRAHMI DIGIT SIX
(#x1106D . 7) ; BRAHMI DIGIT SEVEN
(#x1106E . 8) ; BRAHMI DIGIT EIGHT
(#x1106F . 9) ; BRAHMI DIGIT NINE
(#x110F0 . 0) ; SORA SOMPENG DIGIT ZERO
(#x110F1 . 1) ; SORA SOMPENG DIGIT ONE
(#x110F2 . 2) ; SORA SOMPENG DIGIT TWO
(#x110F3 . 3) ; SORA SOMPENG DIGIT THREE
(#x110F4 . 4) ; SORA SOMPENG DIGIT FOUR
(#x110F5 . 5) ; SORA SOMPENG DIGIT FIVE
(#x110F6 . 6) ; SORA SOMPENG DIGIT SIX
(#x110F7 . 7) ; SORA SOMPENG DIGIT SEVEN
(#x110F8 . 8) ; SORA SOMPENG DIGIT EIGHT
(#x110F9 . 9) ; SORA SOMPENG DIGIT NINE
(#x11136 . 0) ; CHAKMA DIGIT ZERO
(#x11137 . 1) ; CHAKMA DIGIT ONE
(#x11138 . 2) ; CHAKMA DIGIT TWO
(#x11139 . 3) ; CHAKMA DIGIT THREE
(#x1113A . 4) ; CHAKMA DIGIT FOUR
(#x1113B . 5) ; CHAKMA DIGIT FIVE
(#x1113C . 6) ; CHAKMA DIGIT SIX
(#x1113D . 7) ; CHAKMA DIGIT SEVEN
(#x1113E . 8) ; CHAKMA DIGIT EIGHT
(#x1113F . 9) ; CHAKMA DIGIT NINE
(#x111D0 . 0) ; SHARADA DIGIT ZERO
(#x111D1 . 1) ; SHARADA DIGIT ONE
(#x111D2 . 2) ; SHARADA DIGIT TWO
(#x111D3 . 3) ; SHARADA DIGIT THREE
(#x111D4 . 4) ; SHARADA DIGIT FOUR
(#x111D5 . 5) ; SHARADA DIGIT FIVE
(#x111D6 . 6) ; SHARADA DIGIT SIX
(#x111D7 . 7) ; SHARADA DIGIT SEVEN
(#x111D8 . 8) ; SHARADA DIGIT EIGHT
(#x111D9 . 9) ; SHARADA DIGIT NINE
(#x116C0 . 0) ; TAKRI DIGIT ZERO
(#x116C1 . 1) ; TAKRI DIGIT ONE
(#x116C2 . 2) ; TAKRI DIGIT TWO
(#x116C3 . 3) ; TAKRI DIGIT THREE
(#x116C4 . 4) ; TAKRI DIGIT FOUR
(#x116C5 . 5) ; TAKRI DIGIT FIVE
(#x116C6 . 6) ; TAKRI DIGIT SIX
(#x116C7 . 7) ; TAKRI DIGIT SEVEN
(#x116C8 . 8) ; TAKRI DIGIT EIGHT
(#x116C9 . 9) ; TAKRI DIGIT NINE
(#x1D7CE . 0) ; MATHEMATICAL BOLD DIGIT ZERO
(#x1D7CF . 1) ; MATHEMATICAL BOLD DIGIT ONE
(#x1D7D0 . 2) ; MATHEMATICAL BOLD DIGIT TWO
(#x1D7D1 . 3) ; MATHEMATICAL BOLD DIGIT THREE
(#x1D7D2 . 4) ; MATHEMATICAL BOLD DIGIT FOUR
(#x1D7D3 . 5) ; MATHEMATICAL BOLD DIGIT FIVE
(#x1D7D4 . 6) ; MATHEMATICAL BOLD DIGIT SIX
(#x1D7D5 . 7) ; MATHEMATICAL BOLD DIGIT SEVEN
(#x1D7D6 . 8) ; MATHEMATICAL BOLD DIGIT EIGHT
(#x1D7D7 . 9) ; MATHEMATICAL BOLD DIGIT NINE
(#x1D7D8 . 0) ; MATHEMATICAL DOUBLE-STRUCK DIGIT ZERO
(#x1D7D9 . 1) ; MATHEMATICAL DOUBLE-STRUCK DIGIT ONE
(#x1D7DA . 2) ; MATHEMATICAL DOUBLE-STRUCK DIGIT TWO
(#x1D7DB . 3) ; MATHEMATICAL DOUBLE-STRUCK DIGIT THREE
(#x1D7DC . 4) ; MATHEMATICAL DOUBLE-STRUCK DIGIT FOUR
(#x1D7DD . 5) ; MATHEMATICAL DOUBLE-STRUCK DIGIT FIVE
(#x1D7DE . 6) ; MATHEMATICAL DOUBLE-STRUCK DIGIT SIX
(#x1D7DF . 7) ; MATHEMATICAL DOUBLE-STRUCK DIGIT SEVEN
(#x1D7E0 . 8) ; MATHEMATICAL DOUBLE-STRUCK DIGIT EIGHT
(#x1D7E1 . 9) ; MATHEMATICAL DOUBLE-STRUCK DIGIT NINE
(#x1D7E2 . 0) ; MATHEMATICAL SANS-SERIF DIGIT ZERO
(#x1D7E3 . 1) ; MATHEMATICAL SANS-SERIF DIGIT ONE
(#x1D7E4 . 2) ; MATHEMATICAL SANS-SERIF DIGIT TWO
(#x1D7E5 . 3) ; MATHEMATICAL SANS-SERIF DIGIT THREE
(#x1D7E6 . 4) ; MATHEMATICAL SANS-SERIF DIGIT FOUR
(#x1D7E7 . 5) ; MATHEMATICAL SANS-SERIF DIGIT FIVE
(#x1D7E8 . 6) ; MATHEMATICAL SANS-SERIF DIGIT SIX
(#x1D7E9 . 7) ; MATHEMATICAL SANS-SERIF DIGIT SEVEN
(#x1D7EA . 8) ; MATHEMATICAL SANS-SERIF DIGIT EIGHT
(#x1D7EB . 9) ; MATHEMATICAL SANS-SERIF DIGIT NINE
(#x1D7EC . 0) ; MATHEMATICAL SANS-SERIF BOLD DIGIT ZERO
(#x1D7ED . 1) ; MATHEMATICAL SANS-SERIF BOLD DIGIT ONE
(#x1D7EE . 2) ; MATHEMATICAL SANS-SERIF BOLD DIGIT TWO
(#x1D7EF . 3) ; MATHEMATICAL SANS-SERIF BOLD DIGIT THREE
(#x1D7F0 . 4) ; MATHEMATICAL SANS-SERIF BOLD DIGIT FOUR
(#x1D7F1 . 5) ; MATHEMATICAL SANS-SERIF BOLD DIGIT FIVE
(#x1D7F2 . 6) ; MATHEMATICAL SANS-SERIF BOLD DIGIT SIX
(#x1D7F3 . 7) ; MATHEMATICAL SANS-SERIF BOLD DIGIT SEVEN
(#x1D7F4 . 8) ; MATHEMATICAL SANS-SERIF BOLD DIGIT EIGHT
(#x1D7F5 . 9) ; MATHEMATICAL SANS-SERIF BOLD DIGIT NINE
(#x1D7F6 . 0) ; MATHEMATICAL MONOSPACE DIGIT ZERO
(#x1D7F7 . 1) ; MATHEMATICAL MONOSPACE DIGIT ONE
(#x1D7F8 . 2) ; MATHEMATICAL MONOSPACE DIGIT TWO
(#x1D7F9 . 3) ; MATHEMATICAL MONOSPACE DIGIT THREE
(#x1D7FA . 4) ; MATHEMATICAL MONOSPACE DIGIT FOUR
(#x1D7FB . 5) ; MATHEMATICAL MONOSPACE DIGIT FIVE
(#x1D7FC . 6) ; MATHEMATICAL MONOSPACE DIGIT SIX
(#x1D7FD . 7) ; MATHEMATICAL MONOSPACE DIGIT SEVEN
(#x1D7FE . 8) ; MATHEMATICAL MONOSPACE DIGIT EIGHT
(#x1D7FF . 9))); MATHEMATICAL MONOSPACE DIGIT NINE
(num-digits (vector-length digit-table)))
(lambda (c)
(let ((ci (char->integer c)))
(let search ((lo 0) (hi num-digits))
(and (< lo hi)
(let* ((i (quotient (+ lo hi) 2))
(entry (vector-ref digit-table i))
(delta (- ci (car entry))))
(cond ((positive? delta)
(search (+ i 1) hi))
((negative? delta)
(search lo i))
(else (cdr entry))))))))))))

23
module/scheme/complex.scm Normal file
View file

@ -0,0 +1,23 @@
;;; complex.scm --- The R7RS complex library
;; Copyright (C) 2013 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 complex)
(export make-rectangular make-polar
real-part imag-part angle magnitude)
(import (rnrs base)))

24
module/scheme/cxr.scm Normal file
View file

@ -0,0 +1,24 @@
;;; cxr.scm --- The R7RS cxr 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 cxr)
(export caaar caadr cadar caddr cdaar cdadr cddar cdddr
caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr
cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr)
(import (rnrs base)))

32
module/scheme/eval.scm Normal file
View file

@ -0,0 +1,32 @@
;;; eval.scm --- The R7RS eval library
;; Copyright (C) 2013 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 eval)
(export eval environment)
(import (scheme base)
(only (guile)
eval
make-module
resolve-r6rs-interface
module-use-interfaces!))
(begin
(define (environment . import-sets)
(let ((m (make-module)))
(module-use-interfaces! m (map resolve-r6rs-interface import-sets))
m))))

35
module/scheme/file.scm Normal file
View file

@ -0,0 +1,35 @@
;;; file.scm --- The R7RS file library
;; Copyright (C) 2013 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 file)
(export open-input-file open-output-file
open-binary-input-file open-binary-output-file
call-with-input-file call-with-output-file
with-input-from-file with-output-to-file
delete-file file-exists?)
(import (scheme base)
(rnrs io simple)
(rnrs files)
(rename (only (guile) open-file)
(open-file guile-open-file)))
(begin
(define (open-binary-input-file filename)
(guile-open-file filename "rb"))
(define (open-binary-output-file filename)
(guile-open-file filename "wb"))))

36
module/scheme/inexact.scm Normal file
View file

@ -0,0 +1,36 @@
;;; inexact.scm --- The R7RS inexact library
;; Copyright (C) 2013 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 inexact)
(export acos asin atan cos sin tan
log exp sqrt finite? infinite? nan?)
(import (rename (rnrs base)
(finite? r6rs-finite?)
(infinite? r6rs-infinite?)
(nan? r6rs-nan?)))
(begin
(define (finite? z)
(and (r6rs-finite? (real-part z))
(r6rs-finite? (imag-part z))))
(define (infinite? z)
(or (r6rs-infinite? (real-part z))
(r6rs-infinite? (imag-part z))))
(define (nan? z)
(or (r6rs-nan? (real-part z))
(r6rs-nan? (imag-part z))))))

24
module/scheme/lazy.scm Normal file
View file

@ -0,0 +1,24 @@
;;; lazy.scm --- The R7RS lazy 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 lazy)
(export promise? delay force make-promise delay-force)
(import (rename (srfi srfi-45)
(eager make-promise)
(lazy delay-force))))

36
module/scheme/load.scm Normal file
View file

@ -0,0 +1,36 @@
;;; load.scm --- The R7RS load library
;; Copyright (C) 2013 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 load)
(export load)
(import (scheme base)
(scheme eval)
(scheme repl)
(rename (only (guile)
define*
load
save-module-excursion
set-current-module)
(load guile-load)))
(begin
(define* (load filename #:optional (env (interaction-environment)))
(save-module-excursion
(lambda ()
(set-current-module env)
(guile-load filename))))))

42
module/scheme/process-context.scm Normal file
View file

@ -0,0 +1,42 @@
;;; process-context.scm --- The R7RS process-context library
;; Copyright (C) 2013 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 process-context)
(export command-line
exit
emergency-exit
get-environment-variable
get-environment-variables)
(import (scheme base)
(only (srfi srfi-13) string-index)
(rename (only (guile)
command-line
exit primitive-_exit
getenv environ)
(primitive-_exit emergency-exit)
(getenv get-environment-variable)))
(begin
(define (get-environment-variables)
(map (lambda (s)
(let ((i (string-index s #\=)))
(cons (substring s 0 i)
(substring s (+ i 1) (string-length s)))))
(environ)))))

72
module/scheme/r5rs.scm Normal file
View file

@ -0,0 +1,72 @@
;;; r5rs.scm --- The R7RS r5rs 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 r5rs)
(export * + - / < <= = > >=
abs acos and angle append apply asin assoc assq assv atan begin
boolean? car cdr caar cadr cdar cddr
caaar caadr cadar caddr cdaar cdadr cddar cdddr
caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr
cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr
call-with-current-continuation call-with-input-file
call-with-output-file call-with-values case 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 eof-object? eq? equal? eqv?
eval even? exact? exact->inexact exp expt floor for-each force gcd
if imag-part inexact? inexact->exact 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? 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?)
(import (rename (scheme base)
(exact inexact->exact)
(inexact exact->inexact))
(scheme read)
(scheme write)
(scheme file)
(scheme lazy)
(scheme inexact)
(scheme complex)
(scheme char)
(scheme cxr)
(scheme eval)
(scheme repl)
(scheme load)
(only (ice-9 r5rs)
scheme-report-environment)
(only (ice-9 safe-r5rs)
null-environment)))

22
module/scheme/read.scm Normal file
View file

@ -0,0 +1,22 @@
;;; read.scm --- The R7RS read library
;; Copyright (C) 2013 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 read)
(export read)
(import (only (guile) read)))

22
module/scheme/repl.scm Normal file
View file

@ -0,0 +1,22 @@
;;; repl.scm --- The R7RS repl library
;; Copyright (C) 2013 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 repl)
(export interaction-environment)
(import (only (guile) interaction-environment)))

34
module/scheme/time.scm Normal file
View file

@ -0,0 +1,34 @@
;;; time.scm --- The R7RS time 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 time)
(export current-second current-jiffy jiffies-per-second)
(import (scheme base)
(srfi srfi-19)
(rename (only (guile)
internal-time-units-per-second
get-internal-real-time)
(get-internal-real-time current-jiffy)))
(begin
(define (current-second)
(let ((time (current-time time-tai)))
(+ (time-second time)
(* 1e-9 (time-nanosecond time)))))
(define (jiffies-per-second)
internal-time-units-per-second)))

38
module/scheme/write.scm Normal file
View file

@ -0,0 +1,38 @@
;;; write.scm --- The R7RS write 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 write)
(export display
write
write-shared
write-simple)
(import (scheme base)
(rename (only (guile)
display
write)
(write guile-write)))
(begin
(define write-simple guile-write)
;; XXX FIXME outputs cyclic data in non-standard format.
(define write guile-write)
;; XXX FIXME doesn't show non-cyclic sharing, and outputs cyclic
;; data in non-standard format.
(define write-shared guile-write)))