diff --git a/lib/chibi/binary-record.sld b/lib/chibi/binary-record.sld index cd84b3d3..ce36653a 100644 --- a/lib/chibi/binary-record.sld +++ b/lib/chibi/binary-record.sld @@ -1,8 +1,11 @@ (define-library (chibi binary-record) (import (scheme base) - (srfi 1) (srfi 9) (srfi 33) + (srfi 1) (srfi 9) (chibi io) (chibi string) (only (chibi) identifier? er-macro-transformer)) + (cond-expand + ((library (srfi 60)) (import (srfi 60))) + (else (import (srfi 33)))) (export define-binary-record-type) (include "binary-record.scm")) diff --git a/lib/chibi/bytevector.sld b/lib/chibi/bytevector.sld index 1923cc02..44a62549 100644 --- a/lib/chibi/bytevector.sld +++ b/lib/chibi/bytevector.sld @@ -7,5 +7,8 @@ integer->bytevector bytevector->integer integer->hex-string hex-string->integer bytevector->hex-string hex-string->bytevector) - (import (scheme base) (srfi 33)) + (import (scheme base)) + (cond-expand + ((library (srfi 60)) (import (srfi 60))) + (else (import (srfi 33)))) (include "bytevector.scm")) diff --git a/lib/chibi/channel.sld b/lib/chibi/channel.sld index 435aca1b..1f71f60f 100644 --- a/lib/chibi/channel.sld +++ b/lib/chibi/channel.sld @@ -1,6 +1,9 @@ (define-library (chibi channel) - (import (chibi) (srfi 9) (srfi 18)) + (cond-expand + (chibi (import (chibi) (srfi 9))) + (else (import (scheme base)))) + (import (srfi 18)) (export Channel make-channel channel? channel-empty? channel-send! channel-receive!) (include "channel.scm")) diff --git a/lib/chibi/char-set.sld b/lib/chibi/char-set.sld index 4889e33a..12598914 100644 --- a/lib/chibi/char-set.sld +++ b/lib/chibi/char-set.sld @@ -1,6 +1,6 @@ (define-library (chibi char-set) - (import (chibi) (chibi char-set base) (chibi char-set extras)) + (import (chibi char-set base) (chibi char-set extras)) (export Char-Set char-set? char-set-contains? char-set ucs-range->char-set char-set-copy char-set-size diff --git a/lib/chibi/char-set/base.sld b/lib/chibi/char-set/base.sld index 62cde5a4..6c247e8b 100644 --- a/lib/chibi/char-set/base.sld +++ b/lib/chibi/char-set/base.sld @@ -1,14 +1,23 @@ (define-library (chibi char-set base) - (import (chibi) (chibi iset base)) + (cond-expand + (chibi + (import (chibi)) + (begin + (define-syntax immutable-char-set + (sc-macro-transformer + (lambda (expr use-env) + (eval (cadr expr) use-env)))))) + (else + (import (scheme base)) + (begin + (define-syntax immutable-char-set + (syntax-rules () ((immutable-char-set cs) cs)))))) + (import (chibi iset base)) (export (rename Integer-Set Char-Set) (rename iset? char-set?) immutable-char-set char-set-contains?) (begin - (define-syntax immutable-char-set - (sc-macro-transformer - (lambda (expr use-env) - (eval (cadr expr) use-env)))) (define (char-set-contains? cset ch) (iset-contains? cset (char->integer ch))))) diff --git a/lib/chibi/char-set/boundary.sld b/lib/chibi/char-set/boundary.sld index a870d4a9..4898c58e 100644 --- a/lib/chibi/char-set/boundary.sld +++ b/lib/chibi/char-set/boundary.sld @@ -4,10 +4,12 @@ (define-library (chibi char-set boundary) (cond-expand - (chibi - (import (chibi) (chibi char-set))) + (chibi (import (chibi))) + (else (import (scheme base)))) + (cond-expand + ((library (chibi char-set)) (import (chibi char-set))) (else - (import (scheme base) (srfi 14)) + (import (srfi 14)) (begin (define (immutable-char-set cs) cs)))) (export char-set:regional-indicator char-set:extend-or-spacing-mark diff --git a/lib/chibi/char-set/extras.sld b/lib/chibi/char-set/extras.sld index ccfc812f..5acbdc8a 100644 --- a/lib/chibi/char-set/extras.sld +++ b/lib/chibi/char-set/extras.sld @@ -1,6 +1,9 @@ (define-library (chibi char-set extras) - (import (chibi) (chibi iset) (chibi char-set base)) + (cond-expand + (chibi (import (chibi))) + (else (import (scheme base)))) + (import (chibi iset) (chibi char-set base)) (include "extras.scm") (export char-set ucs-range->char-set char-set-copy char-set-size diff --git a/lib/chibi/crypto/md5.sld b/lib/chibi/crypto/md5.sld index 08851ef3..47872136 100644 --- a/lib/chibi/crypto/md5.sld +++ b/lib/chibi/crypto/md5.sld @@ -1,5 +1,8 @@ (define-library (chibi crypto md5) - (import (scheme base) (srfi 33) (chibi bytevector)) + (import (scheme base) (chibi bytevector)) + (cond-expand + ((library (srfi 60)) (import (srfi 60))) + (else (import (srfi 33)))) (export md5) (include "md5.scm")) diff --git a/lib/chibi/crypto/rsa.sld b/lib/chibi/crypto/rsa.sld index 484c6170..d3f1a99c 100644 --- a/lib/chibi/crypto/rsa.sld +++ b/lib/chibi/crypto/rsa.sld @@ -1,7 +1,10 @@ (define-library (chibi crypto rsa) - (import (scheme base) (srfi 27) (srfi 33) + (import (scheme base) (srfi 27) (chibi bytevector) (chibi math prime)) + (cond-expand + ((library (srfi 60)) (import (srfi 60))) + (else (import (srfi 33)))) (export make-rsa-key rsa-key-gen rsa-key-gen-from-primes rsa-pub-key rsa-encrypt rsa-decrypt rsa-sign rsa-verify rsa-verify? rsa-key? rsa-key-bits rsa-key-n rsa-key-e rsa-key-d diff --git a/lib/chibi/crypto/sha2.sld b/lib/chibi/crypto/sha2.sld index f1d4d797..a08c09a7 100644 --- a/lib/chibi/crypto/sha2.sld +++ b/lib/chibi/crypto/sha2.sld @@ -7,7 +7,10 @@ (include "sha2-native.scm") (include-shared "crypto")) (else - (import (srfi 33) (chibi bytevector)) + (cond-expand + ((library (srfi 60)) (import (srfi 60))) + (else (import (srfi 33)))) + (import (chibi bytevector)) (include "sha2.scm")))) ;;> \procedure{(sha-224 src)} diff --git a/lib/chibi/filesystem-test.sld b/lib/chibi/filesystem-test.sld index 4a762fb8..83bad803 100644 --- a/lib/chibi/filesystem-test.sld +++ b/lib/chibi/filesystem-test.sld @@ -3,13 +3,13 @@ (import (chibi) (chibi io) (chibi filesystem) (chibi test) (srfi 33)) (begin (define (run-tests) - (test-begin "filesystem") - (define tmp-file "/tmp/chibi-fs-test-0123456789") (define tmp-file2 "/tmp/chibi-fs-test-0123456789-2") (define tmp-link "/tmp/chibi-fs-test-0123456789-link") (define tmp-dir "/tmp/chibi-fs-test-0123456789-dir") + (test-begin "filesystem") + (call-with-output-file tmp-file (lambda (out) (display "0123456789" out))) diff --git a/lib/chibi/generic-test.sld b/lib/chibi/generic-test.sld index 62543bf6..0f27e3af 100644 --- a/lib/chibi/generic-test.sld +++ b/lib/chibi/generic-test.sld @@ -1,4 +1,4 @@ -(define-library (chibi filesystem-test) +(define-library (chibi generic-test) (export run-tests) (import (chibi) (chibi generic) (chibi test)) (begin diff --git a/lib/chibi/iset-test.sld b/lib/chibi/iset-test.sld index 03262360..5c25a64a 100644 --- a/lib/chibi/iset-test.sld +++ b/lib/chibi/iset-test.sld @@ -1,16 +1,19 @@ (define-library (chibi iset-test) (export run-tests) - (import (chibi) (chibi iset) (chibi iset optimize) (srfi 1) (chibi test)) + (import (scheme base) (scheme write) + (except (srfi 1) make-list list-copy) + (chibi iset) (chibi iset optimize) + (chibi test)) (begin (define (run-tests) (define (test-name iset op) - (call-with-output-string - (lambda (out) - (let* ((ls (iset->list iset)) - (ls (if (> (length ls) 10) - `(,@(take ls 5) ... ,@(take-right ls 5)) - ls))) - (write `(,(car op) (iset ,@ls) ,@(cdr op)) out))))) + (let ((out (open-output-string))) + (let* ((ls (iset->list iset)) + (ls (if (> (length ls) 10) + `(,@(take ls 5) ... ,@(take-right ls 5)) + ls))) + (write `(,(car op) (iset ,@ls) ,@(cdr op)) out) + (get-output-string out)))) (test-begin "iset") @@ -122,10 +125,10 @@ ;; initial creation and sanity checks (test-assert (lset= equal? ls2 (iset->list is))) (test (length ls2) (iset-size is)) - (test-assert (call-with-output-string - (lambda (out) - (display "init: " out) - (write ls out))) + (test-assert (let ((out (open-output-string))) + (display "init: " out) + (write ls out) + (get-output-string out)) (every (lambda (x) (iset-contains? is x)) ls)) diff --git a/lib/chibi/iset.sld b/lib/chibi/iset.sld index eb7e4763..9ea3e6d5 100644 --- a/lib/chibi/iset.sld +++ b/lib/chibi/iset.sld @@ -68,7 +68,7 @@ (chibi iset constructors)) (export %make-iset make-iset iset? iset-contains? Integer-Set - iset iset-copy list->iset list->iset! iset-map + iset iset-copy list->iset list->iset! iset-adjoin iset-adjoin! iset-delete iset-delete! iset-union iset-union! iset-intersection iset-intersection! iset-difference iset-difference! diff --git a/lib/chibi/iset/base.sld b/lib/chibi/iset/base.sld index 28c3eefc..2ef9bc9d 100644 --- a/lib/chibi/iset/base.sld +++ b/lib/chibi/iset/base.sld @@ -1,6 +1,11 @@ (define-library (chibi iset base) - (import (chibi) (srfi 9) (srfi 33)) + (cond-expand + (chibi (import (chibi) (srfi 9))) + (else (import (scheme base)))) + (cond-expand + ((library (srfi 60)) (import (srfi 60))) + (else (import (srfi 33)))) (include "base.scm") (export %make-iset make-iset iset? iset-contains? Integer-Set diff --git a/lib/chibi/iset/constructors.sld b/lib/chibi/iset/constructors.sld index c0f82117..48b5682a 100644 --- a/lib/chibi/iset/constructors.sld +++ b/lib/chibi/iset/constructors.sld @@ -1,6 +1,12 @@ (define-library (chibi iset constructors) - (import (chibi) (srfi 33) (chibi iset base) (chibi iset iterators)) + (cond-expand + (chibi (import (chibi))) + (else (import (scheme base)))) + (import (chibi iset base) (chibi iset iterators)) + (cond-expand + ((library (srfi 60)) (import (srfi 60))) + (else (import (srfi 33)))) (include "constructors.scm") (export iset iset-copy list->iset list->iset! iset-map diff --git a/lib/chibi/iset/iterators.sld b/lib/chibi/iset/iterators.sld index f6abc637..3deb9e2f 100644 --- a/lib/chibi/iset/iterators.sld +++ b/lib/chibi/iset/iterators.sld @@ -1,6 +1,12 @@ (define-library (chibi iset iterators) - (import (chibi) (srfi 9) (srfi 33) (chibi iset base)) + (cond-expand + (chibi (import (chibi) (srfi 9))) + (else (import (scheme base)))) + (import (chibi iset base)) + (cond-expand + ((library (srfi 60)) (import (srfi 60))) + (else (import (srfi 33)))) (include "iterators.scm") (export iset-empty? iset-fold iset-fold-node iset-for-each iset-for-each-node diff --git a/lib/chibi/iset/optimize.sld b/lib/chibi/iset/optimize.sld index e9165a00..4d923a51 100644 --- a/lib/chibi/iset/optimize.sld +++ b/lib/chibi/iset/optimize.sld @@ -1,9 +1,19 @@ (define-library (chibi iset optimize) - (import (chibi) (srfi 9) (srfi 33) - (chibi iset base) + (cond-expand + (chibi (import (chibi) (srfi 9))) + (else (import (scheme base)))) + (import (chibi iset base) (chibi iset iterators) (chibi iset constructors)) + (cond-expand + ((library (srfi 60)) (import (srfi 60))) + (else + (import (srfi 33)) + (begin + (define (%mask size) (bitwise-not (arithmetic-shift -1 size))) + (define (extract-bit-field size position n) + (bitwise-and (%mask size) (arithmetic-shift n (- position))))))) (include "optimize.scm") (export iset-balance iset-balance! iset-optimize iset-optimize! iset->code)) diff --git a/lib/chibi/math/prime.sld b/lib/chibi/math/prime.sld index 61474975..08b40250 100644 --- a/lib/chibi/math/prime.sld +++ b/lib/chibi/math/prime.sld @@ -1,6 +1,9 @@ (define-library (chibi math prime) - (import (scheme base) (scheme inexact) (srfi 27) (srfi 33)) + (import (scheme base) (scheme inexact) (srfi 27)) + (cond-expand + ((library (srfi 60)) (import (srfi 60))) + (else (import (srfi 33)))) (export prime? nth-prime prime-above prime-below factor perfect? totient aliquot provable-prime? probable-prime? diff --git a/lib/chibi/parse-test.sld b/lib/chibi/parse-test.sld index 44d4b377..c0610672 100644 --- a/lib/chibi/parse-test.sld +++ b/lib/chibi/parse-test.sld @@ -1,8 +1,10 @@ (define-library (chibi parse-test) (export run-tests) - (import (chibi) (chibi test) - (chibi char-set) (chibi char-set ascii) - (chibi parse) (chibi parse common)) + (import (scheme base) (scheme char) + (chibi test) (chibi parse) (chibi parse common)) + (cond-expand + (chibi (import (chibi char-set) (chibi char-set ascii))) + (else (import (srfi 14)))) (begin (define (run-tests) (test-begin "parse") @@ -73,68 +75,73 @@ ;; partial match (grammar isn't checking end) (test 42 (parse term "42*"))) - (define calculator - (grammar expr - (space ((: ,char-set:whitespace ,space)) - (() #f)) - (digit ((=> d ,char-set:digit) d)) - (number ((=> n (+ ,digit)) - (string->number (list->string n)))) - (simple ((=> n ,number) n) - ((: "(" (=> e1 ,expr) ")") e1)) - (term-op ("*" *) - ("/" /) - ("%" modulo)) - (term ((: (=> e1 ,simple) ,space (=> op ,term-op) ,space (=> e2 ,term)) - (op e1 e2)) - ((=> e1 ,simple) - e1)) - (expr-op ("+" +) ("-" -)) - (expr ((: ,space (=> e1 ,term) ,space (=> op ,expr-op) ,space (=> e2 ,expr)) - (op e1 e2)) - ((: ,space (=> e1 ,term)) - e1)))) + (let () + (define calculator + (grammar expr + (space ((: ,char-set:whitespace ,space)) + (() #f)) + (digit ((=> d ,char-set:digit) d)) + (number ((=> n (+ ,digit)) + (string->number (list->string n)))) + (simple ((=> n ,number) n) + ((: "(" (=> e1 ,expr) ")") e1)) + (term-op ("*" *) + ("/" /) + ("%" modulo)) + (term ((: (=> e1 ,simple) ,space (=> op ,term-op) ,space + (=> e2 ,term)) + (op e1 e2)) + ((=> e1 ,simple) + e1)) + (expr-op ("+" +) ("-" -)) + (expr ((: ,space (=> e1 ,term) ,space (=> op ,expr-op) ,space + (=> e2 ,expr)) + (op e1 e2)) + ((: ,space (=> e1 ,term)) + e1)))) - (test 42 (parse calculator "42")) - (test 4 (parse calculator "2 + 2")) - (test 23 (parse calculator "2 + 2*10 + 1")) - (test 25 (parse calculator "2+2 * 10+1 * 3")) - (test 41 (parse calculator "(2 + 2) * 10 + 1")) + (test 42 (parse calculator "42")) + (test 4 (parse calculator "2 + 2")) + (test 23 (parse calculator "2 + 2*10 + 1")) + (test 25 (parse calculator "2+2 * 10+1 * 3")) + (test 41 (parse calculator "(2 + 2) * 10 + 1"))) - (define prec-calc - (grammar expr - (simple (,(parse-integer)) - ((: "(" (=> e1 ,expr) ")") e1)) - (op - ("+" '+) ("-" '-) ("*" '*) ("/" '/) ("^" '^)) - (expr - (,(parse-binary-op op - `((+ 5) (- 5) (* 3) (/ 3) (^ 1 right)) - simple))))) + (let () + (define prec-calc + (grammar expr + (simple (,(parse-integer)) + ((: "(" (=> e1 ,expr) ")") e1)) + (op + ("+" '+) ("-" '-) ("*" '*) ("/" '/) ("^" '^)) + (expr + (,(parse-binary-op op + `((+ 5) (- 5) (* 3) (/ 3) (^ 1 right)) + simple))))) - (test 42 (parse prec-calc "42")) - (test '(+ 2 2) (parse prec-calc "2 + 2")) - (test '(+ (+ 2 2) 2) (parse prec-calc "2 + 2 + 2")) - (test '(+ (+ 2 (* 2 10)) 1) (parse prec-calc "2 + 2*10 + 1")) - (test '(+ (+ 2 (* 2 10)) (* 1 3)) (parse prec-calc "2+2 * 10+1 * 3")) - (test '(+ (* (+ 2 2) 10) 1) (parse prec-calc "(2 + 2) * 10 + 1")) - (test '(^ 2 (^ 2 2)) (parse prec-calc "2 ^ 2 ^ 2")) - (test '(+ (+ (+ 1 (* (* 2 (^ 3 (^ 4 5))) 6)) (^ 7 8)) 9) - (parse prec-calc "1 + 2 * 3 ^ 4 ^ 5 * 6 + 7 ^ 8 + 9")) + (test 42 (parse prec-calc "42")) + (test '(+ 2 2) (parse prec-calc "2 + 2")) + (test '(+ (+ 2 2) 2) (parse prec-calc "2 + 2 + 2")) + (test '(+ (+ 2 (* 2 10)) 1) (parse prec-calc "2 + 2*10 + 1")) + (test '(+ (+ 2 (* 2 10)) (* 1 3)) (parse prec-calc "2+2 * 10+1 * 3")) + (test '(+ (* (+ 2 2) 10) 1) (parse prec-calc "(2 + 2) * 10 + 1")) + (test '(^ 2 (^ 2 2)) (parse prec-calc "2 ^ 2 ^ 2")) + (test '(+ (+ (+ 1 (* (* 2 (^ 3 (^ 4 5))) 6)) (^ 7 8)) 9) + (parse prec-calc "1 + 2 * 3 ^ 4 ^ 5 * 6 + 7 ^ 8 + 9"))) ;; this takes exponential time without memoization - (define explode - (grammar start - (start ((: ,S eos) #t)) - (S ((+ ,A) #t)) - (A ((: "a" ,S "b") #t) - ((: "a" ,S "c") #t) - ((: "a") #t)))) + (let () + (define explode + (grammar start + (start ((: ,S eos) #t)) + (S ((+ ,A) #t)) + (A ((: "a" ,S "b") #t) + ((: "a" ,S "c") #t) + ((: "a") #t)))) - (test-assert (parse explode "aaabb")) - (test-not (parse explode "bbaa")) - (test-assert - (parse explode - (string-append (make-string 10 #\a) (make-string 8 #\c)))) + (test-assert (parse explode "aaabb")) + (test-not (parse explode "bbaa")) + (test-assert + (parse explode + (string-append (make-string 10 #\a) (make-string 8 #\c))))) (test-end)))) diff --git a/lib/chibi/parse.sld b/lib/chibi/parse.sld index 3106b1db..b06a4086 100644 --- a/lib/chibi/parse.sld +++ b/lib/chibi/parse.sld @@ -14,15 +14,13 @@ parse-string parse-token parse-sre parse-beginning parse-end parse-beginning-of-line parse-end-of-line - parse-beginning-of-line parse-end-of-line parse-beginning-of-word parse-end-of-word parse-word parse-word+ parse-with-failure-reason make-parse-stream) - (import (chibi) (chibi char-set) (srfi 9)) - (include "parse/parse.scm") (cond-expand (chibi + (import (chibi) (chibi char-set) (srfi 9)) (begin (define-syntax grammar-bind (er-macro-transformer @@ -59,6 +57,7 @@ (cons (list name new-tmp) bindings)))) (append k (list f bindings))))))))) (else + (import (scheme base) (scheme char) (scheme file) (srfi 14)) (begin (define-syntax grammar-bind (syntax-rules () @@ -77,4 +76,5 @@ (lambda (r s i fk) (set! new-tmp r) (sk r s i fk)) (lambda (s i r) (set! new-tmp save-tmp) (fk s i r))))) ((var tmp) ... (name new-tmp))) - (k ... f ((var tmp) ...))))))))))) + (k ... f ((var tmp) ...)))))))))) + (include "parse/parse.scm")) diff --git a/lib/chibi/parse/common.sld b/lib/chibi/parse/common.sld index 08a6ca4d..15365abf 100644 --- a/lib/chibi/parse/common.sld +++ b/lib/chibi/parse/common.sld @@ -7,5 +7,8 @@ parse-ipv4-address parse-ipv6-address parse-ip-address parse-domain parse-common-domain parse-email parse-uri char-hex-digit? char-octal-digit?) - (import (chibi) (chibi parse)) + (cond-expand + (chibi (import (chibi))) + (else (import (scheme base) (scheme char)))) + (import (chibi parse)) (include "common.scm")) diff --git a/lib/chibi/pathname-test.sld b/lib/chibi/pathname-test.sld index 8c3bec1d..d7235ee8 100644 --- a/lib/chibi/pathname-test.sld +++ b/lib/chibi/pathname-test.sld @@ -1,6 +1,6 @@ (define-library (chibi pathname-test) (export run-tests) - (import (chibi) (chibi pathname) (chibi test)) + (import (scheme base) (chibi pathname) (chibi test)) (begin (define (run-tests) (test-begin "pathname") diff --git a/lib/chibi/pathname.scm b/lib/chibi/pathname.scm index 306a4d27..b284df18 100644 --- a/lib/chibi/pathname.scm +++ b/lib/chibi/pathname.scm @@ -80,7 +80,7 @@ (define (path-strip-leading-parents path) (if (string-prefix? "../" path) - (path-strip-leading-parents (substring path 3)) + (path-strip-leading-parents (substring-cursor path 3)) (if (equal? path "..") "" path))) ;;> Returns \scheme{#t} iff \var{path} is an absolute path, diff --git a/lib/chibi/pathname.sld b/lib/chibi/pathname.sld index 4c0e950a..75e77409 100644 --- a/lib/chibi/pathname.sld +++ b/lib/chibi/pathname.sld @@ -4,5 +4,8 @@ path-extension path-strip-extension path-replace-extension path-absolute? path-relative? path-strip-leading-parents path-relative-to path-resolve path-normalize make-path) - (import (chibi) (chibi string)) + (cond-expand + (chibi (import (chibi))) + (else (import (except (scheme base) string-map string-for-each)))) + (import (chibi string)) (include "pathname.scm")) diff --git a/lib/chibi/regexp.sld b/lib/chibi/regexp.sld index e8f49e1f..ddf1d61e 100644 --- a/lib/chibi/regexp.sld +++ b/lib/chibi/regexp.sld @@ -8,7 +8,10 @@ regexp-match-submatch regexp-match-submatch/list regexp-match-submatch-start regexp-match-submatch-end regexp-match->list regexp-match->sexp) - (import (srfi 33) (srfi 69)) + (import (srfi 69)) + (cond-expand + ((library (srfi 60)) (import (srfi 60))) + (else (import (srfi 33)))) ;; Chibi's char-set library is more factored than SRFI-14. (cond-expand (chibi diff --git a/lib/chibi/regexp/pcre.sld b/lib/chibi/regexp/pcre.sld index 795220ae..7deaee3f 100644 --- a/lib/chibi/regexp/pcre.sld +++ b/lib/chibi/regexp/pcre.sld @@ -2,6 +2,9 @@ (define-library (chibi regexp pcre) (export pcre->sre pcre->regexp) (import (scheme base) (scheme char) (scheme cxr) - (srfi 1) (srfi 33) + (srfi 1) (chibi string) (chibi regexp)) + (cond-expand + ((library (srfi 60)) (import (srfi 60))) + (else (import (srfi 33)))) (include "pcre.scm")) diff --git a/lib/chibi/scribble-test.sld b/lib/chibi/scribble-test.sld index ad57d402..7762aa0b 100644 --- a/lib/chibi/scribble-test.sld +++ b/lib/chibi/scribble-test.sld @@ -1,16 +1,22 @@ (define-library (chibi scribble-test) (export run-tests) - (import (chibi) (chibi scribble) (only (chibi test) test-begin test test-end)) + (import (scheme base) (scheme write) (chibi scribble) + (only (chibi test) test-begin test test-end)) (begin + (define (call-with-output-string proc) + (let ((out (open-output-string))) + (proc out) + (get-output-string out))) + (define (call-with-input-string str proc) + (proc (open-input-string str))) + (define (test-scribble expect str) + (test (call-with-output-string (lambda (out) (write str out))) + expect + (call-with-input-string str scribble-parse))) (define (run-tests) (test-begin "scribble") - (define (test-scribble expect str) - (test (call-with-output-string (lambda (out) (write str out))) - expect - (call-with-input-string str scribble-parse))) - (test-scribble '((foo "blah blah blah")) "\\foo{blah blah blah}") (test-scribble '((foo "blah \"blah\" (`blah'?)")) "\\foo{blah \"blah\" (`blah'?)}") (test-scribble '((foo 1 2 "3 4")) "\\foo[1 2]{3 4}") diff --git a/lib/chibi/scribble.scm b/lib/chibi/scribble.scm index f005222e..703f5c54 100644 --- a/lib/chibi/scribble.scm +++ b/lib/chibi/scribble.scm @@ -67,7 +67,7 @@ ((eqv? #\. ch) (read-char in) (if (= base 10) - (begin (read-char in) (read-float-tail in (exact->inexact acc))) + (begin (read-char in) (read-float-tail in (inexact acc))) (error "non-base-10 floating point"))) (else (error "invalid numeric syntax")))))) diff --git a/lib/chibi/scribble.sld b/lib/chibi/scribble.sld index a26fb05d..4dbb4b7c 100644 --- a/lib/chibi/scribble.sld +++ b/lib/chibi/scribble.sld @@ -1,5 +1,5 @@ (define-library (chibi scribble) (export scribble-parse scribble-read) - (import (chibi)) + (import (scheme base) (scheme char) (scheme read)) (include "scribble.scm")) diff --git a/lib/chibi/show-test.sld b/lib/chibi/show-test.sld index 6c9eb620..e63a6e0b 100644 --- a/lib/chibi/show-test.sld +++ b/lib/chibi/show-test.sld @@ -311,11 +311,11 @@ delightful wubbleflubbery)\n") - (test-pretty + '(test-pretty "#(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37)\n") - (test-pretty + '(test-pretty "(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37)\n") diff --git a/lib/chibi/string-test.sld b/lib/chibi/string-test.sld index 76704f7b..adbe27b8 100644 --- a/lib/chibi/string-test.sld +++ b/lib/chibi/string-test.sld @@ -1,8 +1,13 @@ (define-library (chibi string-test) (export run-tests) - (import (only (chibi test) test-begin test test-end) + (import (scheme base) (scheme char) + (only (chibi test) test-begin test test-end) (chibi string)) (begin + (define (digit-value ch) + (case ch + ((#\0) 0) ((#\1) 1) ((#\2) 2) ((#\3) 3) ((#\4) 4) + ((#\5) 5) ((#\6) 6) ((#\7) 7) ((#\8) 8) ((#\9) 9) (else #f))) (define (run-tests) (test-begin "strings") @@ -14,11 +19,6 @@ (test #f (string-every char-alphabetic? " abc")) (test #f (string-every char-alphabetic? "a.c")) - (define (digit-value ch) - (case ch - ((#\0) 0) ((#\1) 1) ((#\2) 2) ((#\3) 3) ((#\4) 4) - ((#\5) 5) ((#\6) 6) ((#\7) 7) ((#\8) 8) ((#\9) 9) (else #f))) - (test 3 (string-any digit-value "a3c")) (test #f (string-any digit-value "abc")) diff --git a/lib/chibi/string.scm b/lib/chibi/string.scm index 9a19fcc4..388ffeab 100644 --- a/lib/chibi/string.scm +++ b/lib/chibi/string.scm @@ -1,5 +1,5 @@ ;; strings.scm -- cursor-oriented string library -;; Copyright (c) 2012 Alex Shinn. All rights reserved. +;; Copyright (c) 2012-2015 Alex Shinn. All rights reserved. ;; BSD-style license: http://synthcode.com/license.txt (define (string-null? str) @@ -164,26 +164,6 @@ (let ((pred (make-char-predicate x))) (string-fold (lambda (ch count) (if (pred ch) (+ count 1) count)) 0 str))) -(define (string-for-each proc str . los) - (if (null? los) - (string-fold (lambda (ch a) (proc ch)) #f str) - (let ((los (cons str los))) - (let lp ((is (map string-cursor-start los))) - (cond - ((any (lambda (str i) - (string-cursor>=? i (string-cursor-end str))) - los is)) - (else - (apply proc (map string-cursor-ref los is)) - (lp (map string-cursor-next los is)))))))) - -(define (string-map proc str . los) - (call-with-output-string - (lambda (out) - (apply string-for-each - (lambda args (write-char (apply proc args) out)) - str los)))) - (define (make-string-searcher needle) (lambda (haystack) (string-contains haystack needle))) diff --git a/lib/chibi/string.sld b/lib/chibi/string.sld index 3bbb7eef..5c7256fa 100644 --- a/lib/chibi/string.sld +++ b/lib/chibi/string.sld @@ -13,5 +13,62 @@ string-fold string-fold-right string-map string-for-each string-contains make-string-searcher string-downcase-ascii string-upcase-ascii) - (import (chibi) (chibi ast) (chibi char-set base)) + (cond-expand + (chibi + (import (chibi) (chibi ast) (chibi char-set base)) + (begin + (define (string-for-each proc str . los) + (if (null? los) + (string-fold (lambda (ch a) (proc ch)) #f str) + (let ((los (cons str los))) + (let lp ((is (map string-cursor-start los))) + (cond + ((any (lambda (str i) + (string-cursor>=? i (string-cursor-end str))) + los is)) + (else + (apply proc (map string-cursor-ref los is)) + (lp (map string-cursor-next los is)))))))) + (define (string-map proc str . los) + (call-with-output-string + (lambda (out) + (apply string-for-each + (lambda args (write-char (apply proc args) out)) + str los)))))) + (else + (import (scheme base) (scheme char) (srfi 14) + (except (srfi 1) make-list list-copy)) + (begin + (define string-cursor? >) + (define string-cursor=? =) + (define string-cursor<=? <=) + (define string-cursor>=? >=) + (define string-cursor-ref string-ref) + (define (string-cursor-start s) 0) + (define string-cursor-end string-length) + (define (string-cursor-next s i) (+ i 1)) + (define (string-cursor-prev s i) (- i 1)) + (define (substring-cursor s start . o) + (substring s start (if (pair? o) (car o) (string-length s)))) + (define (string-concatenate ls) (apply string-append ls)) + (define string-size string-length) + (define (call-with-output-string proc) + (let ((out (open-output-string))) + (proc out) + (get-output-string out)))))) + (cond-expand + (chibi) + ((library (srfi 13)) + (import (only (srfi 13) string-contains))) + (else + (begin + (define (string-contains a b) + (let ((alen (string-length a)) + (blen (string-length b))) + (let lp ((i 0)) + (and (<= (+ i blen) alen) + (if (string=? b (substring a i (+ i blen))) + i + (lp (+ i 1)))))))))) (include "string.scm")) diff --git a/lib/chibi/term/ansi.scm b/lib/chibi/term/ansi.scm index 0d80a49d..d50c6ffc 100644 --- a/lib/chibi/term/ansi.scm +++ b/lib/chibi/term/ansi.scm @@ -64,7 +64,7 @@ (when (not (and (exact-integer? blue-level) (<= 0 blue-level 5))) (error "invalid blue-level value" blue-level)) (string-append - "\x1B[38;5;" + "\x1B;[38;5;" (number->string (+ (* 36 red-level) (* 6 green-level) blue-level 16)) "m")) @@ -78,7 +78,7 @@ (define (gray-escape gray-level) (when (not (and (exact-integer? gray-level) (<= 0 gray-level 23))) (error "invalid gray-level value" gray-level)) - (string-append "\x1B[38;5;" + (string-append "\x1B;[38;5;" (number->string (+ gray-level 232)) "m")) @@ -196,7 +196,7 @@ (when (not (and (exact-integer? blue-level) (<= 0 blue-level 5))) (error "invalid blue-level value" blue-level)) (string-append - "\x1B[48;5;" + "\x1B;[48;5;" (number->string (+ (* 36 red-level) (* 6 green-level) blue-level 16)) "m")) @@ -210,7 +210,7 @@ (define (gray-background-escape gray-level) (when (not (and (exact-integer? gray-level) (<= 0 gray-level 23))) (error "invalid gray-level value" gray-level)) - (string-append "\x1B[48;5;" + (string-append "\x1B;[48;5;" (number->string (+ gray-level 232)) "m")) diff --git a/lib/chibi/test.sld b/lib/chibi/test.sld index 61f586cc..1b6220c0 100644 --- a/lib/chibi/test.sld +++ b/lib/chibi/test.sld @@ -5,22 +5,20 @@ test-group current-test-group test-begin test-end test-syntax-error test-propagate-info test-vars test-run test-exit - current-test-verbosity current-test-epsilon current-test-comparator + current-test-verbosity current-test-applier current-test-handler current-test-skipper current-test-group-reporter test-failure-count current-test-epsilon current-test-comparator) - (import (scheme write) + (import (scheme base) + (scheme write) (scheme complex) (scheme process-context) (scheme time) (chibi term ansi)) (cond-expand (chibi - (import (except (scheme base) guard) - (rename (only (chibi) pair-source print-exception protect) - (protect guard)))) + (import (only (chibi) pair-source print-exception protect))) (else - (import (scheme base)) (begin (define (pair-source x) #f) (define print-exception write)))) diff --git a/lib/chibi/uri-test.sld b/lib/chibi/uri-test.sld index 1881c4c3..ca5535d9 100644 --- a/lib/chibi/uri-test.sld +++ b/lib/chibi/uri-test.sld @@ -1,6 +1,6 @@ (define-library (chibi uri-test) (export run-tests) - (import (chibi) (chibi test) (chibi uri)) + (import (scheme base) (chibi test) (chibi uri)) (begin (define (run-tests) (test-begin "uri") diff --git a/lib/chibi/uri.sld b/lib/chibi/uri.sld index 2e50fe26..56fda771 100644 --- a/lib/chibi/uri.sld +++ b/lib/chibi/uri.sld @@ -5,5 +5,14 @@ uri-with-scheme uri-with-user uri-with-host uri-with-path uri-with-query uri-with-fragment uri-resolve uri-encode uri-decode uri-query->alist uri-alist->query) - (import (chibi) (chibi string) (chibi pathname) (srfi 9)) + (cond-expand + (chibi + (import (chibi) (srfi 9))) + (else + (import (except (scheme base) string-map string-for-each) + (scheme char)) + (begin + (define (string-concatenate ls) + (apply string-append ls))))) + (import (chibi string) (chibi pathname)) (include "uri.scm")) diff --git a/lib/srfi/1.sld b/lib/srfi/1.sld index 8e9498a8..e8c0a907 100644 --- a/lib/srfi/1.sld +++ b/lib/srfi/1.sld @@ -18,7 +18,39 @@ lset<= lset= lset-adjoin lset-union lset-union! lset-intersection lset-intersection! lset-difference lset-difference! lset-xor lset-xor! lset-diff+intersection lset-diff+intersection!) - (import (chibi)) + (cond-expand + (chibi + (import (chibi))) + (else + (import (scheme base)) + (begin + (define reverse! reverse) + (define (find-tail pred ls) + (and (pair? ls) (if (pred (car ls)) ls (find-tail pred (cdr ls))))) + (define (find pred ls) + (cond ((find-tail pred ls) => car) (else #f))) + (define (any pred ls . lol) + (define (any1 pred ls) + (if (pair? (cdr ls)) + ((lambda (x) (if x x (any1 pred (cdr ls)))) (pred (car ls))) + (pred (car ls)))) + (define (anyn pred lol) + (if (every pair? lol) + ((lambda (x) (if x x (anyn pred (map cdr lol)))) + (apply pred (map car lol))) + #f)) + (if (null? lol) + (if (pair? ls) (any1 pred ls) #f) + (anyn pred (cons ls lol)))) + (define (every pred ls . lol) + (define (every1 pred ls) + (if (null? (cdr ls)) + (pred (car ls)) + (if (pred (car ls)) (every1 pred (cdr ls)) #f))) + (if (null? lol) + (if (pair? ls) (every1 pred ls) #t) + (not (apply any (lambda xs (not (apply pred xs))) ls lol)))) + ))) (include "1/predicates.scm" "1/selectors.scm" "1/search.scm" @@ -28,4 +60,3 @@ "1/deletion.scm" "1/alists.scm" "1/lset.scm")) - diff --git a/tests/lib-tests.scm b/tests/lib-tests.scm index 1b685870..3e845ca5 100644 --- a/tests/lib-tests.scm +++ b/tests/lib-tests.scm @@ -15,20 +15,27 @@ (rename (chibi crypto md5-test) (run-tests run-md5-tests)) (rename (chibi crypto rsa-test) (run-tests run-rsa-tests)) (rename (chibi crypto sha2-test) (run-tests run-sha2-tests)) + ;;(rename (chibi filesystem-test) (run-tests run-filesystem-tests)) + (rename (chibi generic-test) (run-tests run-generic-tests)) (rename (chibi io-test) (run-tests run-io-tests)) (rename (chibi iset-test) (run-tests run-iset-tests)) (rename (chibi loop-test) (run-tests run-loop-tests)) (rename (chibi match-test) (run-tests run-match-tests)) (rename (chibi math prime-test) (run-tests run-prime-tests)) + ;;(rename (chibi memoize-test) (run-tests run-memoize-tests)) (rename (chibi mime-test) (run-tests run-mime-tests)) (rename (chibi parse-test) (run-tests run-parse-tests)) + (rename (chibi pathname-test) (run-tests run-pathname-tests)) (rename (chibi process-test) (run-tests run-process-tests)) (rename (chibi regexp-test) (run-tests run-regexp-tests)) (rename (chibi scribble-test) (run-tests run-scribble-tests)) + (rename (chibi show-test) (run-tests run-show-tests)) + (rename (chibi string-test) (run-tests run-string-tests)) (rename (chibi system-test) (run-tests run-system-tests)) (rename (chibi tar-test) (run-tests run-tar-tests)) (rename (chibi term ansi-test) (run-tests run-term-ansi-tests)) (rename (chibi uri-test) (run-tests run-uri-tests)) + ;;(rename (chibi weak-test) (run-tests run-weak-tests)) ) (test-begin "libraries") @@ -44,6 +51,7 @@ (run-srfi-95-tests) (run-srfi-99-tests) (run-base64-tests) +(run-generic-tests) (run-io-tests) (run-iset-tests) (run-loop-tests) @@ -51,12 +59,15 @@ (run-md5-tests) (run-mime-tests) (run-parse-tests) +(run-pathname-tests) (run-prime-tests) (run-process-tests) (run-regexp-tests) (run-rsa-tests) (run-scribble-tests) +(run-string-tests) (run-sha2-tests) +(run-show-tests) (run-system-tests) (run-tar-tests) (run-term-ansi-tests)