mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-18 21:29:19 +02:00
Merge branch 'master' into r6rs
This commit is contained in:
Daphne Preston-Kendal
commit
c1b017aaa7
16 changed files with 931 additions and 31 deletions
|
|
@ -1403,7 +1403,7 @@ namespace.
|
|||
|
||||
\item{\hyperlink["lib/chibi/shell.html"]{(chibi shell) - Process combinators with high-level pipeline syntax in the spirit of SCSH.}}
|
||||
|
||||
\item{\hyperlink["lib/chibi/show.html"]{(chibi show) - Monadic formattinga.}}
|
||||
\item{\hyperlink["lib/chibi/show.html"]{(chibi show) - Monadic formatting.}}
|
||||
|
||||
\item{\hyperlink["lib/chibi/scribble.html"]{(chibi scribble) - A parser for the scribble syntax used to write this manual}}
|
||||
|
||||
|
|
|
|||
72
lib/chibi/csv-test.sld
Normal file
72
lib/chibi/csv-test.sld
Normal file
|
|
@ -0,0 +1,72 @@
|
|||
|
||||
(define-library (chibi csv-test)
|
||||
(import (scheme base)
|
||||
(srfi 227)
|
||||
(chibi csv)
|
||||
(chibi test))
|
||||
(export run-tests)
|
||||
(begin
|
||||
(define string->csv
|
||||
(opt-lambda (str (reader (csv-read->list)))
|
||||
(reader (open-input-string str))))
|
||||
(define (run-tests)
|
||||
(test-begin "(chibi csv)")
|
||||
(test-assert (eof-object? (string->csv "")))
|
||||
(test '("1997" "Ford" "E350")
|
||||
(string->csv "1997,Ford,E350"))
|
||||
(test '("1997" "Ford" "E350")
|
||||
(string->csv "\n1997,Ford,E350"))
|
||||
(test '(" ")
|
||||
(string->csv " \n1997,Ford,E350"))
|
||||
(test '("" "")
|
||||
(string->csv ",\n1997,Ford,E350"))
|
||||
(test '("1997" "Ford" "E350")
|
||||
(string->csv "\"1997\",\"Ford\",\"E350\""))
|
||||
(test '("1997" "Ford" "E350" "Super, luxurious truck")
|
||||
(string->csv "1997,Ford,E350,\"Super, luxurious truck\""))
|
||||
(test '("1997" "Ford" "E350" "Super, \"luxurious\" truck")
|
||||
(string->csv "1997,Ford,E350,\"Super, \"\"luxurious\"\" truck\""))
|
||||
(test '("1997" "Ford" "E350" "Go get one now\nthey are going fast")
|
||||
(string->csv "1997,Ford,E350,\"Go get one now
|
||||
they are going fast\""))
|
||||
(test '("1997" "Ford" "E350")
|
||||
(string->csv
|
||||
"# this is a comment\n1997,Ford,E350"
|
||||
(csv-read->list
|
||||
(csv-parser (csv-grammar '((comment-chars #\#)))))))
|
||||
(test '("1997" "Fo\"rd" "E3\"50")
|
||||
(string->csv "1997\tFo\"rd\tE3\"50"
|
||||
(csv-read->list (csv-parser default-tsv-grammar))))
|
||||
(test '#("1997" "Ford" "E350")
|
||||
(string->csv "1997,Ford,E350" (csv-read->vector)))
|
||||
(test '#("1997" "Ford" "E350")
|
||||
(string->csv "1997,Ford,E350" (csv-read->fixed-vector 3)))
|
||||
(test-error
|
||||
(string->csv "1997,Ford,E350" (csv-read->fixed-vector 2)))
|
||||
(let ((city-csv "Los Angeles,34°03′N,118°15′W
|
||||
New York City,40°42′46″N,74°00′21″W
|
||||
Paris,48°51′24″N,2°21′03″E"))
|
||||
(test '(*TOP*
|
||||
(row (col-0 "Los Angeles")
|
||||
(col-1 "34°03′N")
|
||||
(col-2 "118°15′W"))
|
||||
(row (col-0 "New York City")
|
||||
(col-1 "40°42′46″N")
|
||||
(col-2 "74°00′21″W"))
|
||||
(row (col-0 "Paris")
|
||||
(col-1 "48°51′24″N")
|
||||
(col-2 "2°21′03″E")))
|
||||
((csv->sxml) (open-input-string city-csv)))
|
||||
(test '(*TOP*
|
||||
(city (name "Los Angeles")
|
||||
(latitude "34°03′N")
|
||||
(longitude "118°15′W"))
|
||||
(city (name "New York City")
|
||||
(latitude "40°42′46″N")
|
||||
(longitude "74°00′21″W"))
|
||||
(city (name "Paris")
|
||||
(latitude "48°51′24″N")
|
||||
(longitude "2°21′03″E")))
|
||||
((csv->sxml 'city '(name latitude longitude))
|
||||
(open-input-string city-csv))))
|
||||
(test-end))))
|
||||
362
lib/chibi/csv.scm
Normal file
362
lib/chibi/csv.scm
Normal file
|
|
@ -0,0 +1,362 @@
|
|||
|
||||
;;> \section{CSV Grammars}
|
||||
|
||||
;;> CSV is a simple and compact format for tabular data, which has
|
||||
;;> made it popular for a variety of tasks since the early days of
|
||||
;;> computing. Unfortunately, there are many incompatible dialects
|
||||
;;> requiring a grammar to specify all of the different options.
|
||||
|
||||
(define-record-type Csv-Grammar
|
||||
(make-csv-grammar separator-chars quote-char escape-char record-separator comment-chars)
|
||||
csv-grammar?
|
||||
(separator-chars csv-grammar-separator-chars csv-grammar-separator-chars-set!)
|
||||
(quote-char csv-grammar-quote-char csv-grammar-quote-char-set!)
|
||||
(escape-char csv-grammar-escape-char csv-grammar-escape-char-set!)
|
||||
(record-separator csv-grammar-record-separator csv-grammar-record-separator-set!)
|
||||
(comment-chars csv-grammar-comment-chars csv-grammar-comment-chars-set!))
|
||||
|
||||
;; TODO: Consider some minimal low-level parsing options. In general
|
||||
;; this is intended to be performed by the parser, but if we can skip
|
||||
;; intermediate string generation (e.g. parsing numbers directly) it
|
||||
;; can save a considerable amount of garbage when parsing large files.
|
||||
|
||||
;;> Creates a new CSV grammar from the given spec, an alist of symbols
|
||||
;;> to values. The following options are supported:
|
||||
;;>
|
||||
;;> \itemlist[
|
||||
;;> \item{\scheme{'separator-chars} - A non-empty list of characters used to delimit fields, by default \scheme{'(#\\,)} (comma-separated).}
|
||||
;;> \item{\scheme{'quote-char} - A single character used to quote fields containing special characters, or \scheme{#f} to disable quoting, by default \scheme{#\\"} (a double-quote).}
|
||||
;;> \item{\scheme{'escape-char} - A single character used to escape characters within quoted fields, or \scheme{#f} to disable escapes, by default \scheme{#\\"} (a double-quote). If this is the same character as the \scheme{quote-char}, then the quote char can be doubled to escape, but no other characters can be escaped.}
|
||||
;;> \item{\scheme{'record-separator} - A single character used to delimit the record (row), or one of the symbols \scheme{'cr}, \scheme{'crlf}, \scheme{'lf} or \scheme{'lax}. These correspond to sequences of carriage return and line feed, or in the case of \scheme{'lax} any of the other three sequences. Defaults to \scheme{'lax}.}
|
||||
;;> \item{\scheme{'comment-chars} - A list of characters which if found at the start of a record indicate it is a comment, discarding all characters through to the next record-separator. Defaults to the empty list (no comments).}
|
||||
;;> ]
|
||||
;;>
|
||||
;;> Example Gecos grammar:
|
||||
;;>
|
||||
;;> \example{
|
||||
;;> (csv-grammar
|
||||
;;> '((separator-chars #\\:)
|
||||
;;> (quote-char . #f)
|
||||
;;> (escape-char . #f)))
|
||||
;;> }
|
||||
(define (csv-grammar spec)
|
||||
(let ((grammar (make-csv-grammar '(#\,) #\" #\" 'lax '())))
|
||||
(for-each
|
||||
(lambda (x)
|
||||
(case (car x)
|
||||
((separator-chars delimiter)
|
||||
(csv-grammar-separator-chars-set! grammar (cdr x)))
|
||||
((quote-char)
|
||||
(csv-grammar-quote-char-set! grammar (cdr x)))
|
||||
((escape-char)
|
||||
(csv-grammar-escape-char-set! grammar (cdr x)))
|
||||
((record-separator newline-type)
|
||||
(let ((rec-sep
|
||||
(case (cdr x)
|
||||
((crlf lax) (cdr x))
|
||||
((cr) #\return)
|
||||
((lf) #\newline)
|
||||
(else
|
||||
(if (char? (cdr x))
|
||||
(cdr x)
|
||||
(error "invalid record-separator, expected a char or one of 'lax or 'crlf" (cdr x)))))))
|
||||
(csv-grammar-escape-char-set! grammar (cdr x))))
|
||||
((comment-chars)
|
||||
(csv-grammar-comment-chars-set! grammar (cdr x)))
|
||||
(else
|
||||
(error "unknown csv-grammar spec" x))))
|
||||
spec)
|
||||
grammar))
|
||||
|
||||
;;> The default CSV grammar for convenience, with all of the defaults
|
||||
;;> from \scheme{csv-grammar}, i.e. comma-delimited with \scheme{#\"}
|
||||
;;> for quoting, doubled to escape.
|
||||
(define default-csv-grammar
|
||||
(csv-grammar '()))
|
||||
|
||||
;;> The default TSV grammar for convenience, splitting fields only on
|
||||
;;> tabs, with no quoting or escaping.
|
||||
(define default-tsv-grammar
|
||||
(csv-grammar '((separator-chars #\tab) (quote-char . #f) (escape-char . #f))))
|
||||
|
||||
;;> \section{CSV Parsers}
|
||||
|
||||
;;> Parsers are low-level utilities to perform operations on records a
|
||||
;;> field at a time. You generally want to work with readers, which
|
||||
;;> build on this to build records into familiar data structures.
|
||||
|
||||
;;> Parsers follow the rules of a grammar to parse a single CSV
|
||||
;;> record, possible comprised of multiple fields. A parser is a
|
||||
;;> procedure of three arguments which performs a fold operation over
|
||||
;;> the fields of the record. The parser signature is:
|
||||
;;> \scheme{(parser kons knil in)}, where \scheme{kons} itself is
|
||||
;;> a procedure of three arguments: \scheme{(proc acc index field)}.
|
||||
;;> \scheme{proc} is called on each field of the record, in order,
|
||||
;;> along with its zero-based \scheme{index} and the accumulated
|
||||
;;> result of the last call, starting with \scheme{knil}.
|
||||
|
||||
;;> Returns a new CSV parser for the given \var{grammar}. The parser
|
||||
;;> by itself can be used to parse a record at a time.
|
||||
;;>
|
||||
;;> \example{
|
||||
;;> (let ((parse (csv-parser)))
|
||||
;;> (parse (lambda (vec i field) (vector-set! vec i (string->number field)) vec)
|
||||
;;> (make-vector 3)
|
||||
;;> (open-input-string "1,2,3")))
|
||||
;;> }
|
||||
(define csv-parser
|
||||
(opt-lambda ((grammar default-csv-grammar))
|
||||
(lambda (kons knil in)
|
||||
(when (pair? (csv-grammar-comment-chars grammar))
|
||||
(let lp ()
|
||||
(when (memv (peek-char in) (csv-grammar-comment-chars grammar))
|
||||
(csv-skip-line in grammar)
|
||||
(lp))))
|
||||
(let lp ((acc knil)
|
||||
(index 0)
|
||||
(out (open-output-string)))
|
||||
(define (finish-row)
|
||||
(let ((field (get-output-string out)))
|
||||
(if (and (zero? index) (equal? field ""))
|
||||
;; empty row, read again
|
||||
(lp acc index out)
|
||||
(kons acc index field))))
|
||||
(let ((ch (read-char in)))
|
||||
(cond
|
||||
((eof-object? ch)
|
||||
(let ((field (get-output-string out)))
|
||||
(if (and (zero? index) (equal? field ""))
|
||||
;; no data
|
||||
ch
|
||||
(kons acc index field))))
|
||||
((memv ch (csv-grammar-separator-chars grammar))
|
||||
(lp (kons acc index (get-output-string out))
|
||||
(+ index 1)
|
||||
(open-output-string)))
|
||||
((eqv? ch (csv-grammar-quote-char grammar))
|
||||
;; TODO: Consider a strict mode to enforce no text
|
||||
;; before/after the quoted text.
|
||||
(csv-read-quoted in out grammar)
|
||||
(lp acc index out))
|
||||
((eqv? ch (csv-grammar-record-separator grammar))
|
||||
(finish-row))
|
||||
((and (eqv? ch #\return)
|
||||
(memq (csv-grammar-record-separator grammar) '(crlf lax)))
|
||||
(cond
|
||||
((eqv? (peek-char in) #\newline)
|
||||
(read-char in)
|
||||
(finish-row))
|
||||
((eq? (csv-grammar-record-separator grammar) 'lax)
|
||||
(finish-row))
|
||||
(else
|
||||
(write-char ch out)
|
||||
(lp acc (+ index 1) out))))
|
||||
((and (eqv? ch #\newline)
|
||||
(eq? (csv-grammar-record-separator grammar) 'lax))
|
||||
(finish-row))
|
||||
(else
|
||||
(write-char ch out)
|
||||
(lp acc index out))))))))
|
||||
|
||||
(define (csv-skip-line in grammar)
|
||||
(let lp ()
|
||||
(let ((ch (read-char in)))
|
||||
(cond
|
||||
((eof-object? ch))
|
||||
((eqv? ch (csv-grammar-record-separator grammar)))
|
||||
((and (eqv? ch #\newline)
|
||||
(eq? (csv-grammar-record-separator grammar) 'lax)))
|
||||
((and (eqv? ch #\return)
|
||||
(memq (csv-grammar-record-separator grammar) '(crlf lax)))
|
||||
(cond
|
||||
((eqv? (peek-char in) #\newline) (read-char in))
|
||||
((eq? (csv-grammar-record-separator grammar) 'lax))
|
||||
(else (lp))))
|
||||
(else (lp))))))
|
||||
|
||||
(define (csv-read-quoted in out grammar)
|
||||
(let lp ()
|
||||
(let ((ch (read-char in)))
|
||||
(cond
|
||||
((eof-object? ch)
|
||||
(error "unterminated csv quote" (get-output-string out)))
|
||||
((eqv? ch (csv-grammar-quote-char grammar))
|
||||
(when (and (eqv? ch (csv-grammar-escape-char grammar))
|
||||
(eqv? ch (peek-char in)))
|
||||
(write-char (read-char in) out)
|
||||
(lp)))
|
||||
((eqv? ch (csv-grammar-escape-char grammar))
|
||||
(write-char (read-char in) out)
|
||||
(lp))
|
||||
(else
|
||||
;; TODO: Consider an option to disable newlines in quotes.
|
||||
(write-char ch out)
|
||||
(lp))))))
|
||||
|
||||
;;> \section{CSV Readers}
|
||||
|
||||
;;> A CSV reader reads a single record, returning some representation
|
||||
;;> of it. You can either loop manually with these or pass them to
|
||||
;;> one of the high-level utilities to operate on a whole CSV file at
|
||||
;;> a time.
|
||||
|
||||
;;> The simplest reader, simply returns the field string values in
|
||||
;;> order as a list.
|
||||
;;>
|
||||
;;> \example{
|
||||
;;> ((csv-read->list) (open-input-string "foo,bar,baz"))
|
||||
;;> }
|
||||
(define csv-read->list
|
||||
(opt-lambda ((parser (csv-parser)))
|
||||
(opt-lambda ((in (current-input-port)))
|
||||
(let ((res (parser (lambda (ls i field) (cons field ls)) '() in)))
|
||||
(if (pair? res)
|
||||
(reverse res)
|
||||
res)))))
|
||||
|
||||
;;> The equivalent of \scheme{csv-read->list} but returns a vector.
|
||||
;;>
|
||||
;;> \example{
|
||||
;;> ((csv-read->vector) (open-input-string "foo,bar,baz"))
|
||||
;;> }
|
||||
(define csv-read->vector
|
||||
(opt-lambda ((parser (csv-parser)))
|
||||
(let ((reader (csv-read->list parser)))
|
||||
(opt-lambda ((in (current-input-port)))
|
||||
(let ((res (reader in)))
|
||||
(if (pair? res)
|
||||
(list->vector res)
|
||||
res))))))
|
||||
|
||||
;;> The same as \scheme{csv-read->vector} but requires the vector to
|
||||
;;> be of a fixed size, and may be more efficient.
|
||||
;;>
|
||||
;;> \example{
|
||||
;;> ((csv-read->fixed-vector 3) (open-input-string "foo,bar,baz"))
|
||||
;;> }
|
||||
(define csv-read->fixed-vector
|
||||
(opt-lambda (size (parser (csv-parser)))
|
||||
(opt-lambda ((in (current-input-port)))
|
||||
(let ((res (make-vector size)))
|
||||
(let ((len (parser (lambda (prev-i i field) (vector-set! res i field) i)
|
||||
0
|
||||
in)))
|
||||
(if (zero? len)
|
||||
eof-object
|
||||
res))))))
|
||||
|
||||
;;> Returns an SXML representation of the record, as a row with
|
||||
;;> multiple named columns.
|
||||
;;>
|
||||
;;> \example{
|
||||
;;> ((csv-read->sxml 'city '(name latitude longitude))
|
||||
;;> (open-input-string "Tokyo,35°41′23″N,139°41′32″E"))
|
||||
;;> }
|
||||
(define csv-read->sxml
|
||||
(opt-lambda ((row-name 'row)
|
||||
(column-names
|
||||
(lambda (i)
|
||||
(string->symbol (string-append "col-" (number->string i)))))
|
||||
(parser (csv-parser)))
|
||||
(define (get-column-name i)
|
||||
(if (procedure? column-names)
|
||||
(column-names i)
|
||||
(list-ref column-names i)))
|
||||
(opt-lambda ((in (current-input-port)))
|
||||
(let ((res (parser (lambda (ls i field)
|
||||
`((,(get-column-name i) ,field) ,@ls))
|
||||
(list row-name)
|
||||
in)))
|
||||
(if (pair? res)
|
||||
(reverse res)
|
||||
res)))))
|
||||
|
||||
;;> \section{CSV Utilities}
|
||||
|
||||
;;> A folding operation on records. \var{proc} is called successively
|
||||
;;> on each row and the accumulated result.
|
||||
;;>
|
||||
;;> \example{
|
||||
;;> (csv-fold
|
||||
;;> (lambda (row acc) (cons (cadr (assq 'name (cdr row))) acc))
|
||||
;;> '()
|
||||
;;> (csv-read->sxml 'city '(name latitude longitude))
|
||||
;;> (open-input-string
|
||||
;;> "Tokyo,35°41′23″N,139°41′32″E
|
||||
;;> Paris,48°51′24″N,2°21′03″E"))
|
||||
;;> }
|
||||
(define csv-fold
|
||||
(opt-lambda (proc
|
||||
knil
|
||||
(reader (csv-read->list))
|
||||
(in (current-input-port)))
|
||||
(let lp ((acc knil))
|
||||
(let ((row (reader in)))
|
||||
(cond
|
||||
((eof-object? row) acc)
|
||||
(else (lp (proc row acc))))))))
|
||||
|
||||
;;> An iterator which simply calls \var{proc} on each record in the
|
||||
;;> input in order.
|
||||
;;>
|
||||
;;> \example{
|
||||
;;> (let ((count 0))
|
||||
;;> (csv-for-each
|
||||
;;> (lambda (row) (if (string->number (car row)) (set! count (+ 1 count))))
|
||||
;;> (csv-read->list)
|
||||
;;> (open-input-string
|
||||
;;> "1,foo\\n2,bar\\nthree,baz\\n4,qux"))
|
||||
;;> count)
|
||||
;;> }
|
||||
(define csv-for-each
|
||||
(opt-lambda (proc
|
||||
(reader (csv-read->list))
|
||||
(in (current-input-port)))
|
||||
(csv-fold (lambda (row acc) (proc row)) #f reader in)))
|
||||
|
||||
;;> Returns a list containing the result of calling \var{proc} on each
|
||||
;;> element in the input.
|
||||
;;>
|
||||
;;> \example{
|
||||
;;> (csv-map
|
||||
;;> (lambda (row) (string->symbol (cadr row)))
|
||||
;;> (csv-read->list)
|
||||
;;> (open-input-string
|
||||
;;> "1,foo\\n2,bar\\nthree,baz\\n4,qux"))
|
||||
;;> }
|
||||
(define csv-map
|
||||
(opt-lambda (proc
|
||||
(reader (csv-read->list))
|
||||
(in (current-input-port)))
|
||||
(reverse (csv-fold (lambda (row acc) (cons (proc row) acc)) '() reader in))))
|
||||
|
||||
;;> Returns a list of all of the read records in the input.
|
||||
;;>
|
||||
;;> \example{
|
||||
;;> (csv->list
|
||||
;;> (csv-read->list)
|
||||
;;> (open-input-string
|
||||
;;> "1,foo\\n2,bar\\nthree,baz\\n4,qux"))
|
||||
;;> }
|
||||
(define csv->list
|
||||
(opt-lambda ((reader (csv-read->list))
|
||||
(in (current-input-port)))
|
||||
(csv-map (lambda (row) row) reader in)))
|
||||
|
||||
;;> Returns an SXML representation of the CSV.
|
||||
;;>
|
||||
;;> \example{
|
||||
;;> ((csv->sxml 'city '(name latitude longitude))
|
||||
;;> (open-input-string
|
||||
;;> "Tokyo,35°41′23″N,139°41′32″E
|
||||
;;> Paris,48°51′24″N,2°21′03″E"))
|
||||
;;> }
|
||||
(define csv->sxml
|
||||
(opt-lambda ((row-name 'row)
|
||||
(column-names
|
||||
(lambda (i)
|
||||
(string->symbol (string-append "col-" (number->string i)))))
|
||||
(parser (csv-parser)))
|
||||
(opt-lambda ((in (current-input-port)))
|
||||
(cons '*TOP*
|
||||
(csv->list (csv-read->sxml row-name column-names parser) in)))))
|
||||
9
lib/chibi/csv.sld
Normal file
9
lib/chibi/csv.sld
Normal file
|
|
@ -0,0 +1,9 @@
|
|||
|
||||
(define-library (chibi csv)
|
||||
(import (scheme base) (srfi 227))
|
||||
(export csv-grammar csv-parser csv-grammar?
|
||||
default-csv-grammar default-tsv-grammar
|
||||
csv-read->list csv-read->vector csv-read->fixed-vector
|
||||
csv-read->sxml
|
||||
csv-fold csv-map csv->list csv-for-each csv->sxml)
|
||||
(include "csv.scm"))
|
||||
|
|
@ -32,6 +32,11 @@
|
|||
|
||||
;;> If no patterns match an error is signalled.
|
||||
|
||||
;;> Note there is no \scheme{else} clause. \scheme{else} is sometimes
|
||||
;;> used descriptively for the last pattern, since an identifier used
|
||||
;;> only once matches anything, but it's preferred to use \scheme{_}
|
||||
;;> described below.
|
||||
|
||||
;;> Identifiers will match anything, and make the corresponding
|
||||
;;> binding available in the body.
|
||||
|
||||
|
|
@ -128,7 +133,7 @@
|
|||
;;> are bound if the \scheme{or} operator matches, but the binding is
|
||||
;;> only defined for identifiers from the subpattern which matched.
|
||||
|
||||
;;> \example{(match 1 ((or) #t) (else #f))}
|
||||
;;> \example{(match 1 ((or) #t) (_ #f))}
|
||||
;;> \example{(match 1 ((or x) x))}
|
||||
;;> \example{(match 1 ((or x 2) x))}
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
;; repl.scm - friendlier repl with line editing and signal handling
|
||||
;; Copyright (c) 2012-2013 Alex Shinn. All rights reserved.
|
||||
;; Copyright (c) 2012-2024 Alex Shinn. All rights reserved.
|
||||
;; BSD-style license: http://synthcode.com/license.txt
|
||||
|
||||
;;> A user-friendly REPL with line editing and signal handling. The
|
||||
|
|
@ -296,6 +296,8 @@
|
|||
(pair? (exception-irritants exn)))
|
||||
(let ((name (car (exception-irritants exn))))
|
||||
(cond
|
||||
((and (identifier? name) (not (env-parent (current-environment))))
|
||||
(display "Did you forget to import a language? e.g. (import (scheme base))\n" out))
|
||||
((identifier? name)
|
||||
(display "Searching for modules exporting " out)
|
||||
(display name out)
|
||||
|
|
@ -400,6 +402,16 @@
|
|||
((= (length value) 1) (push-history-value! (car value)))
|
||||
(else (push-history-value! value))))
|
||||
|
||||
(define-generic repl-print)
|
||||
|
||||
(define-method (repl-print obj (out output-port?))
|
||||
(write/ss obj out))
|
||||
|
||||
(define-generic repl-print-exception)
|
||||
|
||||
(define-method (repl-print-exception obj (out output-port?))
|
||||
(print-exception obj out))
|
||||
|
||||
(define (repl/eval rp expr-list)
|
||||
(let ((thread (current-thread))
|
||||
(out (repl-out rp)))
|
||||
|
|
@ -409,7 +421,7 @@
|
|||
(lambda ()
|
||||
(protect (exn
|
||||
(else
|
||||
(print-exception exn out)
|
||||
(repl-print-exception exn out)
|
||||
(repl-advise-exception exn (current-error-port))))
|
||||
(for-each
|
||||
(lambda (expr)
|
||||
|
|
@ -420,17 +432,17 @@
|
|||
(null? expr))
|
||||
(eval expr (repl-env rp))
|
||||
expr))
|
||||
(lambda res-list
|
||||
(lambda res-values
|
||||
(cond
|
||||
((not (or (null? res-list)
|
||||
(equal? res-list (list (if #f #f)))))
|
||||
(push-history-value-maybe! res-list)
|
||||
(write/ss (car res-list) out)
|
||||
((not (or (null? res-values)
|
||||
(equal? res-values (list undefined-value))))
|
||||
(push-history-value-maybe! res-values)
|
||||
(repl-print (car res-values) out)
|
||||
(for-each
|
||||
(lambda (res)
|
||||
(write-char #\space out)
|
||||
(write/ss res out))
|
||||
(cdr res-list))
|
||||
(repl-print res out))
|
||||
(cdr res-values))
|
||||
(newline out))))))
|
||||
expr-list))))))
|
||||
|
||||
|
|
|
|||
|
|
@ -1,8 +1,9 @@
|
|||
|
||||
(define-library (chibi repl)
|
||||
(export repl $0 $1 $2 $3 $4 $5 $6 $7 $8 $9)
|
||||
(export repl repl-print repl-print-exception
|
||||
$0 $1 $2 $3 $4 $5 $6 $7 $8 $9)
|
||||
(import (chibi) (only (meta) load-module module-name->file)
|
||||
(chibi ast) (chibi modules) (chibi doc)
|
||||
(chibi ast) (chibi modules) (chibi doc) (chibi generic)
|
||||
(chibi string) (chibi io) (chibi optional)
|
||||
(chibi process) (chibi term edit-line)
|
||||
(srfi 1)
|
||||
|
|
|
|||
|
|
@ -526,6 +526,7 @@
|
|||
(not (assq-ref info 'line-number)))
|
||||
`((file-name . ,(car (pair-source expr)))
|
||||
(line-number . ,(cdr (pair-source expr)))
|
||||
(format . ,(current-test-value-formatter))
|
||||
,@info)
|
||||
info)))
|
||||
|
||||
|
|
@ -584,14 +585,20 @@
|
|||
((SKIP) "-")
|
||||
(else "."))))
|
||||
|
||||
(define (display-expected/actual expected actual)
|
||||
(let* ((e-str (write-to-string expected))
|
||||
(a-str (write-to-string actual))
|
||||
(diff (diff e-str a-str read-char)))
|
||||
(write-string "expected ")
|
||||
(write-string (edits->string/color (car diff) (car (cddr diff)) 1))
|
||||
(write-string " but got ")
|
||||
(write-string (edits->string/color (cadr diff) (car (cddr diff)) 2))))
|
||||
(define (display-expected/actual expected actual format)
|
||||
(let ((e-str (format expected))
|
||||
(a-str (format actual)))
|
||||
(if (and (equal? e-str a-str)
|
||||
(not (eqv? format write-to-string)))
|
||||
;; If the formatter can't display any difference, fall back to
|
||||
;; write-to-string.
|
||||
(display-expected/actual expected actual write-to-string)
|
||||
(let ((diff (diff e-str a-str read-char)))
|
||||
(write-string "expected ")
|
||||
(write-string (edits->string/color (car diff) (car (cddr diff)) 1))
|
||||
(write-string " but got ")
|
||||
(write-string (edits->string/color (cadr diff) (car (cddr diff)) 2))
|
||||
))))
|
||||
|
||||
(define (test-print-explanation indent status info)
|
||||
(cond
|
||||
|
|
@ -617,8 +624,9 @@
|
|||
(write (assq-ref info 'result)))))
|
||||
((eq? status 'FAIL)
|
||||
(display indent)
|
||||
(display-expected/actual
|
||||
(assq-ref info 'expected) (assq-ref info 'result))))
|
||||
(display-expected/actual (assq-ref info 'expected)
|
||||
(assq-ref info 'result)
|
||||
(or (assq-ref info 'format) write-to-string))))
|
||||
;; print variables
|
||||
(cond
|
||||
((and (memq status '(FAIL ERROR)) (assq-ref info 'var-names))
|
||||
|
|
@ -863,6 +871,11 @@
|
|||
|
||||
;;> \section{Parameters}
|
||||
|
||||
;;> If specified, takes a single object as input (the expected or
|
||||
;;> actual value of a test) and returns the string representation
|
||||
;;> (default \scheme{write-to-string}).
|
||||
(define current-test-value-formatter (make-parameter #f))
|
||||
|
||||
;;> The current test group as started by \scheme{test-group} or
|
||||
;;> \scheme{test-begin}.
|
||||
|
||||
|
|
|
|||
|
|
@ -10,7 +10,7 @@
|
|||
test-get-name! test-group-name test-group-ref
|
||||
test-group-set! test-group-inc! test-group-push!
|
||||
;; parameters
|
||||
current-test-verbosity
|
||||
current-test-value-formatter current-test-verbosity
|
||||
current-test-applier current-test-skipper current-test-reporter
|
||||
current-test-group-reporter test-failure-count
|
||||
current-test-epsilon current-test-comparator
|
||||
|
|
|
|||
24
lib/srfi/35.sld
Normal file
24
lib/srfi/35.sld
Normal file
|
|
@ -0,0 +1,24 @@
|
|||
(define-library (srfi 35)
|
||||
(import (srfi 35 internal))
|
||||
(export make-condition-type
|
||||
condition-type?
|
||||
make-condition
|
||||
condition?
|
||||
condition-has-type?
|
||||
condition-ref
|
||||
make-compound-condition
|
||||
extract-condition
|
||||
define-condition-type
|
||||
condition
|
||||
|
||||
&condition
|
||||
|
||||
&message
|
||||
message-condition?
|
||||
condition-message
|
||||
|
||||
&serious
|
||||
serious-condition?
|
||||
|
||||
&error
|
||||
error?))
|
||||
249
lib/srfi/35/internal.scm
Normal file
249
lib/srfi/35/internal.scm
Normal file
|
|
@ -0,0 +1,249 @@
|
|||
(define-record-type Simple-Condition
|
||||
(make-simple-condition)
|
||||
simple-condition?)
|
||||
|
||||
(define-record-type Compound-Condition
|
||||
(%make-compound-condition components)
|
||||
compound-condition?
|
||||
(components compound-condition-components))
|
||||
|
||||
(define (make-condition-type id parent field-names)
|
||||
(make-rtd id
|
||||
(list->vector
|
||||
(map
|
||||
(lambda (field-name)
|
||||
(list 'immutable field-name))
|
||||
field-names))
|
||||
parent))
|
||||
|
||||
(define (condition? obj)
|
||||
(or (simple-condition? obj)
|
||||
(compound-condition? obj)))
|
||||
|
||||
(define (condition-type? obj)
|
||||
(condition-subtype? obj Simple-Condition))
|
||||
|
||||
(define (condition-subtype? maybe-child-ct maybe-parent-ct)
|
||||
(and (rtd? maybe-child-ct)
|
||||
(or (eqv? maybe-child-ct maybe-parent-ct)
|
||||
(condition-subtype? (rtd-parent maybe-child-ct)
|
||||
maybe-parent-ct))))
|
||||
|
||||
(define (condition-type-ancestors ct)
|
||||
(unfold (lambda (a) (not (condition-type? a)))
|
||||
(lambda (a) a)
|
||||
(lambda (a) (rtd-parent a))
|
||||
ct))
|
||||
|
||||
(define (condition-type-common-ancestor ct_1 ct_2)
|
||||
(let ((ct_1-as (condition-type-ancestors ct_1))
|
||||
(ct_2-as (condition-type-ancestors ct_2)))
|
||||
(find (lambda (a)
|
||||
(memv a ct_2-as))
|
||||
ct_1-as)))
|
||||
|
||||
(define (make-condition ct . plist)
|
||||
(define *undef* (cons '*undef* '()))
|
||||
(let* ((field-names (rtd-all-field-names ct))
|
||||
(field-values (make-vector (vector-length field-names) *undef*)))
|
||||
(let loop ((property plist))
|
||||
(if (null? property)
|
||||
(cond ((vector-any (lambda (name value)
|
||||
(and (eq? value *undef*) name))
|
||||
field-names
|
||||
field-values)
|
||||
=> (lambda (undef-field-name)
|
||||
(error "make-condition: value not given for field"
|
||||
undef-field-name
|
||||
ct)))
|
||||
(else
|
||||
(apply (rtd-constructor ct) (vector->list field-values))))
|
||||
(let ((idx (vector-index (lambda (x) (eq? x (car property)))
|
||||
field-names)))
|
||||
(if idx
|
||||
(begin
|
||||
(vector-set! field-values idx (cadr property))
|
||||
(loop (cddr property)))
|
||||
(error "make-condition: unknown field" (car property))))))))
|
||||
|
||||
(define (make-compound-condition . cs)
|
||||
(if (= (length cs) 1)
|
||||
(car cs)
|
||||
;; SRFI 35 requires at least one component, but R6RS doesn’t;
|
||||
;; defer to R6RS’s less strict error checking (!)
|
||||
(%make-compound-condition
|
||||
(append-map
|
||||
(lambda (c)
|
||||
(if (simple-condition? c)
|
||||
(list c)
|
||||
(compound-condition-components c)))
|
||||
cs))))
|
||||
|
||||
(define (condition-has-type? c ct)
|
||||
(if (simple-condition? c)
|
||||
(is-a? c ct)
|
||||
(any
|
||||
(lambda (comp) (condition-has-type? comp ct))
|
||||
(compound-condition-components c))))
|
||||
|
||||
(define (condition-ref c field-name)
|
||||
(if (simple-condition? c)
|
||||
((rtd-accessor (record-rtd c) field-name) c)
|
||||
(condition-ref
|
||||
(find
|
||||
(lambda (comp)
|
||||
(find field-name
|
||||
(vector->list
|
||||
(rtd-all-field-names (record-rtd c)))))
|
||||
(compound-condition-components c))
|
||||
field-name)))
|
||||
|
||||
(define (simple-conditions c)
|
||||
(if (simple-condition? c)
|
||||
(list c)
|
||||
(compound-condition-components c)))
|
||||
|
||||
(define (extract-condition c ct)
|
||||
(if (and (simple-condition? c)
|
||||
(condition-has-type? c ct))
|
||||
c
|
||||
(find
|
||||
(lambda (comp)
|
||||
(condition-has-type? comp ct))
|
||||
(compound-condition-components ct))))
|
||||
|
||||
(define (condition-predicate ct)
|
||||
(lambda (obj)
|
||||
(and (condition? obj)
|
||||
(condition-has-type? obj ct))))
|
||||
(define (condition-accessor ct proc)
|
||||
(lambda (c)
|
||||
(cond ((and (simple-condition? c)
|
||||
(condition-has-type? c ct))
|
||||
(proc c))
|
||||
((find (lambda (comp) (condition-has-type? comp ct))
|
||||
(compound-condition-components c))
|
||||
=> (lambda (comp)
|
||||
(proc comp)))
|
||||
(else (error "condition-accessor: condition does not have the right type"
|
||||
c ct)))))
|
||||
|
||||
(define-syntax define-condition-type/constructor
|
||||
(syntax-rules ()
|
||||
((_ name parent constructor predicate
|
||||
(field-name field-accessor) ...)
|
||||
(begin
|
||||
(define ct (make-condition-type 'name
|
||||
parent
|
||||
'(field-name ...)))
|
||||
(define name ct)
|
||||
(define constructor (rtd-constructor ct))
|
||||
(define predicate (condition-predicate ct))
|
||||
(define field-accessor
|
||||
(condition-accessor ct
|
||||
(rtd-accessor ct 'field-name))) ...))))
|
||||
|
||||
(define-syntax define-condition-type
|
||||
(syntax-rules ()
|
||||
((_ name parent predicate (field-name field-accessor) ...)
|
||||
(define-condition-type/constructor
|
||||
name parent blah-ignored predicate
|
||||
(field-name field-accessor) ...))))
|
||||
|
||||
(define (%condition . specs)
|
||||
(define (find-common-field-spec ct name)
|
||||
(let loop ((more-specs specs))
|
||||
(if (null? more-specs)
|
||||
#f
|
||||
(let* ((other-ct (caar more-specs))
|
||||
(field-specs (cdar more-specs))
|
||||
(a (condition-type-common-ancestor ct other-ct)))
|
||||
(cond ((and (vector-index
|
||||
(lambda (n)
|
||||
(eq? n name))
|
||||
(rtd-all-field-names a))
|
||||
(assq name field-specs)))
|
||||
(else (loop (cdr more-specs))))))))
|
||||
(let loop ((more-specs specs)
|
||||
(components '()))
|
||||
(if (null? more-specs)
|
||||
(apply make-compound-condition (reverse components))
|
||||
(let* ((this-spec (car more-specs))
|
||||
(ct (car this-spec))
|
||||
(field-specs (cdr this-spec))
|
||||
(field-names (rtd-all-field-names ct))
|
||||
(field-values
|
||||
(vector-map
|
||||
(lambda (field-name)
|
||||
(cond ((assq field-name field-specs) => cdr)
|
||||
((find-common-field-spec ct field-name) => cdr)
|
||||
(else
|
||||
(error "condition: value not given for field"
|
||||
field-name
|
||||
ct))))
|
||||
field-names)))
|
||||
(loop
|
||||
(cdr more-specs)
|
||||
(cons
|
||||
(apply (rtd-constructor ct) (vector->list field-values))
|
||||
components))))))
|
||||
(define-syntax condition
|
||||
(syntax-rules ()
|
||||
((_ (ct (field-name field-value) ...) ...)
|
||||
(%condition (list ct (cons 'field-name field-value) ...) ...))))
|
||||
|
||||
(define &condition Simple-Condition)
|
||||
|
||||
(define-condition-type/constructor &message &condition
|
||||
make-message-condition message-condition?
|
||||
(message condition-message))
|
||||
|
||||
(define-condition-type/constructor &serious &condition
|
||||
make-serious-condition serious-condition?)
|
||||
|
||||
(define-condition-type/constructor &error &serious
|
||||
make-error error?)
|
||||
|
||||
;; (chibi repl) support
|
||||
(define-method (repl-print-exception (exn condition?) (out output-port?))
|
||||
(define components (simple-conditions exn))
|
||||
(define n-components (length components))
|
||||
(display "CONDITION: " out)
|
||||
(display n-components out)
|
||||
(display " component" out)
|
||||
(if (not (= n-components 1)) (display "s" out))
|
||||
(display "\n" out)
|
||||
(for-each
|
||||
(lambda (component idx)
|
||||
(define component-type (record-rtd component))
|
||||
(display " " out)
|
||||
(display idx out)
|
||||
(display ". " out)
|
||||
(display (rtd-name component-type) out)
|
||||
(display "\n" out)
|
||||
(let loop ((as (reverse
|
||||
(condition-type-ancestors component-type)))
|
||||
(idx 0))
|
||||
(if (not (null? as))
|
||||
(let ((a (car as)))
|
||||
(let a-loop ((fields (vector->list (rtd-field-names a)))
|
||||
(idx idx))
|
||||
(if (null? fields)
|
||||
(loop (cdr as) idx)
|
||||
(begin
|
||||
(display " " out)
|
||||
(display (if (pair? (car fields))
|
||||
(car (cdar fields))
|
||||
(car fields))
|
||||
out)
|
||||
(if (not (eqv? a component-type))
|
||||
(begin
|
||||
(display " (" out)
|
||||
(display (rtd-name a) out)
|
||||
(display ")" out)))
|
||||
(display ": " out)
|
||||
(write (slot-ref component-type component idx) out)
|
||||
(display "\n" out)
|
||||
(a-loop (cdr fields) (+ idx 1)))))))))
|
||||
components
|
||||
(iota n-components 1)))
|
||||
48
lib/srfi/35/internal.sld
Normal file
48
lib/srfi/35/internal.sld
Normal file
|
|
@ -0,0 +1,48 @@
|
|||
(define-library (srfi 35 internal)
|
||||
(import (except (scheme base)
|
||||
define-record-type
|
||||
;; exclude (srfi 1 immutable) duplicate imports:
|
||||
map cons list append reverse)
|
||||
(scheme write)
|
||||
(only (chibi)
|
||||
slot-ref
|
||||
is-a?)
|
||||
(only (chibi repl) repl-print-exception)
|
||||
(only (chibi generic) define-method)
|
||||
;; don’t let people go messing with a compound condition
|
||||
;; components list:
|
||||
(srfi 1 immutable)
|
||||
(srfi 99)
|
||||
(srfi 133))
|
||||
(export make-condition-type
|
||||
condition?
|
||||
condition-type?
|
||||
condition-subtype?
|
||||
make-condition
|
||||
make-compound-condition
|
||||
condition-has-type?
|
||||
condition-ref
|
||||
simple-conditions
|
||||
extract-condition
|
||||
condition-predicate
|
||||
condition-accessor
|
||||
define-condition-type/constructor
|
||||
define-condition-type
|
||||
condition
|
||||
|
||||
&condition
|
||||
|
||||
&message
|
||||
make-message-condition
|
||||
message-condition?
|
||||
condition-message
|
||||
|
||||
&serious
|
||||
make-serious-condition
|
||||
serious-condition?
|
||||
|
||||
&error
|
||||
make-error
|
||||
error?)
|
||||
|
||||
(include "internal.scm"))
|
||||
94
lib/srfi/35/test.sld
Normal file
94
lib/srfi/35/test.sld
Normal file
|
|
@ -0,0 +1,94 @@
|
|||
(define-library (srfi 35 test)
|
||||
(import (scheme base)
|
||||
(srfi 35 internal)
|
||||
(chibi test))
|
||||
(export run-tests)
|
||||
(begin
|
||||
(define (run-tests)
|
||||
(test-begin "srfi-35: condition types")
|
||||
(test-group "Adapted from the SRFI 35 examples"
|
||||
(define-condition-type &c &condition
|
||||
c?
|
||||
(x c-x))
|
||||
|
||||
(define-condition-type &c1 &c
|
||||
c1?
|
||||
(a c1-a))
|
||||
|
||||
(define-condition-type &c2 &c
|
||||
c2?
|
||||
(b c2-b))
|
||||
(define v1 (make-condition &c1 'x "V1" 'a "a1"))
|
||||
(define v2 (condition (&c2
|
||||
(x "V2")
|
||||
(b "b2"))))
|
||||
(define v3 (condition (&c1
|
||||
(x "V3/1")
|
||||
(a "a3"))
|
||||
(&c2
|
||||
(b "b3"))))
|
||||
(define v4 (make-compound-condition v1 v2))
|
||||
(define v5 (make-compound-condition v2 v3))
|
||||
|
||||
(test #t (c? v1))
|
||||
(test #t (c1? v1))
|
||||
(test #f (c2? v1))
|
||||
(test "V1" (c-x v1))
|
||||
(test "a1" (c1-a v1))
|
||||
|
||||
(test #t (c? v2))
|
||||
(test #f (c1? v2))
|
||||
(test #t (c2? v2))
|
||||
(test "V2" (c-x v2))
|
||||
(test "b2" (c2-b v2))
|
||||
|
||||
(test #t (c? v3))
|
||||
(test #t (c1? v3))
|
||||
(test #t (c2? v3))
|
||||
(test "V3/1" (c-x v3))
|
||||
(test "a3" (c1-a v3))
|
||||
(test "b3" (c2-b v3))
|
||||
|
||||
(test #t (c? v4))
|
||||
(test #t (c1? v4))
|
||||
(test #t (c2? v4))
|
||||
(test "V1" (c-x v4))
|
||||
(test "a1" (c1-a v4))
|
||||
(test "b2" (c2-b v4))
|
||||
|
||||
(test #t (c? v5))
|
||||
(test #t (c1? v5))
|
||||
(test #t (c2? v5))
|
||||
(test "V2" (c-x v5))
|
||||
(test "a3" (c1-a v5))
|
||||
(test "b2" (c2-b v5)))
|
||||
|
||||
(test-group "Standard condition hierarchy"
|
||||
(let ((mc (make-message-condition "foo!")))
|
||||
(test #t (message-condition? mc))
|
||||
(test "foo!" (condition-message mc))
|
||||
|
||||
(let ((ec (make-error)))
|
||||
(test #t (error? ec))
|
||||
(test #t (serious-condition? ec))
|
||||
|
||||
(let ((cc (make-compound-condition ec mc)))
|
||||
(test #t (error? cc))
|
||||
(test #t (serious-condition? cc))
|
||||
(test #t (message-condition? cc))
|
||||
(test "foo!" (condition-message mc))))))
|
||||
|
||||
(test-group "R6RS extension: shadowing field names"
|
||||
(define-condition-type/constructor &a &condition
|
||||
make-a a?
|
||||
(val a-val))
|
||||
(define-condition-type/constructor &b &a
|
||||
make-b b?
|
||||
(val b-val))
|
||||
|
||||
(define c (make-b 'a 'b))
|
||||
|
||||
(test 'a (a-val c))
|
||||
(test 'b (b-val c)))
|
||||
|
||||
(test-end))))
|
||||
|
|
@ -9,7 +9,13 @@
|
|||
(type? x))
|
||||
|
||||
(define (rtd-constructor rtd . o)
|
||||
(let ((fields (vector->list (if (pair? o) (car o) (rtd-all-field-names rtd))))
|
||||
(let ((fields
|
||||
(if (pair? o)
|
||||
(map
|
||||
(lambda (field)
|
||||
(rtd-field-offset rtd field))
|
||||
(vector->list (car o)))
|
||||
(iota (vector-length (rtd-all-field-names rtd)))))
|
||||
(make (make-constructor (type-name rtd) rtd)))
|
||||
(lambda args
|
||||
(let ((res (make)))
|
||||
|
|
@ -18,7 +24,7 @@
|
|||
((null? a) (if (null? p) res (error "not enough args" p)))
|
||||
((null? p) (error "too many args" a))
|
||||
(else
|
||||
(slot-set! rtd res (rtd-field-offset rtd (car p)) (car a))
|
||||
(slot-set! rtd res (car p) (car a))
|
||||
(lp (cdr a) (cdr p)))))))))
|
||||
|
||||
(define (rtd-predicate rtd)
|
||||
|
|
@ -35,13 +41,13 @@
|
|||
|
||||
(define (rtd-field-offset rtd field)
|
||||
(let ((p (type-parent rtd)))
|
||||
(or (and (type? p)
|
||||
(rtd-field-offset p field))
|
||||
(let ((i (field-index-of (type-slots rtd) field)))
|
||||
(or (let ((i (field-index-of (type-slots rtd) field)))
|
||||
(and i
|
||||
(if (type? p)
|
||||
(+ i (vector-length (rtd-all-field-names p)))
|
||||
i))))))
|
||||
i)))
|
||||
(and (type? p)
|
||||
(rtd-field-offset p field)))))
|
||||
|
||||
(define (rtd-accessor rtd field)
|
||||
(make-getter (type-name rtd) rtd (rtd-field-offset rtd field)))
|
||||
|
|
|
|||
|
|
@ -1,5 +1,8 @@
|
|||
|
||||
(define-library (srfi 99 records procedural)
|
||||
(export make-rtd rtd? rtd-constructor rtd-predicate rtd-accessor rtd-mutator)
|
||||
(import (chibi) (chibi ast) (srfi 99 records inspection))
|
||||
(import (chibi)
|
||||
(chibi ast)
|
||||
(only (srfi 1) iota)
|
||||
(srfi 99 records inspection))
|
||||
(include "procedural.scm"))
|
||||
|
|
|
|||
|
|
@ -8,6 +8,7 @@
|
|||
(rename (srfi 18 test) (run-tests run-srfi-18-tests))
|
||||
(rename (srfi 26 test) (run-tests run-srfi-26-tests))
|
||||
(rename (srfi 27 test) (run-tests run-srfi-27-tests))
|
||||
(rename (srfi 35 test) (run-tests run-srfi-35-tests))
|
||||
(rename (srfi 38 test) (run-tests run-srfi-38-tests))
|
||||
(rename (srfi 41 test) (run-tests run-srfi-41-tests))
|
||||
(rename (srfi 69 test) (run-tests run-srfi-69-tests))
|
||||
|
|
@ -83,6 +84,7 @@
|
|||
(run-srfi-18-tests)
|
||||
(run-srfi-26-tests)
|
||||
(run-srfi-27-tests)
|
||||
(run-srfi-35-tests)
|
||||
(run-srfi-38-tests)
|
||||
(run-srfi-41-tests)
|
||||
(run-srfi-69-tests)
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue