>From 2cac19c5eb144f988b90914ee05a0a4fc3b2e9eb Mon Sep 17 00:00:00 2001 From: Evan Hanson Date: Wed, 15 Oct 2014 20:11:05 +1300 Subject: [PATCH] Remove srfi-14 --- LICENSE | 33 -- README | 1 - chicken-install.scm | 1 - defaults.make | 2 +- distribution/manifest | 6 - eval.scm | 2 +- manual/Modules | 1 - manual/Supported language | 1 - manual/Unit posix | 2 +- manual/Unit srfi-14 | 940 --------------------------------------------- manual/Unit srfi-4 | 2 +- rules.make | 4 +- scripts/compile-all | 2 +- setup-download.scm | 16 +- setup.defaults | 3 +- srfi-14.import.scm | 94 ----- srfi-14.scm | 831 --------------------------------------- tests/runtests.bat | 6 - tests/runtests.sh | 6 +- tests/srfi-14-tests.scm | 202 ---------- types.db | 77 ---- 21 files changed, 12 insertions(+), 2220 deletions(-) delete mode 100644 manual/Unit srfi-14 delete mode 100644 srfi-14.import.scm delete mode 100644 srfi-14.scm delete mode 100644 tests/srfi-14-tests.scm diff --git a/LICENSE b/LICENSE index 158bdb4..46ddd45 100644 --- a/LICENSE +++ b/LICENSE @@ -118,39 +118,6 @@ srfi-1.scm: this code as long as you do not remove this copyright notice or hold me liable for its use. Please send bug reports to address@hidden -srfi-14.scm: - - Copyright (c) 1988-1994 Massachusetts Institute of Technology. - Copyright (c) 1988-1995 Massachusetts Institute of Technology - This material was developed by the Scheme project at the Massachusetts - Institute of Technology, Department of Electrical Engineering and - Computer Science. Permission to copy and modify this software, to - redistribute either the original software or a modified version, and - to use this software for any purpose is granted, subject to the - following restrictions and understandings. - - 1. Any copy made of this software must include this copyright notice - in full. - - 2. Users of this software agree to make their best efforts (a) to - return to the MIT Scheme project any improvements or extensions that - they make, so that these may be included in future releases; and (b) - to inform MIT of noteworthy uses of this software. - - 3. All materials developed as a consequence of the use of this - software shall duly acknowledge such use, in accordance with the usual - standards of acknowledging credit in academic research. - - 4. MIT has made no warrantee or representation that the operation of - this software will be error-free, and MIT is under no obligation to - provide any services, by way of maintenance, update, or otherwise. - - 5. In conjunction with products arising from the use of this material, - there shall be no use of the name of the Massachusetts Institute of - Technology nor of any adaptation thereof in any advertising, - promotional, or sales literature without prior written consent from - MIT in each case. - === Public domain / unencumbered Since we would still like to acknowledge all the useful contributions diff --git a/README b/README index c7ffd5b..3bbb06b 100644 --- a/README +++ b/README @@ -299,7 +299,6 @@ | | |-- setup-download.import.so | | |-- setup-download.so | | |-- srfi-1.import.so - | | |-- srfi-14.import.so | | |-- srfi-4.import.so | | |-- tcp.import.so | | |-- types.db diff --git a/chicken-install.scm b/chicken-install.scm index 097d0f7..5b5140d 100644 --- a/chicken-install.scm +++ b/chicken-install.scm @@ -48,7 +48,6 @@ "files.import.so" "posix.import.so" "extras.import.so" - "srfi-14.import.so" "tcp.import.so" "foreign.import.so" "utils.import.so" diff --git a/defaults.make b/defaults.make index 7f64f8f..5ae7864 100644 --- a/defaults.make +++ b/defaults.make @@ -275,7 +275,7 @@ CHICKEN_INSTALL_PROGRAM = $(PROGRAM_PREFIX)chicken-install$(PROGRAM_SUFFIX) CHICKEN_UNINSTALL_PROGRAM = $(PROGRAM_PREFIX)chicken-uninstall$(PROGRAM_SUFFIX) CHICKEN_STATUS_PROGRAM = $(PROGRAM_PREFIX)chicken-status$(PROGRAM_SUFFIX) CHICKEN_BUG_PROGRAM = $(PROGRAM_PREFIX)chicken-bug$(PROGRAM_SUFFIX) -IMPORT_LIBRARIES = chicken lolevel srfi-1 srfi-4 data-structures ports files posix extras srfi-14 tcp foreign utils csi irregex +IMPORT_LIBRARIES = chicken lolevel srfi-1 srfi-4 data-structures ports files posix extras tcp foreign utils csi irregex IMPORT_LIBRARIES += setup-api setup-download ifdef STATICBUILD diff --git a/distribution/manifest b/distribution/manifest index 61cbc65..3570389 100644 --- a/distribution/manifest +++ b/distribution/manifest @@ -38,7 +38,6 @@ posixwin.c profiler.c scheduler.c srfi-1.c -srfi-14.c srfi-4.c stub.c support.c @@ -91,7 +90,6 @@ profiler.scm runtime.c scheduler.scm srfi-1.scm -srfi-14.scm srfi-4.scm stub.scm support.scm @@ -119,7 +117,6 @@ tests/runtests.sh tests/runtests.bat tests/runbench.sh tests/srfi-4-tests.scm -tests/srfi-14-tests.scm tests/srfi-45-tests.scm tests/apply-test.scm tests/embedded1.c @@ -255,7 +252,6 @@ data-structures.import.scm posix.import.scm extras.import.scm irregex.import.scm -srfi-14.import.scm tcp.import.scm utils.import.scm lolevel.import.c @@ -265,7 +261,6 @@ data-structures.import.c posix.import.c extras.import.c irregex.import.c -srfi-14.import.c tcp.import.c utils.import.c csi.import.scm @@ -341,7 +336,6 @@ manual-html/Unit ports.html manual-html/Unit posix.html manual-html/Unit irregex.html manual-html/Unit srfi-1.html -manual-html/Unit srfi-14.html manual-html/Unit srfi-4.html manual-html/Unit tcp.html manual-html/Unit utils.html diff --git a/eval.scm b/eval.scm index 8d79f3d..c350522 100644 --- a/eval.scm +++ b/eval.scm @@ -62,7 +62,7 @@ (define ##sys#core-library-modules '(extras lolevel utils files tcp irregex posix srfi-1 srfi-4 - srfi-14 data-structures ports)) + data-structures ports)) (define ##sys#core-syntax-modules '(chicken-syntax chicken-ffi-syntax)) diff --git a/manual/Modules b/manual/Modules index d3ca0d9..32e1010 100644 --- a/manual/Modules +++ b/manual/Modules @@ -280,7 +280,6 @@ Everything from the {{library}}, {{eval}} and {{expand}} library units. [module] regex [module] srfi-1 [module] srfi-4 - [module] srfi-14 [module] tcp [module] utils diff --git a/manual/Supported language b/manual/Supported language index 66782f8..914348b 100644 --- a/manual/Supported language +++ b/manual/Supported language @@ -23,7 +23,6 @@ * [[Unit irregex]] Regular expressions * [[Unit srfi-1]] List Library * [[Unit srfi-4]] Homogeneous numeric vectors -* [[Unit srfi-14]] Character set library * [[Unit posix]] Unix-like services * [[Unit utils]] Shell scripting and file operations * [[Unit tcp]] Basic TCP-sockets diff --git a/manual/Unit posix b/manual/Unit posix index b7b0c07..48f6125 100644 --- a/manual/Unit posix +++ b/manual/Unit posix @@ -1433,6 +1433,6 @@ Returns: * -1 when failure ---- -Previous: [[Unit srfi-14]] +Previous: [[Unit srfi-4]] Next: [[Unit utils]] diff --git a/manual/Unit srfi-14 b/manual/Unit srfi-14 deleted file mode 100644 index f2d2995..0000000 --- a/manual/Unit srfi-14 +++ /dev/null @@ -1,940 +0,0 @@ -[[tags: manual]] - -== Unit srfi-14 - -Character set library. An abbreviated version of the SRFI is provided -in this document. Full documentation is available in the -[[http://srfi.schemers.org/srfi-14/srfi-14.html|original SRFI-14 -document]]. - -On systems that support dynamic loading, the {{srfi-14}} unit can -be made available in the interpreter ({{csi}}) by entering - - -(require-extension srfi-14) - - -This library provides only the Latin-1 character set. To get Unicode -semantics, see the [[/egg/utf8|utf8]] egg. However, information on Unicode -character sets is still provided in this document. - -== Specification - -In the following procedure specifications: - - -* A CS parameter is a character set. -* An S parameter is a string. -* A CHAR parameter is a character. -* A CHAR-LIST parameter is a list of characters. -* A PRED parameter is a unary character predicate procedure, returning a true/false value when applied to a character. -* An OBJ parameter may be any value at all. - -Passing values to procedures with these parameters that do not satisfy -these types is an error. - -Unless otherwise noted in the specification of a procedure, procedures -always return character sets that are distinct (from the point of view -of the linear-update operations) from the parameter character sets. For -example, {{char-set-adjoin}} is guaranteed to provide a fresh character -set, even if it is not given any character parameters. - -Parameters given in square brackets are optional. Unless otherwise noted in -the text describing the procedure, any prefix of these optional parameters -may be supplied, from zero arguments to the full list. When a procedure -returns multiple values, this is shown by listing the return values in -square brackets, as well. So, for example, the procedure with signature - - - halts? F [X INIT-STORE] -> [BOOLEAN INTEGER] - - -would take one (F), two (F, X) or three (F, X, INIT-STORE) input -parameters, and return two values, a boolean and an integer. - -A parameter followed by "{{...}}" means zero-or-more elements. So the -procedure with the signature - - - sum-squares X ... -> NUMBER - -takes zero or more arguments (X ...), while the procedure with signature - - - spell-check DOC DICT_1 DICT_2 ... -> STRING-LIST - - -takes two required parameters (DOC and DICT_1) and zero or more optional -parameters (DICT_2 ...). - - -=== General procedures - -(char-set? obj) -> boolean
- -Is the object OBJ a character set? - -(char-set= cs_1 ...) -> boolean
- -Are the character sets equal? - -Boundary cases: - - - (char-set=) => TRUE - (char-set= cs) => TRUE - -Rationale: transitive binary relations are generally extended to n-ary -relations in Scheme, which enables clearer, more concise code to be -written. While the zero-argument and one-argument cases will almost -certainly not arise in first-order uses of such relations, they may well -arise in higher-order cases or macro-generated code. ''E.g.,'' consider - - - (apply char-set= cset-list) - - -This is well-defined if the list is empty or a singleton list. Hence -we extend these relations to any number of arguments. Implementors have -reported actual uses of n-ary relations in higher-order cases allowing for -fewer than two arguments. The way of Scheme is to handle the general case; -we provide the fully general extension. - -A counter-argument to this extension is that R5RS's transitive binary -arithmetic relations ({{=}}, {{<}}, ''etc.'') require at least two -arguments, hence this decision is a break with the prior convention -- -although it is at least one that is backwards-compatible. - -(char-set<= cs_1 ...) -> boolean
- -Returns true if every character set CS_I is a subset of character set -CS_I+1. - -Boundary cases: - - - (char-set<=) => TRUE - (char-set<= cs) => TRUE - -Rationale: See {{char-set=}} for discussion of zero- and one-argument -applications. Consider testing a list of char-sets for monotonicity with - - - (apply char-set<= cset-list) - -(char-set-hash cs [bound]) -> integer
- -Compute a hash value for the character set CS. BOUND is a non-negative -exact integer specifying the range of the hash function. A positive value -restricts the return value to the range [0,BOUND). - -If BOUND is either zero or not given, the implementation may use an -implementation-specific default value, chosen to be as large as is -efficiently practical. For instance, the default range might be chosen for -a given implementation to map all strings into the range of integers that -can be represented with a single machine word. - -Invariant: - - - (char-set= cs_1 cs_2) => (= (char-set-hash cs_1 b) (char-set-hash cs_2 b)) - - -A legal but nonetheless discouraged implementation: - - - (define (char-set-hash cs . maybe-bound) 1) - -Rationale: allowing the user to specify an explicit bound simplifies user -code by removing the mod operation that typically accompanies every hash -computation, and also may allow the implementation of the hash function to -exploit a reduced range to efficiently compute the hash value. ''E.g.'', -for small bounds, the hash function may be computed in a fashion such -that intermediate values never overflow into bignum integers, allowing -the implementor to provide a fixnum-specific "fast path" for computing the -common cases very rapidly. - - -=== Iterating over character sets - -(char-set-cursor cset) -> cursor
-(char-set-ref cset cursor) -> char
-(char-set-cursor-next cset cursor) -> cursor
-(end-of-char-set? cursor) -> boolean
- -Cursors are a low-level facility for iterating over the characters -in a set. A cursor is a value that indexes a character in a char set. -{{char-set-cursor}} produces a new cursor for a given char set. The -set element indexed by the cursor is fetched with {{char-set-ref}}. -A cursor index is incremented with {{char-set-cursor-next}}; in this -way, code can step through every character in a char set. Stepping -a cursor "past the end" of a char set produces a cursor that answers -true to {{end-of-char-set?}}. It is an error to pass such a cursor to -{{char-set-ref}} or to {{char-set-cursor-next}}. - -A cursor value may not be used in conjunction with a different character -set; if it is passed to {{char-set-ref}} or {{char-set-cursor-next}} with a -character set other than the one used to create it, the results and effects -are undefined. - -Cursor values are ''not'' necessarily distinct from other types. They -may be integers, linked lists, records, procedures or other values. -This license is granted to allow cursors to be very "lightweight" values -suitable for tight iteration, even in fairly simple implementations. - -Note that these primitives are necessary to export an iteration facility -for char sets to loop macros. - -Example: - - - (define cs (char-set #\G #\a #\T #\e #\c #\h)) - - ;; Collect elts of CS into a list. - (let lp ((cur (char-set-cursor cs)) (ans '())) - (if (end-of-char-set? cur) ans - (lp (char-set-cursor-next cs cur) - (cons (char-set-ref cs cur) ans)))) - => (#\G #\T #\a #\c #\e #\h) - - ;; Equivalently, using a list unfold (from SRFI 1): - (unfold-right end-of-char-set? - (curry char-set-ref cs) - (curry char-set-cursor-next cs) - (char-set-cursor cs)) - => (#\G #\T #\a #\c #\e #\h) - -Rationale: Note that the cursor API's four functions "fit" the functional -protocol used by the unfolders provided by the list, string and char-set -SRFIs (see the example above). By way of contrast, here is a simpler, -two-function API that was rejected for failing this criterion. Besides -{{char-set-cursor}}, it provided a single function that mapped a cursor and -a character set to two values, the indexed character and the next cursor. -If the cursor had exhausted the character set, then this function returned -false instead of the character value, and another end-of-char-set cursor. -In this way, the other three functions of the current API were combined -together. - -(char-set-fold kons knil cs) -> object
- -This is the fundamental iterator for character sets. Applies the function -KONS across the character set CS using initial state value KNIL. That is, -if CS is the empty set, the procedure returns KNIL. Otherwise, some element -C of CS is chosen; let CS' be the remaining, unchosen characters. The -procedure returns - - - (char-set-fold KONS (KONS C KNIL) CS') - -Examples: - - - ;; CHAR-SET-MEMBERS - (lambda (cs) (char-set-fold cons '() cs)) - - ;; CHAR-SET-SIZE - (lambda (cs) (char-set-fold (lambda (c i) (+ i 1)) 0 cs)) - - ;; How many vowels in the char set? - (lambda (cs) - (char-set-fold (lambda (c i) (if (vowel? c) (+ i 1) i)) - 0 cs)) - -(char-set-unfold f p g seed [base-cs]) -> char-set
-(char-set-unfold! f p g seed base-cs) -> char-set
- -This is a fundamental constructor for char-sets. - - -* G is used to generate a series of "seed" values from the initial seed: SEED, (G SEED), (G^2 SEED), (G^3 SEED), ... -* P tells us when to stop -- when it returns true when applied to one of these seed values. -* F maps each seed value to a character. These characters are added to the base character set BASE-CS to form the result; BASE-CS defaults to the empty set. {{char-set-unfold!}} adds the characters to BASE-CS in a linear-update -- it is allowed, but not required, to side-effect and use BASE-CS's storage to construct the result. - -More precisely, the following definitions hold, ignoring the -optional-argument issues: - - - (define (char-set-unfold p f g seed base-cs) - (char-set-unfold! p f g seed (char-set-copy base-cs))) - - (define (char-set-unfold! p f g seed base-cs) - (let lp ((seed seed) (cs base-cs)) - (if (p seed) cs ; P says we are done. - (lp (g seed) ; Loop on (G SEED). - (char-set-adjoin! cs (f seed)))))) ; Add (F SEED) to set. - -(Note that the actual implementation may be more efficient.) - -Examples: - - - - (port->char-set p) = (char-set-unfold eof-object? values - (lambda (x) (read-char p)) - (read-char p)) - - (list->char-set lis) = (char-set-unfold null? car cdr lis) - - -(char-set-for-each proc cs) -> unspecified
- -Apply procedure PROC to each character in the character set CS. Note that -the order in which PROC is applied to the characters in the set is not -specified, and may even change from one procedure application to another. - -Nothing at all is specified about the value returned by this procedure; -it is not even required to be consistent from call to call. It is simply -required to be a value (or values) that may be passed to a command -continuation, ''e.g.'' as the value of an expression appearing as a -non-terminal subform of a {{begin}} expression. Note that in R5RS, this -restricts the procedure to returning a single value; non-R5RS systems may -not even provide this restriction. - -(char-set-map proc cs) -> char-set
- -PROC is a char->char procedure. Apply it to all the characters in the -char-set CS, and collect the results into a new character set. - -Essentially lifts PROC from a char->char procedure to a char-set -> -char-set procedure. - -Example: - - - (char-set-map char-downcase cset) - - -=== Creating character sets - -(char-set-copy cs) -> char-set
- -Returns a copy of the character set CS. "Copy" means that if either the -input parameter or the result value of this procedure is passed to one of -the linear-update procedures described below, the other character set is -guaranteed not to be altered. - -A system that provides pure-functional implementations of the -linear-operator suite could implement this procedure as the identity -function -- so copies are ''not'' guaranteed to be distinct by {{eq?}}. - -(char-set char_1 ...) -> char-set
- -Return a character set containing the given characters. - -(list->char-set char-list [base-cs]) -> char-set
-(list->char-set! char-list base-cs) -> char-set
- -Return a character set containing the characters in the list of characters -CHAR-LIST. - -If character set BASE-CS is provided, the characters from CHAR-LIST -are added to it. {{list->char-set!}} is allowed, but not required, to -side-effect and reuse the storage in BASE-CS; {{list->char-set}} produces a -fresh character set. - -(string->char-set s [base-cs]) -> char-set
-(string->char-set! s base-cs) -> char-set
- -Return a character set containing the characters in the string S. - -If character set BASE-CS is provided, the characters from S are added to -it. {{string->char-set!}} is allowed, but not required, to side-effect -and reuse the storage in BASE-CS; {{string->char-set}} produces a fresh -character set. - -(char-set-filter pred cs [base-cs]) -> char-set
-(char-set-filter! pred cs base-cs) -> char-set
- -Returns a character set containing every character C in CS such that -{{(PRED C)}} returns true. - -If character set BASE-CS is provided, the characters specified by PRED -are added to it. {{char-set-filter!}} is allowed, but not required, to -side-effect and reuse the storage in BASE-CS; {{char-set-filter}} produces -a fresh character set. - -An implementation may not save away a reference to PRED and invoke it after -{{char-set-filter}} or {{char-set-filter!}} returns -- that is, "lazy," -on-demand implementations are not allowed, as PRED may have external -dependencies on mutable data or have other side-effects. - -Rationale: This procedure provides a means of converting a character -predicate into its equivalent character set; the CS parameter allows the -programmer to bound the predicate's domain. Programmers should be aware -that filtering a character set such as {{char-set:full}} could be a very -expensive operation in an implementation that provided an extremely large -character type, such as 32-bit Unicode. An earlier draft of this library -provided a simple {{predicate->char-set}} procedure, which was rejected in -favor of {{char-set-filter}} for this reason. - -(ucs-range->char-set lower upper [error? base-cs]) -> char-set
-(ucs-range->char-set! lower upper error? base-cs) -> char-set
- -LOWER and UPPER are exact non-negative integers; LOWER <= UPPER. - -Returns a character set containing every character whose ISO/IEC 10646 -UCS-4 code lies in the half-open range [LOWER,UPPER). - - -* If the requested range includes unassigned UCS values, these are silently ignored (the current UCS specification has "holes" in the space of assigned codes). -* If the requested range includes "private" or "user space" codes, these are handled in an implementation-specific manner; however, a UCS- or Unicode-based Scheme implementation should pass them through transparently. -* If any code from the requested range specifies a valid, assigned UCS character that has no corresponding representative in the implementation's character type, then (1) an error is raised if ERROR? is true, and (2) the code is ignored if ERROR? is false (the default). This might happen, for example, if the implementation uses ASCII characters, and the requested range includes non-ASCII characters. - -If character set BASE-CS is provided, the characters specified by the range -are added to it. {{ucs-range->char-set!}} is allowed, but not required, -to side-effect and reuse the storage in BASE-CS; {{ucs-range->char-set}} -produces a fresh character set. - -Note that ASCII codes are a subset of the Latin-1 codes, which are in turn -a subset of the 16-bit Unicode codes, which are themselves a subset of -the 32-bit UCS-4 codes. We commit to a specific encoding in this routine, -regardless of the underlying representation of characters, so that client -code using this library will be portable. ''I.e.'', a conformant Scheme -implementation may use EBCDIC or SHIFT-JIS to encode characters; it -must simply map the UCS characters from the given range into the native -representation when possible, and report errors when not possible. - -(->char-set x) -> char-set
- -Coerces X into a char-set. X may be a string, character or char-set. A -string is converted to the set of its constituent characters; a character -is converted to a singleton set; a char-set is returned as-is. This -procedure is intended for use by other procedures that want to provide -"user-friendly," wide-spectrum interfaces to their clients. - - -=== Querying character sets - -(char-set-size cs) -> integer
- -Returns the number of elements in character set CS. - -(char-set-count pred cs) -> integer
- -Apply PRED to the chars of character set CS, and return the number of chars -that caused the predicate to return true. - -(char-set->list cs) -> character-list
- -This procedure returns a list of the members of character set CS. The order -in which CS's characters appear in the list is not defined, and may be -different from one call to another. - -(char-set->string cs) -> string
- -This procedure returns a string containing the members of character set CS. -The order in which CS's characters appear in the string is not defined, and -may be different from one call to another. - -(char-set-contains? cs char) -> boolean
- -This procedure tests CHAR for membership in character set CS. - -The MIT Scheme character-set package called this procedure -CHAR-SET-MEMBER?, but the argument order isn't consistent with the name. - -(char-set-every pred cs) -> boolean
-(char-set-any pred cs) -> boolean
- -The {{char-set-every}} procedure returns true if predicate PRED returns -true of every character in the character set CS. Likewise, {{char-set-any}} -applies PRED to every character in character set CS, and returns the first -true value it finds. If no character produces a true value, it returns -false. The order in which these procedures sequence through the elements of -CS is not specified. - -Note that if you need to determine the actual character on which a -predicate returns true, use {{char-set-any}} and arrange for the predicate -to return the character parameter as its true value, ''e.g.'' - - - (char-set-any (lambda (c) (and (char-upper-case? c) c)) - cs) - - -=== Character-set algebra - -(char-set-adjoin cs char_1 ...) -> char-set
-(char-set-delete cs char_1 ...) -> char-set
- -Add/delete the CHAR_I characters to/from character set CS. - -(char-set-adjoin! cs char_1 ...) -> char-set
-(char-set-delete! cs char_1 ...) -> char-set
- -Linear-update variants. These procedures are allowed, but not required, to -side-effect their first parameter. - -(char-set-complement cs) -> char-set
-(char-set-union cs_1 ...) -> char-set
-(char-set-intersection cs_1 ...) -> char-set
-(char-set-difference cs_1 cs_2 ...) -> char-set
-(char-set-xor cs_1 ...) -> char-set
-(char-set-diff+intersection cs_1 cs_2 ...) -> [char-set char-set]
- -These procedures implement set complement, union, intersection, difference, -and exclusive-or for character sets. The union, intersection and xor -operations are n-ary. The difference function is also n-ary, associates to -the left (that is, it computes the difference between its first argument -and the union of all the other arguments), and requires at least one -argument. - -Boundary cases: - - - (char-set-union) => char-set:empty - (char-set-intersection) => char-set:full - (char-set-xor) => char-set:empty - (char-set-difference CS) => CS - - -{{char-set-diff+intersection}} returns both the difference and the -intersection of the arguments -- it partitions its first parameter. It is -equivalent to - - - (values (char-set-difference CS_1 CS_2 ...) - (char-set-intersection CS_1 (char-set-union CS_2 ...))) - - -but can be implemented more efficiently. - -Programmers should be aware that {{char-set-complement}} could potentially -be a very expensive operation in Scheme implementations that provide a very -large character type, such as 32-bit Unicode. If this is a possibility, -sets can be complimented with respect to a smaller universe using -{{char-set-difference}}. - -(char-set-complement! cs) -> char-set
-(char-set-union! cs_1 cs_2 ...) -> char-set
-(char-set-intersection! cs_1 cs_2 ...) -> char-set
-(char-set-difference! cs_1 cs_2 ...) -> char-set
-(char-set-xor! cs_1 cs_2 ...) -> char-set
-(char-set-diff+intersection! cs_1 cs_2 cs_3 ...) -> [char-set char-set]
- -These are linear-update variants of the set-algebra functions. They are -allowed, but not required, to side-effect their first (required) parameter. - -{{char-set-diff+intersection!}} is allowed to side-effect both of its two -required parameters, CS_1 and CS_2. - -== Standard character sets - -Several character sets are predefined for convenience: - - - - - - - - - - - - - - - - - - -
{{char-set:lower-case}}Lower-case letters
{{char-set:upper-case}}Upper-case letters
{{char-set:title-case}}Title-case letters
{{char-set:letter}}Letters
{{char-set:digit}}Digits
{{char-set:letter+digit}}Letters and digits
{{char-set:graphic}}Printing characters except spaces
{{char-set:printing}}Printing characters including spaces
{{char-set:whitespace}}Whitespace characters
{{char-set:iso-control}}The ISO control characters
{{char-set:punctuation}}Punctuation characters
{{char-set:symbol}}Symbol characters
{{char-set:hex-digit}}A hexadecimal digit: 0-9, A-F, a-f
{{char-set:blank}}Blank characters -- horizontal whitespace
{{char-set:ascii}}All characters in the ASCII set.
{{char-set:empty}}Empty set
{{char-set:full}}All characters
- -In Unicode Scheme implementations, the base character sets are compatible -with Java's Unicode specifications. For ASCII or Latin-1, we simply -restrict the Unicode set specifications to their first 128 or 256 codes, -respectively. - -Here are the definitions for some of the sets in an ASCII implementation: - - - - - - - - - - - - -
{{char-set:lower-case}}a-z
{{char-set:upper-case}}A-Z
{{char-set:letter}}A-Z and a-z
{{char-set:digit}}0123456789
{{char-set:punctuation}}{{!"#%&'()*,-./:;address@hidden
{{char-set:symbol}}{{$+<=>^`|~}}
{{char-set:whitespace}}Space, newline, tab, form feed, vertical tab, carriage return
{{char-set:blank}}Space and tab
{{char-set:graphic}}letter + digit + punctuation + symbol
{{char-set:printing}}graphic + whitespace
{{char-set:iso-control}}ASCII 0-31 and 127
- -=== Character set constants - -char-set:lower-case - -For Unicode, a character is lowercase if - - -* it is not in the range [U+2000,U+2FFF], and -* the Unicode attribute table does not give a lowercase mapping for it, and -* at least one of the following is true: -** the Unicode attribute table gives a mapping to uppercase for the character, or -** the name for the character in the Unicode attribute table contains the words "SMALL LETTER" or "SMALL LIGATURE". - -The lower-case ASCII characters are - -abcdefghijklmnopqrstuvwxyz - -Latin-1 adds another 33 lower-case characters to the ASCII set: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
00B5MICRO SIGN
00DFLATIN SMALL LETTER SHARP S
00E0LATIN SMALL LETTER A WITH GRAVE
00E1LATIN SMALL LETTER A WITH ACUTE
00E2LATIN SMALL LETTER A WITH CIRCUMFLEX
00E3LATIN SMALL LETTER A WITH TILDE
00E4LATIN SMALL LETTER A WITH DIAERESIS
00E5LATIN SMALL LETTER A WITH RING ABOVE
00E6LATIN SMALL LETTER AE
00E7LATIN SMALL LETTER C WITH CEDILLA
00E8LATIN SMALL LETTER E WITH GRAVE
00E9LATIN SMALL LETTER E WITH ACUTE
00EALATIN SMALL LETTER E WITH CIRCUMFLEX
00EBLATIN SMALL LETTER E WITH DIAERESIS
00ECLATIN SMALL LETTER I WITH GRAVE
00EDLATIN SMALL LETTER I WITH ACUTE
00EELATIN SMALL LETTER I WITH CIRCUMFLEX
00EFLATIN SMALL LETTER I WITH DIAERESIS
00F0LATIN SMALL LETTER ETH
00F1LATIN SMALL LETTER N WITH TILDE
00F2LATIN SMALL LETTER O WITH GRAVE
00F3LATIN SMALL LETTER O WITH ACUTE
00F4LATIN SMALL LETTER O WITH CIRCUMFLEX
00F5LATIN SMALL LETTER O WITH TILDE
00F6LATIN SMALL LETTER O WITH DIAERESIS
00F8LATIN SMALL LETTER O WITH STROKE
00F9LATIN SMALL LETTER U WITH GRAVE
00FALATIN SMALL LETTER U WITH ACUTE
00FBLATIN SMALL LETTER U WITH CIRCUMFLEX
00FCLATIN SMALL LETTER U WITH DIAERESIS
00FDLATIN SMALL LETTER Y WITH ACUTE
00FELATIN SMALL LETTER THORN
00FFLATIN SMALL LETTER Y WITH DIAERESIS
- -Note that three of these have no corresponding Latin-1 upper-case -character: - - - - - -
00B5MICRO SIGN
00DFLATIN SMALL LETTER SHARP S
00FFLATIN SMALL LETTER Y WITH DIAERESIS
- -(The compatibility micro character uppercases to the non-Latin-1 Greek -capital mu; the German sharp s character uppercases to the pair of -characters "SS," and the capital y-with-diaeresis is non-Latin-1.) - -char-set:upper-case - -For Unicode, a character is uppercase if - - -* it is not in the range [U+2000,U+2FFF], and -* the Unicode attribute table does not give an uppercase mapping for it (this excludes titlecase characters), and -* at least one of the following is true: -** the Unicode attribute table gives a mapping to lowercase for the character, or -** the name for the character in the Unicode attribute table contains the words "CAPITAL LETTER" or "CAPITAL LIGATURE". - -The upper-case ASCII characters are - -ABCDEFGHIJKLMNOPQRSTUVWXYZ - -Latin-1 adds another 30 upper-case characters to the ASCII set: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
00C0LATIN CAPITAL LETTER A WITH GRAVE
00C1LATIN CAPITAL LETTER A WITH ACUTE
00C2LATIN CAPITAL LETTER A WITH CIRCUMFLEX
00C3LATIN CAPITAL LETTER A WITH TILDE
00C4LATIN CAPITAL LETTER A WITH DIAERESIS
00C5LATIN CAPITAL LETTER A WITH RING ABOVE
00C6LATIN CAPITAL LETTER AE
00C7LATIN CAPITAL LETTER C WITH CEDILLA
00C8LATIN CAPITAL LETTER E WITH GRAVE
00C9LATIN CAPITAL LETTER E WITH ACUTE
00CALATIN CAPITAL LETTER E WITH CIRCUMFLEX
00CBLATIN CAPITAL LETTER E WITH DIAERESIS
00CCLATIN CAPITAL LETTER I WITH GRAVE
00CDLATIN CAPITAL LETTER I WITH ACUTE
00CELATIN CAPITAL LETTER I WITH CIRCUMFLEX
00CFLATIN CAPITAL LETTER I WITH DIAERESIS
00D0LATIN CAPITAL LETTER ETH
00D1LATIN CAPITAL LETTER N WITH TILDE
00D2LATIN CAPITAL LETTER O WITH GRAVE
00D3LATIN CAPITAL LETTER O WITH ACUTE
00D4LATIN CAPITAL LETTER O WITH CIRCUMFLEX
00D5LATIN CAPITAL LETTER O WITH TILDE
00D6LATIN CAPITAL LETTER O WITH DIAERESIS
00D8LATIN CAPITAL LETTER O WITH STROKE
00D9LATIN CAPITAL LETTER U WITH GRAVE
00DALATIN CAPITAL LETTER U WITH ACUTE
00DBLATIN CAPITAL LETTER U WITH CIRCUMFLEX
00DCLATIN CAPITAL LETTER U WITH DIAERESIS
00DDLATIN CAPITAL LETTER Y WITH ACUTE
00DELATIN CAPITAL LETTER THORN
- - -char-set:title-case - -In Unicode, a character is titlecase if it has the category Lt in the -character attribute database. There are very few of these characters; here -is the entire 31-character list as of Unicode 3.0: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
01C5LATIN CAPITAL LETTER D WITH SMALL LETTER Z WITH CARON
01C8LATIN CAPITAL LETTER L WITH SMALL LETTER J
01CBLATIN CAPITAL LETTER N WITH SMALL LETTER J
01F2LATIN CAPITAL LETTER D WITH SMALL LETTER Z
1F88GREEK CAPITAL LETTER ALPHA WITH PSILI AND PROSGEGRAMMENI
1F89GREEK CAPITAL LETTER ALPHA WITH DASIA AND PROSGEGRAMMENI
1F8AGREEK CAPITAL LETTER ALPHA WITH PSILI AND VARIA AND PROSGEGRAMMENI
1F8BGREEK CAPITAL LETTER ALPHA WITH DASIA AND VARIA AND PROSGEGRAMMENI
1F8CGREEK CAPITAL LETTER ALPHA WITH PSILI AND OXIA AND PROSGEGRAMMENI
1F8DGREEK CAPITAL LETTER ALPHA WITH DASIA AND OXIA AND PROSGEGRAMMENI
1F8EGREEK CAPITAL LETTER ALPHA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI
1F8FGREEK CAPITAL LETTER ALPHA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI
1F98GREEK CAPITAL LETTER ETA WITH PSILI AND PROSGEGRAMMENI
1F99GREEK CAPITAL LETTER ETA WITH DASIA AND PROSGEGRAMMENI
1F9AGREEK CAPITAL LETTER ETA WITH PSILI AND VARIA AND PROSGEGRAMMENI
1F9BGREEK CAPITAL LETTER ETA WITH DASIA AND VARIA AND PROSGEGRAMMENI
1F9CGREEK CAPITAL LETTER ETA WITH PSILI AND OXIA AND PROSGEGRAMMENI
1F9DGREEK CAPITAL LETTER ETA WITH DASIA AND OXIA AND PROSGEGRAMMENI
1F9EGREEK CAPITAL LETTER ETA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI
1F9FGREEK CAPITAL LETTER ETA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI
1FA8GREEK CAPITAL LETTER OMEGA WITH PSILI AND PROSGEGRAMMENI
1FA9GREEK CAPITAL LETTER OMEGA WITH DASIA AND PROSGEGRAMMENI
1FAAGREEK CAPITAL LETTER OMEGA WITH PSILI AND VARIA AND PROSGEGRAMMENI
1FABGREEK CAPITAL LETTER OMEGA WITH DASIA AND VARIA AND PROSGEGRAMMENI
1FACGREEK CAPITAL LETTER OMEGA WITH PSILI AND OXIA AND PROSGEGRAMMENI
1FADGREEK CAPITAL LETTER OMEGA WITH DASIA AND OXIA AND PROSGEGRAMMENI
1FAEGREEK CAPITAL LETTER OMEGA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI
1FAFGREEK CAPITAL LETTER OMEGA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI
1FBCGREEK CAPITAL LETTER ALPHA WITH PROSGEGRAMMENI
1FCCGREEK CAPITAL LETTER ETA WITH PROSGEGRAMMENI
1FFCGREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI
- -There are no ASCII or Latin-1 titlecase characters. - - -char-set:letter - -In Unicode, a letter is any character with one of the letter categories -(Lu, Ll, Lt, Lm, Lo) in the Unicode character database. - -There are 52 ASCII letters - -abcdefghijklmnopqrstuvwxyz ABCDEFGHIJKLMNOPQRSTUVWXYZ - -There are 117 Latin-1 letters. These are the 115 characters that are -members of the Latin-1 {{char-set:lower-case}} and {{char-set:upper-case}} -sets, plus - - - - -
00AAFEMININE ORDINAL INDICATOR
00BAMASCULINE ORDINAL INDICATOR
- -(These two letters are considered lower-case by Unicode, but not by SRFI 14.) - - -char-set:digit - -In Unicode, a character is a digit if it has the category Nd in the -character attribute database. In Latin-1 and ASCII, the only such -characters are 0123456789. In Unicode, there are other digit characters in -other code blocks, such as Gujarati digits and Tibetan digits. - - -char-set:hex-digit - -The only hex digits are 0123456789abcdefABCDEF. - - -char-set:letter+digit - -The union of {{char-set:letter}} and {{char-set:digit.}} - - -char-set:graphic - -A graphic character is one that would put ink on paper. The ASCII and -Latin-1 graphic characters are the members of - - - - - - -
{{char-set:letter}}
{{char-set:digit}}
{{char-set:punctuation}}
{{char-set:symbol}}
- - -char-set:printing - -A printing character is one that would occupy space when printed, ''i.e.'', -a graphic character or a space character. {{char-set:printing}} is the -union of {{char-set:whitespace}} and {{char-set:graphic.}} - - -char-set:whitespace - -In Unicode, a whitespace character is either - - -* a character with one of the space, line, or paragraph separator categories (Zs, Zl or Zp) of the Unicode character database. -* U+0009 Horizontal tabulation (\t control-I) -* U+000A Line feed (\n control-J) -* U+000B Vertical tabulation (\v control-K) -* U+000C Form feed (\f control-L) -* U+000D Carriage return (\r control-M) - -There are 24 whitespace characters in Unicode 3.0: - - - - - - - - - - - - - - - - - - - - - - - - - - -
0009HORIZONTAL TABULATION\t control-I
000ALINE FEED\n control-J
000BVERTICAL TABULATION\v control-K
000CFORM FEED\f control-L
000DCARRIAGE RETURN\r control-M
0020SPACEZs
00A0NO-BREAK SPACEZs
1680OGHAM SPACE MARKZs
2000EN QUADZs
2001EM QUADZs
2002EN SPACEZs
2003EM SPACEZs
2004THREE-PER-EM SPACEZs
2005FOUR-PER-EM SPACEZs
2006SIX-PER-EM SPACEZs
2007FIGURE SPACEZs
2008PUNCTUATION SPACEZs
2009THIN SPACEZs
200AHAIR SPACEZs
200BZERO WIDTH SPACEZs
2028LINE SEPARATORZl
2029PARAGRAPH SEPARATORZp
202FNARROW NO-BREAK SPACEZs
3000IDEOGRAPHIC SPACEZs
- -The ASCII whitespace characters are the first six characters in the -above list -- line feed, horizontal tabulation, vertical tabulation, form -feed, carriage return, and space. These are also exactly the characters -recognised by the Posix {{isspace()}} procedure. Latin-1 adds the no-break -space. - -char-set:iso-control - -The ISO control characters are the Unicode/Latin-1 characters in the ranges -[U+0000,U+001F] and [U+007F,U+009F]. - -ASCII restricts this set to the characters in the range [U+0000,U+001F] -plus the character U+007F. - -Note that Unicode defines other control characters which do not belong to -this set (hence the qualifying prefix "iso-" in the name). - -char-set:punctuation - -In Unicode, a punctuation character is any character that has one of the -punctuation categories in the Unicode character database (Pc, Pd, Ps, Pe, -Pi, Pf, or Po.) - -ASCII has 23 punctuation characters: - - - !"#%&'()*,-./:;address@hidden - -Latin-1 adds six more: - - - - - - - - -
00A1INVERTED EXCLAMATION MARK
00ABLEFT-POINTING DOUBLE ANGLE QUOTATION MARK
00ADSOFT HYPHEN
00B7MIDDLE DOT
00BBRIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
00BFINVERTED QUESTION MARK
- -Note that the nine ASCII characters {{$+<=>^`|~}} are ''not'' punctuation. -They are "symbols." - - -char-set:symbol - -In Unicode, a symbol is any character that has one of the symbol categories -in the Unicode character database (Sm, Sc, Sk, or So). There are nine ASCII -symbol characters: - - - $+<=>^`|~ - -Latin-1 adds 18 more: - - - - - - - - - - - - - - - - - - - - -
00A2CENT SIGN
00A3POUND SIGN
00A4CURRENCY SIGN
00A5YEN SIGN
00A6BROKEN BAR
00A7SECTION SIGN
00A8DIAERESIS
00A9COPYRIGHT SIGN
00ACNOT SIGN
00AEREGISTERED SIGN
00AFMACRON
00B0DEGREE SIGN
00B1PLUS-MINUS SIGN
00B4ACUTE ACCENT
00B6PILCROW SIGN
00B8CEDILLA
00D7MULTIPLICATION SIGN
00F7DIVISION SIGN
- - -char-set:blank - -Blank chars are horizontal whitespace. In Unicode, a blank character is -either - - -* a character with the space separator category (Zs) in the Unicode character database. -* U+0009 Horizontal tabulation (\t control-I) - -There are eighteen blank characters in Unicode 3.0: - - - - - - - - - - - - - - - - - - - - -
0009HORIZONTAL TABULATION\t control-I
0020SPACEZs
00A0NO-BREAK SPACEZs
1680OGHAM SPACE MARKZs
2000EN QUADZs
2001EM QUADZs
2002EN SPACEZs
2003EM SPACEZs
2004THREE-PER-EM SPACEZs
2005FOUR-PER-EM SPACEZs
2006SIX-PER-EM SPACEZs
2007FIGURE SPACEZs
2008PUNCTUATION SPACEZs
2009THIN SPACEZs
200AHAIR SPACEZs
200BZERO WIDTH SPACEZs
202FNARROW NO-BREAK SPACEZs
3000IDEOGRAPHIC SPACEZs
- -The ASCII blank characters are the first two characters above -- horizontal -tab and space. Latin-1 adds the no-break space. - ---- -Previous: [[Unit srfi-4]] - -Next: [[Unit srfi-18]] diff --git a/manual/Unit srfi-4 b/manual/Unit srfi-4 index dfb37c4..920ff56 100644 --- a/manual/Unit srfi-4 +++ b/manual/Unit srfi-4 @@ -323,4 +323,4 @@ undefined. --- Previous: [[Unit srfi-1]] -Next: [[Unit srfi-14]] +Next: [[Unit posix]] diff --git a/rules.make b/rules.make index d43038a..6988697 100644 --- a/rules.make +++ b/rules.make @@ -37,7 +37,7 @@ SETUP_API_OBJECTS_1 = setup-api setup-download LIBCHICKEN_SCHEME_OBJECTS_1 = \ library eval data-structures ports files extras lolevel utils tcp srfi-1 srfi-4 \ - srfi-14 $(POSIXFILE) irregex scheduler \ + $(POSIXFILE) irregex scheduler \ profiler stub expand modules chicken-syntax chicken-ffi-syntax build-version LIBCHICKEN_OBJECTS_1 = $(LIBCHICKEN_SCHEME_OBJECTS_1) runtime LIBCHICKEN_SHARED_OBJECTS = $(LIBCHICKEN_OBJECTS_1:=$(O)) @@ -575,8 +575,6 @@ srfi-1.c: $(SRCDIR)srfi-1.scm $(SRCDIR)common-declarations.scm $(bootstrap-lib) srfi-4.c: $(SRCDIR)srfi-4.scm $(SRCDIR)common-declarations.scm $(bootstrap-lib) -srfi-14.c: $(SRCDIR)srfi-14.scm $(SRCDIR)common-declarations.scm - $(bootstrap-lib) utils.c: $(SRCDIR)utils.scm $(SRCDIR)common-declarations.scm $(bootstrap-lib) scheduler.c: $(SRCDIR)scheduler.scm $(SRCDIR)common-declarations.scm diff --git a/scripts/compile-all b/scripts/compile-all index 109d93a..d15b0ca 100755 --- a/scripts/compile-all +++ b/scripts/compile-all @@ -12,7 +12,7 @@ library_options="-optimize-level 2 -include-path . -include-path ./ -inline -ign compiler="$1" shift -for x in library eval data-structures ports files extras lolevel utils tcp srfi-1 srfi-4 srfi-14 posixunix posixwin irregex scheduler profiler stub expand modules chicken-syntax chicken-ffi-syntax build-version; do +for x in library eval data-structures ports files extras lolevel utils tcp srfi-1 srfi-4 posixunix posixwin irregex scheduler profiler stub expand modules chicken-syntax chicken-ffi-syntax build-version; do $compiler $x.scm $library_options -output-file /tmp/xxx.c "$@" done diff --git a/setup-download.scm b/setup-download.scm index 3e4beea..ba77037 100644 --- a/setup-download.scm +++ b/setup-download.scm @@ -25,7 +25,7 @@ (require-library extras irregex posix utils setup-api srfi-1 data-structures tcp - srfi-14 files) + files) (module setup-download (retrieve-extension @@ -37,7 +37,7 @@ temporary-directory) (import scheme chicken foreign) - (import extras irregex posix utils srfi-1 data-structures tcp srfi-14 files + (import extras irregex posix utils srfi-1 data-structures tcp files setup-api) (define-constant +default-tcp-connect-timeout+ 30000) ; 30 seconds @@ -280,14 +280,6 @@ (set! in (open-input-string data))) ) ) (values in out))) - ;; Simpler replacement for SRFI-13's string-every - (define (string-every criteria s) - (let ((end (string-length s))) - (let lp ((i 0)) - (or (fx>= i end) - (and (char-set-contains? criteria (string-ref s i)) - (lp (fx+ i 1))))))) - (define (http-retrieve-files in out dest) (d "reading files ...~%") (let ((version #f)) @@ -306,8 +298,8 @@ (else (set! version v))) (open-input-string ln)))) - ((string-every char-set:whitespace ln) - (skip)) + ((irregex-match '(* ("\x09\x0a\x0b\x0c\x0d\x20\xa0")) ln) + (skip)) ; Blank line. (else (error "unrecognized file-information - possibly corrupt transmission" ln))))) diff --git a/setup.defaults b/setup.defaults index 5d1d149..4177f5a 100644 --- a/setup.defaults +++ b/setup.defaults @@ -29,8 +29,7 @@ (map (data-structures extras files foreign irregex lolevel ports tcp utils - posix irregex setup-api setup-download - srfi-1 srfi-4 srfi-14 + posix irregex setup-api setup-download srfi-1 srfi-4 ->) ) diff --git a/srfi-14.import.scm b/srfi-14.import.scm deleted file mode 100644 index af17927..0000000 --- a/srfi-14.import.scm +++ /dev/null @@ -1,94 +0,0 @@ -;;;; srfi-14.import.scm - import library for "srfi-14" module -; -; Copyright (c) 2008-2014, The CHICKEN Team -; All rights reserved. -; -; Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following -; conditions are met: -; -; Redistributions of source code must retain the above copyright notice, this list of conditions and the following -; disclaimer. -; Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following -; disclaimer in the documentation and/or other materials provided with the distribution. -; Neither the name of the author nor the names of its contributors may be used to endorse or promote -; products derived from this software without specific prior written permission. -; -; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS -; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY -; AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR -; CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR -; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR -; OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -; POSSIBILITY OF SUCH DAMAGE. - - -(##sys#register-primitive-module - 'srfi-14 - '(->char-set - char-set - char-set->list - char-set->string - char-set-adjoin - char-set-adjoin! - char-set-any - char-set-complement - char-set-complement! - char-set-contains? - char-set-copy - char-set-count - char-set-cursor - char-set-cursor-next - char-set-delete - char-set-delete! - char-set-diff+intersection - char-set-diff+intersection! - char-set-difference - char-set-difference! - char-set-every - char-set-filter - char-set-filter! - char-set-fold - char-set-for-each - char-set-hash - char-set-intersection - char-set-intersection! - char-set-map - char-set-ref - char-set-size - char-set-unfold - char-set-unfold! - char-set-union - char-set-union! - char-set-xor - char-set-xor! - char-set:ascii - char-set:blank - char-set:digit - char-set:empty - char-set:full - char-set:graphic - char-set:hex-digit - char-set:iso-control - char-set:letter - char-set:letter+digit - char-set:lower-case - char-set:printing - char-set:punctuation - char-set:s - char-set:symbol - char-set:title-case - char-set:upper-case - char-set:whitespace - char-set<= - char-set= - char-set? - end-of-char-set? - list->char-set - list->char-set! - make-char-set - string->char-set - string->char-set! - ucs-range->char-set - ucs-range->char-set!)) diff --git a/srfi-14.scm b/srfi-14.scm deleted file mode 100644 index a1f6c13..0000000 --- a/srfi-14.scm +++ /dev/null @@ -1,831 +0,0 @@ -;;;; srfi-14.scm - Shivers' reference implementation of SRFI-14 - - -(declare - (unit srfi-14) - (fixnum) - (disable-interrupts) - (hide %char-set:s/check %string-iter %char-set-diff+intersection! %char->latin1 %latin1->char - %ucs-range->char-set! %string->char-set! %list->char-set! %set-char-set! %char-set-unfold! - %char-set-algebra %char-set-cursor-next %char-set-filter! %set-char-set c0 c1 %string-copy - %default-base) ) - -(include "common-declarations.scm") - -(register-feature! 'srfi-14) - - -(define (%latin1->char n) (integer->char n)) -(define (%char->latin1 c) (char->integer c)) - - -;;; SRFI-14 character-sets library -*- Scheme -*- -;;; -;;; - Ported from MIT Scheme runtime by Brian D. Carlstrom. -;;; - Massively rehacked & extended by Olin Shivers 6/98. -;;; - Massively redesigned and rehacked 5/2000 during SRFI process. -;;; At this point, the code bears the following relationship to the -;;; MIT Scheme code: "This is my grandfather's axe. My father replaced -;;; the head, and I have replaced the handle." Nonetheless, we preserve -;;; the MIT Scheme copyright: -;;; Copyright (c) 1988-1995 Massachusetts Institute of Technology -;;; The MIT Scheme license is a "free software" license. See the end of -;;; this file for the tedious details. - -;;; Exports: -;;; char-set? char-set= char-set<= -;;; char-set-hash -;;; char-set-cursor char-set-ref char-set-cursor-next end-of-char-set? -;;; char-set-fold char-set-unfold char-set-unfold! -;;; char-set-for-each char-set-map -;;; char-set-copy -;;; -;;; char-set list->char-set string->char-set -;;; char-set! list->char-set! string->char-set! -;;; -;;; filterchar-set ucs-range->char-set ->char-set -;;; filterchar-set! ucs-range->char-set! -;;; -;;; char-set->list char-set->string -;;; -;;; char-set-size char-set-count char-set-contains? -;;; char-set-every char-set-any -;;; -;;; char-set-adjoin char-set-delete -;;; char-set-adjoin! char-set-delete! -;;; -;;; char-set-complement char-set-union char-set-intersection char-set-difference -;;; char-set-complement! char-set-union! char-set-intersection! char-set-difference! -;;; -;;; char-set-difference char-set-xor char-set-diff+intersection -;;; char-set-difference! char-set-xor! char-set-diff+intersection! -;;; -;;; char-set:lower-case char-set:upper-case char-set:title-case -;;; char-set:letter char-set:digit char-set:letter+digit -;;; char-set:graphic char-set:printing char-set:whitespace -;;; char-set:iso-control char-set:punctuation char-set:symbol -;;; char-set:hex-digit char-set:blank char-set:ascii -;;; char-set:empty char-set:full - -;;; Imports -;;; This code has the following non-R5RS dependencies: -;;; - ERROR -;;; - %LATIN1->CHAR %CHAR->LATIN1 -;;; - LET-OPTIONALS* and :OPTIONAL macros for parsing, checking & defaulting -;;; optional arguments from rest lists. -;;; - BITWISE-AND for CHAR-SET-HASH -;;; - The SRFI-19 DEFINE-RECORD-TYPE record macro -;;; - A simple CHECK-ARG procedure: -;;; (lambda (pred val caller) (if (not (pred val)) (error val caller))) - -;;; This is simple code, not great code. Char sets are represented as 256-char -;;; strings. If char I is ASCII/Latin-1 0, then it isn't in the set; if char I -;;; is ASCII/Latin-1 1, then it is in the set. -;;; - Should be rewritten to use bit strings or byte vecs. -;;; - Is Latin-1 specific. Would certainly have to be rewritten for Unicode. - -;;; See the end of the file for porting and performance-tuning notes. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(define (make-char-set s) (##sys#make-structure 'char-set s)) -(define (char-set:s cs) (##sys#slot cs 1)) -(define (char-set? x) (##sys#structure? x 'char-set)) - -#| -(define-record-type :char-set - (make-char-set s) - char-set? - (s char-set:s)) -|# - - -(define (%string-copy s) (substring s 0 (string-length s))) - -;;; Parse, type-check & default a final optional BASE-CS parameter from -;;; a rest argument. Return a *fresh copy* of the underlying string. -;;; The default is the empty set. The PROC argument is to help us -;;; generate informative error exceptions. - -(define (%default-base maybe-base proc) - (if (pair? maybe-base) - (let ((bcs (car maybe-base)) - (tail (cdr maybe-base))) - (if (null? tail) - (if (char-set? bcs) (%string-copy (char-set:s bcs)) - (##sys#error "BASE-CS parameter not a char-set" proc bcs)) - (##sys#error "Expected final base char set -- too many parameters" - proc maybe-base))) - (make-string 256 (%latin1->char 0)))) - -;;; If CS is really a char-set, do CHAR-SET:S, otw report an error msg on -;;; behalf of our caller, PROC. This procedure exists basically to provide -;;; explicit error-checking & reporting. - -(define (%char-set:s/check cs proc) - (let lp ((cs cs)) - (if (char-set? cs) (char-set:s cs) - (lp (##sys#error proc "Not a char-set" cs))))) - - - -;;; These internal functions hide a lot of the dependency on the -;;; underlying string representation of char sets. They should be -;;; inlined if possible. - -(define-inline (si=0? s i) (zero? (%char->latin1 (string-ref s i)))) -(define-inline (si=1? s i) (not (si=0? s i))) -(define-inline (si s i) (%char->latin1 (string-ref s i))) -(define-inline (%set0! s i) (string-set! s i c0)) -(define-inline (%set1! s i) (string-set! s i c1)) - -(define c0 (%latin1->char 0)) -(define c1 (%latin1->char 1)) - -;;; These do various "s[i] := s[i] op val" operations -- see -;;; %CHAR-SET-ALGEBRA. They are used to implement the various -;;; set-algebra procedures. -(define-inline (setv! s i v) (string-set! s i (%latin1->char v))) ; SET to a Value. -(define-inline (%not! s i v) (setv! s i (- 1 v))) -(define-inline (%and! s i v) (if (zero? v) (%set0! s i))) -(define-inline (%or! s i v) (if (not (zero? v)) (%set1! s i))) -(define-inline (%minus! s i v) (if (not (zero? v)) (%set0! s i))) -(define-inline (%xor! s i v) (if (not (zero? v)) (setv! s i (- 1 (si s i))))) - -(define (char-set-copy cs) - (make-char-set (%string-copy (%char-set:s/check cs 'char-set-copy)))) - -(define char-set= - (lambda rest - (or (null? rest) - (let* ((cs1 (car rest)) - (rest (cdr rest)) - (s1 (%char-set:s/check cs1 'char-set=))) - (let lp ((rest rest)) - (or (not (pair? rest)) - (and (string=? s1 (%char-set:s/check (car rest) 'char-set=)) - (lp (cdr rest))))))))) - -(define char-set<= - (lambda rest - (or (null? rest) - (let ((cs1 (car rest)) - (rest (cdr rest))) - (let lp ((s1 (%char-set:s/check cs1 'char-set<=)) (rest rest)) - (or (not (pair? rest)) - (let ((s2 (%char-set:s/check (car rest) 'char-set<=)) - (rest (cdr rest))) - (if (eq? s1 s2) (lp s2 rest) ; Fast path - (let lp2 ((i 255)) ; Real test - (if (< i 0) (lp s2 rest) - (and (<= (si s1 i) (si s2 i)) - (lp2 (- i 1))))))))))) )) - -;;; Hash -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Compute (c + 37 c + 37^2 c + ...) modulo BOUND. -;;; If you keep BOUND small enough, the intermediate calculations will -;;; always be fixnums. How small is dependent on the underlying Scheme system; -;;; we use a default BOUND of 2^22 = 4194304, which should hack it in -;;; Schemes that give you at least 29 signed bits for fixnums. The core -;;; calculation that you don't want to overflow is, worst case, -;;; (+ 65535 (* 37 (- bound 1))) -;;; where 65535 is the max character code. Choose the default BOUND to be the -;;; biggest power of two that won't cause this expression to fixnum overflow, -;;; and everything will be copacetic. - -(define (char-set-hash cs . maybe-bound) - (let ((bound (optional maybe-bound 4194304))) - (if (zero? bound) (set! bound 4194304)) - (##sys#check-exact bound 'char-set-hash) - (let* ((s (%char-set:s/check cs 'char-set-hash)) - ;; Compute a 111...1 mask that will cover BOUND-1: - (mask (let lp ((i #x10000)) ; Let's skip first 16 iterations, eh? - (if (>= i bound) (- i 1) (lp (+ i i)))))) - (let lp ((i 255) (ans 0)) - (if (< i 0) (modulo ans bound) - (lp (- i 1) - (if (si=0? s i) ans - (fxand mask (+ (* 37 ans) i)))))))) ) - - -(define (char-set-contains? cs char) - (##sys#check-char char 'char-set-contains?) - (si=1? (%char-set:s/check cs 'char-set-contains?) -; (%char->latin1 (check-arg char? char char-set-contains?)))) - (%char->latin1 char) ) ) - -(define (char-set-size cs) - (let ((s (%char-set:s/check cs 'char-set-size))) - (let lp ((i 255) (size 0)) - (if (< i 0) size - (lp (- i 1) (+ size (si s i))))))) - -(define (char-set-count pred cset) -; (check-arg procedure? pred char-set-count) - (let ((s (%char-set:s/check cset 'char-set-count))) - (let lp ((i 255) (count 0)) - (if (< i 0) count - (lp (- i 1) - (if (and (si=1? s i) (pred (%latin1->char i))) - (+ count 1) - count)))))) - - -;;; -- Adjoin & delete - -(define (%set-char-set set proc cs chars) - (let ((s (%string-copy (%char-set:s/check cs proc)))) - (for-each (lambda (c) (set s (%char->latin1 c))) - chars) - (make-char-set s))) - -(define (%set-char-set! set proc cs chars) - (let ((s (%char-set:s/check cs proc))) - (for-each (lambda (c) (set s (%char->latin1 c))) - chars)) - cs) - -(define (char-set-adjoin cs . chars) - (%set-char-set %set1! 'char-set-adjoin cs chars)) -(define (char-set-adjoin! cs . chars) - (%set-char-set! %set1! 'char-set-adjoin! cs chars)) -(define (char-set-delete cs . chars) - (%set-char-set %set0! 'char-set-delete cs chars)) -(define (char-set-delete! cs . chars) - (%set-char-set! %set0! 'char-set-delete! cs chars)) - - -;;; Cursors -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Simple implementation. A cursors is an integer index into the -;;; mark vector, and -1 for the end-of-char-set cursor. -;;; -;;; If we represented char sets as a bit set, we could do the following -;;; trick to pick the lowest bit out of the set: -;;; (count-bits (xor (- cset 1) cset)) -;;; (But first mask out the bits already scanned by the cursor first.) - -(define (char-set-cursor cset) - (%char-set-cursor-next cset 256 'char-set-cursor)) - -(define (end-of-char-set? cursor) (< cursor 0)) - -(define (char-set-ref cset cursor) (%latin1->char cursor)) - -(define (char-set-cursor-next cset cursor) - (##sys#check-exact cursor 'char-set-cursor-next) -; (check-arg (lambda (i) (and (integer? i) (exact? i) (<= 0 i 255))) cursor -; char-set-cursor-next) - (%char-set-cursor-next cset cursor 'char-set-cursor-next)) - -(define (%char-set-cursor-next cset cursor proc) ; Internal - (let ((s (%char-set:s/check cset proc))) - (let lp ((cur cursor)) - (let ((cur (- cur 1))) - (if (or (< cur 0) (si=1? s cur)) cur - (lp cur)))))) - - -;;; -- for-each map fold unfold every any - -(define (char-set-for-each proc cs) -; (check-arg procedure? proc char-set-for-each) - (let ((s (%char-set:s/check cs 'char-set-for-each))) - (let lp ((i 255)) - (cond ((>= i 0) - (if (si=1? s i) (proc (%latin1->char i))) - (lp (- i 1))))))) - -(define (char-set-map proc cs) -; (check-arg procedure? proc char-set-map) - (let ((s (%char-set:s/check cs 'char-set-map)) - (ans (make-string 256 c0))) - (let lp ((i 255)) - (cond ((>= i 0) - (if (si=1? s i) - (%set1! ans (%char->latin1 (proc (%latin1->char i))))) - (lp (- i 1))))) - (make-char-set ans))) - -(define (char-set-fold kons knil cs) -; (check-arg procedure? kons char-set-fold) - (let ((s (%char-set:s/check cs 'char-set-fold))) - (let lp ((i 255) (ans knil)) - (if (< i 0) ans - (lp (- i 1) - (if (si=0? s i) ans - (kons (%latin1->char i) ans))))))) - -(define (char-set-every pred cs) -; (check-arg procedure? pred char-set-every) - (let ((s (%char-set:s/check cs 'char-set-every))) - (let lp ((i 255)) - (or (< i 0) - (and (or (si=0? s i) (pred (%latin1->char i))) - (lp (- i 1))))))) - -(define (char-set-any pred cs) -; (check-arg procedure? pred char-set-any) - (let ((s (%char-set:s/check cs 'char-set-any))) - (let lp ((i 255)) - (and (>= i 0) - (or (and (si=1? s i) (pred (%latin1->char i))) - (lp (- i 1))))))) - - -(define (%char-set-unfold! proc p f g s seed) -; (check-arg procedure? p proc) -; (check-arg procedure? f proc) -; (check-arg procedure? g proc) - (let lp ((seed seed)) - (cond ((not (p seed)) ; P says we are done. - (%set1! s (%char->latin1 (f seed))) ; Add (F SEED) to set. - (lp (g seed)))))) ; Loop on (G SEED). - -(define (char-set-unfold p f g seed . maybe-base) - (let ((bs (%default-base maybe-base char-set-unfold))) - (%char-set-unfold! char-set-unfold p f g bs seed) - (make-char-set bs))) - -(define (char-set-unfold! p f g seed base-cset) - (%char-set-unfold! char-set-unfold! p f g - (%char-set:s/check base-cset 'char-set-unfold!) - seed) - base-cset) - - - -;;; list <--> char-set - -(define (%list->char-set! chars s) - (for-each (lambda (char) (%set1! s (%char->latin1 char))) - chars)) - -(define (char-set . chars) - (let ((s (make-string 256 c0))) - (%list->char-set! chars s) - (make-char-set s))) - -(define (list->char-set chars . maybe-base) - (let ((bs (%default-base maybe-base list->char-set))) - (%list->char-set! chars bs) - (make-char-set bs))) - -(define (list->char-set! chars base-cs) - (%list->char-set! chars (%char-set:s/check base-cs 'list->char-set!)) - base-cs) - - -(define (char-set->list cs) - (let ((s (%char-set:s/check cs 'char-set->list))) - (let lp ((i 255) (ans '())) - (if (< i 0) ans - (lp (- i 1) - (if (si=0? s i) ans - (cons (%latin1->char i) ans))))))) - - - -;;; string <--> char-set - -(define (%string->char-set! str bs proc) - (##sys#check-string str proc) -; (check-arg string? str proc) - (do ((i (- (string-length str) 1) (- i 1))) - ((< i 0)) - (%set1! bs (%char->latin1 (string-ref str i))))) - -(define (string->char-set str . maybe-base) - (let ((bs (%default-base maybe-base string->char-set))) - (%string->char-set! str bs 'string->char-set) - (make-char-set bs))) - -(define (string->char-set! str base-cs) - (%string->char-set! str (%char-set:s/check base-cs 'string->char-set!) - 'string->char-set!) - base-cs) - - -(define (char-set->string cs) - (let* ((s (%char-set:s/check cs 'char-set->string)) - (ans (make-string (char-set-size cs)))) - (let lp ((i 255) (j 0)) - (if (< i 0) ans - (let ((j (if (si=0? s i) j - (begin (string-set! ans j (%latin1->char i)) - (+ j 1))))) - (lp (- i 1) j)))))) - - -;;; -- UCS-range -> char-set - -(define (%ucs-range->char-set! lower upper error? bs proc) - (##sys#check-exact lower proc) - (##sys#check-exact upper proc) -; (check-arg (lambda (x) (and (integer? x) (exact? x) (<= 0 x))) lower proc) -; (check-arg (lambda (x) (and (integer? x) (exact? x) (<= lower x))) upper proc) - - (if (and (< lower upper) (< 256 upper) error?) - (##sys#error "Requested UCS range contains unavailable characters -- this implementation only supports Latin-1" - proc lower upper)) - - (let lp ((i (- (min upper 256) 1))) - (cond ((<= lower i) (%set1! bs i) (lp (- i 1)))))) - -(define (ucs-range->char-set lower upper . rest) - (let-optionals* rest ((error? #f) rest) - (let ((bs (%default-base rest ucs-range->char-set))) - (%ucs-range->char-set! lower upper error? bs 'ucs-range->char-set) - (make-char-set bs)))) - -(define (ucs-range->char-set! lower upper error? base-cs) - (%ucs-range->char-set! lower upper error? - (%char-set:s/check base-cs 'ucs-range->char-set!) - 'ucs-range->char-set) - base-cs) - - -;;; -- predicate -> char-set - -(define (%char-set-filter! pred ds bs proc) -; (check-arg procedure? pred proc) - (let lp ((i 255)) - (cond ((>= i 0) - (if (and (si=1? ds i) (pred (%latin1->char i))) - (%set1! bs i)) - (lp (- i 1)))))) - -(define (char-set-filter predicate domain . maybe-base) - (let ((bs (%default-base maybe-base char-set-filter))) - (%char-set-filter! predicate - (%char-set:s/check domain 'char-set-filter!) - bs - char-set-filter) - (make-char-set bs))) - -(define (char-set-filter! predicate domain base-cs) - (%char-set-filter! predicate - (%char-set:s/check domain 'char-set-filter!) - (%char-set:s/check base-cs 'char-set-filter!) - char-set-filter!) - base-cs) - - -;;; {string, char, char-set, char predicate} -> char-set - -(define (->char-set x) - (cond ((char-set? x) x) - ((string? x) (string->char-set x)) - ((char? x) (char-set x)) - (else (##sys#error '->char-set "Not a charset, string or char." x)))) - - - -;;; Set algebra -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; The exported ! procs are "linear update" -- allowed, but not required, to -;;; side-effect their first argument when computing their result. In other -;;; words, you must use them as if they were completely functional, just like -;;; their non-! counterparts, and you must additionally ensure that their -;;; first arguments are "dead" at the point of call. In return, we promise a -;;; more efficient result, plus allowing you to always assume char-sets are -;;; unchangeable values. - -;;; Apply P to each index and its char code in S: (P I VAL). -;;; Used by the set-algebra ops. - -(define (%string-iter p s) - (let lp ((i (- (string-length s) 1))) - (cond ((>= i 0) - (p i (%char->latin1 (string-ref s i))) - (lp (- i 1)))))) - -;;; String S represents some initial char-set. (OP s i val) does some -;;; kind of s[i] := s[i] op val update. Do -;;; S := S OP CSETi -;;; for all the char-sets in the list CSETS. The n-ary set-algebra ops -;;; all use this internal proc. - -(define (%char-set-algebra s csets op proc) - (for-each (lambda (cset) - (let ((s2 (%char-set:s/check cset proc))) - (let lp ((i 255)) - (cond ((>= i 0) - (op s i (si s2 i)) - (lp (- i 1))))))) - csets)) - - -;;; -- Invert - -(define (char-set-complement cs) - (let ((s (%char-set:s/check cs 'char-set-complement)) - (ans (make-string 256))) - (%string-iter (lambda (i v) (%not! ans i v)) s) - (make-char-set ans))) - -(define (char-set-complement! cset) - (let ((s (%char-set:s/check cset 'char-set-complement!))) - (%string-iter (lambda (i v) (%not! s i v)) s)) - cset) - - -;;; -- Union - -(define (char-set-union! cset1 . csets) - (%char-set-algebra (%char-set:s/check cset1 'char-set-union!) - csets %or! 'char-set-union!) - cset1) - -(define (char-set-union . csets) - (if (pair? csets) - (let ((s (%string-copy (%char-set:s/check (car csets) 'char-set-union)))) - (%char-set-algebra s (cdr csets) %or! 'char-set-union) - (make-char-set s)) - (char-set-copy char-set:empty))) - - -;;; -- Intersection - -(define (char-set-intersection! cset1 . csets) - (%char-set-algebra (%char-set:s/check cset1 'char-set-intersection!) - csets %and! 'char-set-intersection!) - cset1) - -(define (char-set-intersection . csets) - (if (pair? csets) - (let ((s (%string-copy (%char-set:s/check (car csets) 'char-set-intersection)))) - (%char-set-algebra s (cdr csets) %and! 'char-set-intersection) - (make-char-set s)) - (char-set-copy char-set:full))) - - -;;; -- Difference - -(define (char-set-difference! cset1 . csets) - (%char-set-algebra (%char-set:s/check cset1 'char-set-difference!) - csets %minus! 'char-set-difference!) - cset1) - -(define (char-set-difference cs1 . csets) - (if (pair? csets) - (let ((s (%string-copy (%char-set:s/check cs1 'char-set-difference)))) - (%char-set-algebra s csets %minus! 'char-set-difference) - (make-char-set s)) - (char-set-copy cs1))) - - -;;; -- Xor - -(define (char-set-xor! cset1 . csets) - (%char-set-algebra (%char-set:s/check cset1 'char-set-xor!) - csets %xor! 'char-set-xor!) - cset1) - -(define (char-set-xor . csets) - (if (pair? csets) - (let ((s (%string-copy (%char-set:s/check (car csets) 'char-set-xor)))) - (%char-set-algebra s (cdr csets) %xor! 'char-set-xor) - (make-char-set s)) - (char-set-copy char-set:empty))) - - -;;; -- Difference & intersection - -(define (%char-set-diff+intersection! diff int csets proc) - (for-each (lambda (cs) - (%string-iter (lambda (i v) - (if (not (zero? v)) - (cond ((si=1? diff i) - (%set0! diff i) - (%set1! int i))))) - (%char-set:s/check cs proc))) - csets)) - -(define (char-set-diff+intersection! cs1 cs2 . csets) - (let ((s1 (%char-set:s/check cs1 'char-set-diff+intersection!)) - (s2 (%char-set:s/check cs2 'char-set-diff+intersection!))) - (%string-iter (lambda (i v) (if (zero? v) - (%set0! s2 i) - (if (si=1? s2 i) (%set0! s1 i)))) - s1) - (%char-set-diff+intersection! s1 s2 csets 'char-set-diff+intersection!)) - (values cs1 cs2)) - -(define (char-set-diff+intersection cs1 . csets) - (let ((diff (string-copy (%char-set:s/check cs1 'char-set-diff+intersection))) - (int (make-string 256 c0))) - (%char-set-diff+intersection! diff int csets 'char-set-diff+intersection) - (values (make-char-set diff) (make-char-set int)))) - - -;;;; System character sets -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; These definitions are for Latin-1. -;;; -;;; If your Scheme implementation allows you to mark the underlying strings -;;; as immutable, you should do so -- it would be very, very bad if a client's -;;; buggy code corrupted these constants. - -(define char-set:empty (char-set)) -(define char-set:full (char-set-complement char-set:empty)) - -(define char-set:lower-case - (let* ((a-z (ucs-range->char-set #x61 #x7B)) - (latin1 (ucs-range->char-set! #xdf #xf7 #t a-z)) - (latin2 (ucs-range->char-set! #xf8 #x100 #t latin1))) - (char-set-adjoin! latin2 (%latin1->char #xb5)))) - -(define char-set:upper-case - (let ((A-Z (ucs-range->char-set #x41 #x5B))) - ;; Add in the Latin-1 upper-case chars. - (ucs-range->char-set! #xd8 #xdf #t - (ucs-range->char-set! #xc0 #xd7 #t A-Z)))) - -(define char-set:title-case char-set:empty) - -(define char-set:letter - (let ((u/l (char-set-union char-set:upper-case char-set:lower-case))) - (char-set-adjoin! u/l - (%latin1->char #xaa) ; FEMININE ORDINAL INDICATOR - (%latin1->char #xba)))) ; MASCULINE ORDINAL INDICATOR - -(define char-set:digit (string->char-set "0123456789")) -(define char-set:hex-digit (string->char-set "0123456789abcdefABCDEF")) - -(define char-set:letter+digit - (char-set-union char-set:letter char-set:digit)) - -(define char-set:punctuation - (let ((ascii (string->char-set "!\"#%&'()*,-./:;address@hidden")) - (latin-1-chars (map %latin1->char '(#xA1 ; INVERTED EXCLAMATION MARK - #xAB ; LEFT-POINTING DOUBLE ANGLE QUOTATION MARK - #xAD ; SOFT HYPHEN - #xB7 ; MIDDLE DOT - #xBB ; RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK - #xBF)))) ; INVERTED QUESTION MARK - (list->char-set! latin-1-chars ascii))) - -(define char-set:symbol - (let ((ascii (string->char-set "$+<=>^`|~")) - (latin-1-chars (map %latin1->char '(#x00A2 ; CENT SIGN - #x00A3 ; POUND SIGN - #x00A4 ; CURRENCY SIGN - #x00A5 ; YEN SIGN - #x00A6 ; BROKEN BAR - #x00A7 ; SECTION SIGN - #x00A8 ; DIAERESIS - #x00A9 ; COPYRIGHT SIGN - #x00AC ; NOT SIGN - #x00AE ; REGISTERED SIGN - #x00AF ; MACRON - #x00B0 ; DEGREE SIGN - #x00B1 ; PLUS-MINUS SIGN - #x00B4 ; ACUTE ACCENT - #x00B6 ; PILCROW SIGN - #x00B8 ; CEDILLA - #x00D7 ; MULTIPLICATION SIGN - #x00F7)))) ; DIVISION SIGN - (list->char-set! latin-1-chars ascii))) - - -(define char-set:graphic - (char-set-union char-set:letter+digit char-set:punctuation char-set:symbol)) - -(define char-set:whitespace - (list->char-set (map %latin1->char '(#x09 ; HORIZONTAL TABULATION - #x0A ; LINE FEED - #x0B ; VERTICAL TABULATION - #x0C ; FORM FEED - #x0D ; CARRIAGE RETURN - #x20 ; SPACE - #xA0)))) - -(define char-set:printing (char-set-union char-set:whitespace char-set:graphic)) ; NO-BREAK SPACE - -(define char-set:blank - (list->char-set (map %latin1->char '(#x09 ; HORIZONTAL TABULATION - #x20 ; SPACE - #xA0)))) ; NO-BREAK SPACE - - -(define char-set:iso-control - (ucs-range->char-set! #x7F #xA0 #t (ucs-range->char-set 0 32))) - -(define char-set:ascii (ucs-range->char-set 0 128)) - - -;;; Porting & performance-tuning notes -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; See the section at the beginning of this file on external dependencies. -;;; -;;; First and foremost, rewrite this code to use bit vectors of some sort. -;;; This will give big speedup and memory savings. -;;; -;;; - LET-OPTIONALS* macro. -;;; This is only used once. You can rewrite the use, port the hairy macro -;;; definition (which is implemented using a Clinger-Rees low-level -;;; explicit-renaming macro system), or port the simple, high-level -;;; definition, which is less efficient. -;;; -;;; - :OPTIONAL macro -;;; Very simply defined using an R5RS high-level macro. -;;; -;;; Implementations that can arrange for the base char sets to be immutable -;;; should do so. (E.g., Scheme 48 allows one to mark a string as immutable, -;;; which can be used to protect the underlying strings.) It would be very, -;;; very bad if a client's buggy code corrupted these constants. -;;; -;;; There is a fair amount of argument checking. This is, strictly speaking, -;;; unnecessary -- the actual body of the procedures will blow up if an -;;; illegal value is passed in. However, the error message will not be as good -;;; as if the error were caught at the "higher level." Also, a very, very -;;; smart Scheme compiler may be able to exploit having the type checks done -;;; early, so that the actual body of the procedures can assume proper values. -;;; This isn't likely; this kind of compiler technology isn't common any -;;; longer. -;;; -;;; The overhead of optional-argument parsing is irritating. The optional -;;; arguments must be consed into a rest list on entry, and then parsed out. -;;; Function call should be a matter of a few register moves and a jump; it -;;; should not involve heap allocation! Your Scheme system may have a superior -;;; non-R5RS optional-argument system that can eliminate this overhead. If so, -;;; then this is a prime candidate for optimising these procedures, -;;; *especially* the many optional BASE-CS parameters. -;;; -;;; Note that optional arguments are also a barrier to procedure integration. -;;; If your Scheme system permits you to specify alternate entry points -;;; for a call when the number of optional arguments is known in a manner -;;; that enables inlining/integration, this can provide performance -;;; improvements. -;;; -;;; There is enough *explicit* error checking that *all* internal operations -;;; should *never* produce a type or index-range error. Period. Feel like -;;; living dangerously? *Big* performance win to be had by replacing string -;;; and record-field accessors and setters with unsafe equivalents in the -;;; code. Similarly, fixnum-specific operators can speed up the arithmetic -;;; done on the index values in the inner loops. The only arguments that are -;;; not completely error checked are -;;; - string lists (complete checking requires time proportional to the -;;; length of the list) -;;; - procedure arguments, such as char->char maps & predicates. -;;; There is no way to check the range & domain of procedures in Scheme. -;;; Procedures that take these parameters cannot fully check their -;;; arguments. But all other types to all other procedures are fully -;;; checked. -;;; -;;; This does open up the alternate possibility of simply *removing* these -;;; checks, and letting the safe primitives raise the errors. On a dumb -;;; Scheme system, this would provide speed (by eliminating the redundant -;;; error checks) at the cost of error-message clarity. -;;; -;;; In an interpreted Scheme, some of these procedures, or the internal -;;; routines with % prefixes, are excellent candidates for being rewritten -;;; in C. -;;; -;;; It would also be nice to have the ability to mark some of these -;;; routines as candidates for inlining/integration. -;;; -;;; See the comments preceding the hash function code for notes on tuning -;;; the default bound so that the code never overflows your implementation's -;;; fixnum size into bignum calculation. -;;; -;;; All the %-prefixed routines in this source code are written -;;; to be called internally to this library. They do *not* perform -;;; friendly error checks on the inputs; they assume everything is -;;; proper. They also do not take optional arguments. These two properties -;;; save calling overhead and enable procedure integration -- but they -;;; are not appropriate for exported routines. - -;;; Copyright notice -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1988-1995 Massachusetts Institute of Technology -;;; -;;; This material was developed by the Scheme project at the Massachusetts -;;; Institute of Technology, Department of Electrical Engineering and -;;; Computer Science. Permission to copy and modify this software, to -;;; redistribute either the original software or a modified version, and -;;; to use this software for any purpose is granted, subject to the -;;; following restrictions and understandings. -;;; -;;; 1. Any copy made of this software must include this copyright notice -;;; in full. -;;; -;;; 2. Users of this software agree to make their best efforts (a) to -;;; return to the MIT Scheme project any improvements or extensions that -;;; they make, so that these may be included in future releases; and (b) -;;; to inform MIT of noteworthy uses of this software. -;;; -;;; 3. All materials developed as a consequence of the use of this -;;; software shall duly acknowledge such use, in accordance with the usual -;;; standards of acknowledging credit in academic research. -;;; -;;; 4. MIT has made no warrantee or representation that the operation of -;;; this software will be error-free, and MIT is under no obligation to -;;; provide any services, by way of maintenance, update, or otherwise. -;;; -;;; 5. In conjunction with products arising from the use of this material, -;;; there shall be no use of the name of the Massachusetts Institute of -;;; Technology nor of any adaptation thereof in any advertising, -;;; promotional, or sales literature without prior written consent from -;;; MIT in each case. diff --git a/tests/runtests.bat b/tests/runtests.bat index bb3186e..fc14bcb 100644 --- a/tests/runtests.bat +++ b/tests/runtests.bat @@ -364,12 +364,6 @@ echo ======================================== srfi-4 tests ... %interpret% -s srfi-4-tests.scm if errorlevel 1 exit /b 1 -echo ======================================== srfi-14 tests ... -%compile% srfi-14-tests.scm -if errorlevel 1 exit /b 1 -a.out -if errorlevel 1 exit /b 1 - echo ======================================== condition tests ... %interpret% -s condition-tests.scm if errorlevel 1 exit /b 1 diff --git a/tests/runtests.sh b/tests/runtests.sh index 53389ac..91f0eea 100755 --- a/tests/runtests.sh +++ b/tests/runtests.sh @@ -40,7 +40,7 @@ for x in setup-api.so setup-api.import.so setup-download.so \ srfi-1.import.so srfi-4.import.so data-structures.import.so \ ports.import.so files.import.so posix.import.so \ extras.import.so \ - irregex.import.so srfi-14.import.so tcp.import.so \ + irregex.import.so tcp.import.so \ foreign.import.so \ utils.import.so csi.import.so irregex.import.so types.db; do cp ../$x test-repository @@ -304,10 +304,6 @@ $compile numbers-string-conversion-tests.scm echo "======================================== srfi-4 tests ..." $interpret -s srfi-4-tests.scm -echo "======================================== srfi-14 tests ..." -$compile srfi-14-tests.scm -./a.out - echo "======================================== condition tests ..." $interpret -s condition-tests.scm diff --git a/tests/srfi-14-tests.scm b/tests/srfi-14-tests.scm deleted file mode 100644 index db97c27..0000000 --- a/tests/srfi-14-tests.scm +++ /dev/null @@ -1,202 +0,0 @@ -;;; This is a regression testing suite for the SRFI-14 char-set library. -;;; Olin Shivers - -(use srfi-14) - -(let-syntax ((test (syntax-rules () - ((test form ...) - (cond ((not form) (error "Test failed" 'form)) ... - (else 'OK)))))) - (let ((vowel? (lambda (c) (member c '(#\a #\e #\i #\o #\u))))) - -(test - (not (char-set? 5)) - - (char-set? (char-set #\a #\e #\i #\o #\u)) - - (char-set=) - (char-set= (char-set)) - - (char-set= (char-set #\a #\e #\i #\o #\u) - (string->char-set "ioeauaiii")) - - (not (char-set= (char-set #\e #\i #\o #\u) - (string->char-set "ioeauaiii"))) - - (char-set<=) - (char-set<= (char-set)) - - (char-set<= (char-set #\a #\e #\i #\o #\u) - (string->char-set "ioeauaiii")) - - (char-set<= (char-set #\e #\i #\o #\u) - (string->char-set "ioeauaiii")) - - (<= 0 (char-set-hash char-set:graphic 100) 99) - - (= 4 (char-set-fold (lambda (c i) (+ i 1)) 0 - (char-set #\e #\i #\o #\u #\e #\e))) - - (char-set= (string->char-set "eiaou2468013579999") - (char-set-unfold null? car cdr '(#\a #\e #\i #\o #\u #\u #\u) - char-set:digit)) - - (char-set= (string->char-set "eiaou246801357999") - (char-set-unfold! null? car cdr '(#\a #\e #\i #\o #\u) - (string->char-set "0123456789"))) - - (not (char-set= (string->char-set "eiaou246801357") - (char-set-unfold! null? car cdr '(#\a #\e #\i #\o #\u) - (string->char-set "0123456789")))) - - (let ((cs (string->char-set "0123456789"))) - (char-set-for-each (lambda (c) (set! cs (char-set-delete cs c))) - (string->char-set "02468000")) - (char-set= cs (string->char-set "97531"))) - - (not (let ((cs (string->char-set "0123456789"))) - (char-set-for-each (lambda (c) (set! cs (char-set-delete cs c))) - (string->char-set "02468")) - (char-set= cs (string->char-set "7531")))) - - (char-set= (char-set-map char-upcase (string->char-set "aeiou")) - (string->char-set "IOUAEEEE")) - - (not (char-set= (char-set-map char-upcase (string->char-set "aeiou")) - (string->char-set "OUAEEEE"))) - - (char-set= (char-set-copy (string->char-set "aeiou")) - (string->char-set "aeiou")) - - (char-set= (char-set #\x #\y) (string->char-set "xy")) - (not (char-set= (char-set #\x #\y #\z) (string->char-set "xy"))) - - (char-set= (string->char-set "xy") (list->char-set '(#\x #\y))) - (not (char-set= (string->char-set "axy") (list->char-set '(#\x #\y)))) - - (char-set= (string->char-set "xy12345") - (list->char-set '(#\x #\y) (string->char-set "12345"))) - (not (char-set= (string->char-set "y12345") - (list->char-set '(#\x #\y) (string->char-set "12345")))) - - (char-set= (string->char-set "xy12345") - (list->char-set! '(#\x #\y) (string->char-set "12345"))) - (not (char-set= (string->char-set "y12345") - (list->char-set! '(#\x #\y) (string->char-set "12345")))) - - (char-set= (string->char-set "aeiou12345") - (char-set-filter vowel? char-set:ascii (string->char-set "12345"))) - (not (char-set= (string->char-set "aeou12345") - (char-set-filter vowel? char-set:ascii (string->char-set "12345")))) - - (char-set= (string->char-set "aeiou12345") - (char-set-filter! vowel? char-set:ascii (string->char-set "12345"))) - (not (char-set= (string->char-set "aeou12345") - (char-set-filter! vowel? char-set:ascii (string->char-set "12345")))) - - - (char-set= (string->char-set "abcdef12345") - (ucs-range->char-set 97 103 #t (string->char-set "12345"))) - (not (char-set= (string->char-set "abcef12345") - (ucs-range->char-set 97 103 #t (string->char-set "12345")))) - - (char-set= (string->char-set "abcdef12345") - (ucs-range->char-set! 97 103 #t (string->char-set "12345"))) - (not (char-set= (string->char-set "abcef12345") - (ucs-range->char-set! 97 103 #t (string->char-set "12345")))) - - - (char-set= (->char-set #\x) - (->char-set "x") - (->char-set (char-set #\x))) - - (not (char-set= (->char-set #\x) - (->char-set "y") - (->char-set (char-set #\x)))) - - (= 10 (char-set-size (char-set-intersection char-set:ascii char-set:digit))) - - (= 5 (char-set-count vowel? char-set:ascii)) - - (equal? '(#\x) (char-set->list (char-set #\x))) - (not (equal? '(#\X) (char-set->list (char-set #\x)))) - - (equal? "x" (char-set->string (char-set #\x))) - (not (equal? "X" (char-set->string (char-set #\x)))) - - (char-set-contains? (->char-set "xyz") #\x) - (not (char-set-contains? (->char-set "xyz") #\a)) - - (char-set-every char-lower-case? (->char-set "abcd")) - (not (char-set-every char-lower-case? (->char-set "abcD"))) - (char-set-any char-lower-case? (->char-set "abcd")) - (not (char-set-any char-lower-case? (->char-set "ABCD"))) - - (char-set= (->char-set "ABCD") - (let ((cs (->char-set "abcd"))) - (let lp ((cur (char-set-cursor cs)) (ans '())) - (if (end-of-char-set? cur) (list->char-set ans) - (lp (char-set-cursor-next cs cur) - (cons (char-upcase (char-set-ref cs cur)) ans)))))) - - - (char-set= (char-set-adjoin (->char-set "123") #\x #\a) - (->char-set "123xa")) - (not (char-set= (char-set-adjoin (->char-set "123") #\x #\a) - (->char-set "123x"))) - (char-set= (char-set-adjoin! (->char-set "123") #\x #\a) - (->char-set "123xa")) - (not (char-set= (char-set-adjoin! (->char-set "123") #\x #\a) - (->char-set "123x"))) - - (char-set= (char-set-delete (->char-set "123") #\2 #\a #\2) - (->char-set "13")) - (not (char-set= (char-set-delete (->char-set "123") #\2 #\a #\2) - (->char-set "13a"))) - (char-set= (char-set-delete! (->char-set "123") #\2 #\a #\2) - (->char-set "13")) - (not (char-set= (char-set-delete! (->char-set "123") #\2 #\a #\2) - (->char-set "13a"))) - - (char-set= (char-set-intersection char-set:hex-digit (char-set-complement char-set:digit)) - (->char-set "abcdefABCDEF")) - (char-set= (char-set-intersection! (char-set-complement! (->char-set "0123456789")) - char-set:hex-digit) - (->char-set "abcdefABCDEF")) - - (char-set= (char-set-union char-set:hex-digit - (->char-set "abcdefghijkl")) - (->char-set "abcdefABCDEFghijkl0123456789")) - (char-set= (char-set-union! (->char-set "abcdefghijkl") - char-set:hex-digit) - (->char-set "abcdefABCDEFghijkl0123456789")) - - (char-set= (char-set-difference (->char-set "abcdefghijklmn") - char-set:hex-digit) - (->char-set "ghijklmn")) - (char-set= (char-set-difference! (->char-set "abcdefghijklmn") - char-set:hex-digit) - (->char-set "ghijklmn")) - - (char-set= (char-set-xor (->char-set "0123456789") - char-set:hex-digit) - (->char-set "abcdefABCDEF")) - (char-set= (char-set-xor! (->char-set "0123456789") - char-set:hex-digit) - (->char-set "abcdefABCDEF")) - - (call-with-values (lambda () - (char-set-diff+intersection char-set:hex-digit - char-set:letter)) - (lambda (d i) - (and (char-set= d (->char-set "0123456789")) - (char-set= i (->char-set "abcdefABCDEF"))))) - - (call-with-values (lambda () - (char-set-diff+intersection! (char-set-copy char-set:hex-digit) - (char-set-copy char-set:letter))) - (lambda (d i) - (and (char-set= d (->char-set "0123456789")) - (char-set= i (->char-set "abcdefABCDEF")))))) - -)) diff --git a/types.db b/types.db index 7280a3c..1d101a8 100644 --- a/types.db +++ b/types.db @@ -2028,83 +2028,6 @@ (string-fill! (#(procedure #:clean #:enforce) string-fill! (string char #!optional fixnum fixnum) string)) -;; srfi-14 - -(->char-set (procedure ->char-set (*) (struct char-set)) - (((struct char-set)) #(1)) - ((string) (string->char-set #(1))) - ((char) (char-set #(1)))) - -(char-set (#(procedure #:enforce) char-set (#!rest char) (struct char-set))) -(char-set->list (#(procedure #:clean #:enforce) char-set->list ((struct char-set)) list)) -(char-set->string (#(procedure #:clean #:enforce) char-set->string ((struct char-set)) string)) -(char-set-adjoin (#(procedure #:clean #:enforce) char-set-adjoin ((struct char-set) #!rest char) (struct char-set))) -(char-set-adjoin! (#(procedure #:clean #:enforce) char-set-adjoin! ((struct char-set) #!rest char) (struct char-set))) -(char-set-any (#(procedure #:enforce) char-set-any ((procedure (char) *) (struct char-set)) *)) -(char-set-complement (#(procedure #:clean #:enforce) char-set-complement ((struct char-set)) (struct char-set))) -(char-set-complement! (#(procedure #:clean #:enforce) char-set-complement! ((struct char-set)) (struct char-set))) -(char-set-contains? (#(procedure #:clean #:enforce) char-set-contains? ((struct char-set) char) boolean)) -(char-set-copy (#(procedure #:clean #:enforce) char-set-copy ((struct char-set)) (struct char-set))) -(char-set-count (#(procedure #:clean #:enforce) char-set-count ((procedure (char) *) (struct char-set)) fixnum)) -(char-set-cursor (#(procedure #:clean #:enforce) char-set-cursor ((struct char-set)) fixnum)) -(char-set-cursor-next (#(procedure #:clean #:enforce) char-set-cursor-next ((struct char-set) fixnum) fixnum)) -(char-set-delete (#(procedure #:clean #:enforce) char-set-delete ((struct char-set) #!rest char) (struct char-set))) -(char-set-delete! (#(procedure #:clean #:enforce) char-set-delete! ((struct char-set) #!rest char) (struct char-set))) -(char-set-diff+intersection (#(procedure #:clean #:enforce) char-set-diff+intersection ((struct char-set) #!rest (struct char-set)) (struct char-set) (struct char-set))) -(char-set-diff+intersection! (#(procedure #:clean #:enforce) char-set-diff+intersection! ((struct char-set) #!rest (struct char-set)) (struct char-set) (struct char-set))) -(char-set-difference (#(procedure #:clean #:enforce) char-set-difference ((struct char-set) #!rest (struct char-set)) (struct char-set))) -(char-set-difference! (#(procedure #:clean #:enforce) char-set-difference! ((struct char-set) #!rest (struct char-set)) (struct char-set))) -(char-set-every (#(procedure #:enforce) char-set-every ((procedure (char) *) (struct char-set)) boolean)) -(char-set-filter (#(procedure #:enforce) char-set-filter ((procedure (char) *) (struct char-set) #!optional (struct char-set)) (struct char-set))) -(char-set-filter! (#(procedure #:enforce) char-set-filter! ((procedure (char) *) (struct char-set) #!optional (struct char-set)) (struct char-set))) -(char-set-fold (#(procedure #:enforce) char-set-fold ((procedure (char *) *) * (struct char-set)) *)) -(char-set-for-each (#(procedure #:enforce) char-set-for-each ((procedure (char) . *) (struct char-set)) undefined)) -(char-set-hash (#(procedure #:clean #:enforce) char-set-hash ((struct char-set) #!optional number) number)) -(char-set-intersection (#(procedure #:clean #:enforce) char-set-intersection (#!rest (struct char-set)) (struct char-set))) -(char-set-intersection! (#(procedure #:clean #:enforce) char-set-intersection! (#!rest (struct char-set)) (struct char-set))) -(char-set-map (#(procedure #:enforce) char-set-map ((procedure (char) char) (struct char-set)) (struct char-set))) -(char-set-ref (#(procedure #:clean #:enforce) char-set-ref ((struct char-set) fixnum) char)) -(char-set-size (#(procedure #:clean #:enforce) char-set-size ((struct char-set)) fixnum)) -(char-set-unfold (#(procedure #:enforce) char-set-unfold (procedure procedure procedure * #!optional (struct char-set)) (struct char-set))) -(char-set-unfold! (#(procedure #:enforce) char-set-unfold! (procedure procedure procedure * (struct char-set)) (struct char-set))) -(char-set-union (#(procedure #:clean #:enforce) char-set-union (#!rest (struct char-set)) (struct char-set))) -(char-set-union! (#(procedure #:clean #:enforce) char-set-union! (#!rest (struct char-set)) (struct char-set))) -(char-set-xor (#(procedure #:clean #:enforce) char-set-xor (#!rest (struct char-set)) (struct char-set))) -(char-set-xor! (#(procedure #:clean #:enforce) char-set-xor! (#!rest (struct char-set)) (struct char-set))) -(char-set:ascii (struct char-set)) -(char-set:blank (struct char-set)) -(char-set:digit (struct char-set)) -(char-set:empty (struct char-set)) -(char-set:full (struct char-set)) -(char-set:graphic (struct char-set)) -(char-set:hex-digit (struct char-set)) -(char-set:iso-control (struct char-set)) -(char-set:letter (struct char-set)) -(char-set:letter+digit (struct char-set)) -(char-set:lower-case (struct char-set)) -(char-set:printing (struct char-set)) -(char-set:punctuation (struct char-set)) -(char-set:symbol (struct char-set)) -(char-set:title-case (struct char-set)) -(char-set:upper-case (struct char-set)) -(char-set:whitespace (struct char-set)) -(char-set<= (#(procedure #:clean #:enforce) char-set<= (#!rest (struct char-set)) boolean) - (() '#t) - (((struct char-set)) (let ((#(tmp) #(1))) '#t))) -(char-set= (#(procedure #:clean #:enforce) char-set= (#!rest (struct char-set)) boolean) - (() '#t) - (((struct char-set)) (let ((#(tmp) #(1))) '#t))) - -(char-set? (#(procedure #:pure #:predicate (struct char-set)) char-set? (*) boolean)) - -(end-of-char-set? (#(procedure #:clean #:enforce) end-of-char-set? (fixnum) boolean)) -(list->char-set (#(procedure #:clean #:enforce) list->char-set ((list-of char) #!optional (struct char-set)) (struct char-set))) -(list->char-set! (#(procedure #:clean #:enforce) list->char-set! ((list-of char) #!optional (struct char-set)) (struct char-set))) -(string->char-set (#(procedure #:clean #:enforce) string->char-set (string #!optional (struct char-set)) (struct char-set))) -(string->char-set! (#(procedure #:clean #:enforce) string->char-set! (string #!optional (struct char-set)) (struct char-set))) -(ucs-range->char-set (#(procedure #:clean #:enforce) ucs-range->char-set (fixnum fixnum #!optional * (struct char-set)) (struct char-set))) -(ucs-range->char-set! (#(procedure #:clean #:enforce) ucs-range->char-set! (fixnum fixnum #!optional * (struct char-set)) (struct char-set))) - ;; srfi-4 -- 1.7.10.4