diff --git a/lib/chibi/char-set.sld b/lib/chibi/char-set.sld index 12598914..c3cf75c0 100644 --- a/lib/chibi/char-set.sld +++ b/lib/chibi/char-set.sld @@ -1,4 +1,6 @@ +;;> A minimal character set library. + (define-library (chibi char-set) (import (chibi char-set base) (chibi char-set extras)) (export diff --git a/lib/chibi/crypto/md5.scm b/lib/chibi/crypto/md5.scm index 36e969b8..3858eb06 100644 --- a/lib/chibi/crypto/md5.scm +++ b/lib/chibi/crypto/md5.scm @@ -130,6 +130,10 @@ #xffef #xf47d #x8584 #x5dd1 #x6fa8 #x7e4f #xfe2c #xe6e0 #xa301 #x4314 #x4e08 #x11a1 #xf753 #x7e82 #xbd3a #xf235 #x2ad7 #xd2bb #xeb86 #xd391)) +;;> Returns the md5 checksum of \var{src} as a lowercase hex-string. +;;> \var{src} can be any of a string (interpreted as utf8), a +;;> bytevector, or a binary input port. + (define (md5 src) (let ((in (cond ((string? src) (open-input-bytevector (string->utf8 src))) ((bytevector? src) (open-input-bytevector src)) diff --git a/lib/chibi/crypto/md5.sld b/lib/chibi/crypto/md5.sld index 47872136..69caeb6e 100644 --- a/lib/chibi/crypto/md5.sld +++ b/lib/chibi/crypto/md5.sld @@ -1,4 +1,7 @@ +;;> Implementation of the MD5 (Message Digest) cryptographic hash. In +;;> new applications SHA-2 should be preferred. + (define-library (chibi crypto md5) (import (scheme base) (chibi bytevector)) (cond-expand diff --git a/lib/chibi/crypto/rsa.sld b/lib/chibi/crypto/rsa.sld index d3f1a99c..37a10663 100644 --- a/lib/chibi/crypto/rsa.sld +++ b/lib/chibi/crypto/rsa.sld @@ -1,4 +1,6 @@ +;;> RSA public key cryptography implementation. + (define-library (chibi crypto rsa) (import (scheme base) (srfi 27) (chibi bytevector) (chibi math prime)) diff --git a/lib/chibi/crypto/sha2.sld b/lib/chibi/crypto/sha2.sld index a08c09a7..5282a1b2 100644 --- a/lib/chibi/crypto/sha2.sld +++ b/lib/chibi/crypto/sha2.sld @@ -1,4 +1,7 @@ +;;> Implementation of the SHA-2 (Secure Hash Algorithm) cryptographic +;;> hash. + (define-library (chibi crypto sha2) (import (scheme base)) (export sha-224 sha-256) diff --git a/lib/chibi/iset.sld b/lib/chibi/iset.sld index 9ea3e6d5..7ecb0c13 100644 --- a/lib/chibi/iset.sld +++ b/lib/chibi/iset.sld @@ -1,66 +1,10 @@ -;; base.scm - base integer set operations -;; Copyright (c) 2004-2012 Alex Shinn. All rights reserved. +;; Copyright (c) 2004-2015 Alex Shinn. All rights reserved. ;; BSD-style license: http://synthcode.com/license.txt -;; An integer set (iset) is a set of exact integers optimized for -;; minimal space usage and fast membership lookup. General set -;; operations are provided based on the character set operations found -;; in SRFI-14. -;; -;; Creating isets: -;; -;; (make-iset) ; an empty integer set -;; (make-iset n) ; a set of the single integer N -;; (make-iset n m) ; a set of the range of all integers from N-M inclusive -;; -;; The following procedures are provided as direct analogs of the -;; SRFI-14 procedures, accepting and returning isets and integers in -;; place of char-sets and characters: -;; -;; Creating isets: -;; -;; (iset-copy is) ; a new copy of IS -;; (iset n ...) ; an iset containing the elements N... -;; (list->iset ls [base-is]) ; an iset containing all the integers in -;; ; list LS, union BASE-IS if provided -;; (list->iset! ls base-is) ; same as above, allowed but not required to -;; ; modify base-is -;; -;; Querying isets: -;; -;; (iset-size is) ; return the # of elements in IS -;; (iset-contains? is n) ; test N for membership in IS -;; (iset->list is) ; returns a list of all integers in IS -;; -;; Predicates: -;; -;; (iset? obj) ; #t iff obj is an integer set -;; (iset= is ...) ; #t iff all arguments are equivalent integer sets -;; (iset<= is ...) ; #t iff the arguments are monotonically increasing sets -;; (iset>= is ...) ; #t iff the arguments are monotonically decreasing sets -;; -;; Cursors: -;; -;; (iset-cursor iset) -;; (iset-ref iset cursor) -;; (iset-cursor-next iset cursor) -;; (end-of-iset? iset) -;; -;; Set operations: -;; -;; (iset-adjoin is n ...) ; char-set-adjoin -;; (iset-delete is n ...) ; char-set-delete -;; -;; (iset-adjoin! is n ...) ; char-set-adjoin! -;; (iset-delete! is n ...) ; char-set-delete! -;; -;; (iset-union is1 ...) ; char-set-union -;; (iset-intersection is1 ...) ; char-set-intersection -;; (iset-difference is1 is2 ...) ; char-set-difference -;; -;; (iset-union! is1 ...) ; char-set-union! -;; (iset-intersection! is1 ...) ; char-set-intersection! -;; (iset-difference! is1 is2 ...) ; char-set-difference! +;;> A space efficient integer set (iset) implementation, optimized for +;;> minimal space usage and fast membership lookup. General set +;;> operations are provided based on the character set operations +;;> found in SRFI-14. (define-library (chibi iset) (import (chibi iset base) diff --git a/lib/chibi/iset/base.scm b/lib/chibi/iset/base.scm index 5f917ddc..cf3f58a9 100644 --- a/lib/chibi/iset/base.scm +++ b/lib/chibi/iset/base.scm @@ -13,12 +13,20 @@ (left iset-left iset-left-set!) (right iset-right iset-right-set!)) +;;> Create a new iset. Takes two optional arguments, \var{n} and +;;> \var{m}. If only \var{n} is provided the set contains only a +;;> single element. If \var{m} is provided the set contains all +;;> integers from \var{n} to \var{m} inclusive. If neither is +;;> provided the set is initially empty. + (define (make-iset . opt) (if (null? opt) (%make-iset 0 0 0 #f #f) (let ((end (if (pair? (cdr opt)) (cadr opt) (car opt)))) (%make-iset (car opt) end #f #f #f)))) +;;> Returns true iff \var{iset} contains the integer \var{n}. + (define (iset-contains? iset n) (let lp ((is iset)) (let ((start (iset-start is))) diff --git a/lib/chibi/iset/constructors.scm b/lib/chibi/iset/constructors.scm index 6c09d553..c9bd336e 100644 --- a/lib/chibi/iset/constructors.scm +++ b/lib/chibi/iset/constructors.scm @@ -13,16 +13,27 @@ (- n (arithmetic-shift 1 index)) n)) +;;> Create a new iset composed of each of the integers in \var{args}. + (define (iset . args) (list->iset args)) +;;> Returns an iset with all integers in the list \var{ls} added to +;;> \var{iset}, possibly mutating \var{iset} in the process. + (define (list->iset! ls iset) (for-each (lambda (i) (iset-adjoin1! iset i)) ls) iset) +;;> Returns an iset with all integers in the list \var{ls}. If the +;;> optional argument \var{iset} is provided, also includes all +;;> elements in \var{iset}, leaving \var{iset} unchanged. + (define (list->iset ls . opt) (list->iset! ls (if (pair? opt) (iset-copy (car opt)) (make-iset)))) +;;> Returns a new copy of \var{iset}. + (define (iset-copy iset) (and iset (%make-iset @@ -185,9 +196,15 @@ (min end (iset-end node)) #f #f #f)))) +;;> Returns an iset with the integers in \var{ls} added to \var{iset}, +;;> possibly mutating \var{iset} in the process. + (define (iset-adjoin! iset . ls) (list->iset! ls iset)) +;;> Returns an iset with the integers in \var{ls} added to \var{iset}, +;;> without changing \var{iset}. + (define (iset-adjoin iset . ls) (list->iset ls iset)) @@ -221,13 +238,22 @@ (if right (lp right))) (%iset-delete1! is n))))))) +;;> Returns an iset with the integers in \var{ls} removed (if present) +;;> from \var{iset}, possibly mutating \var{iset} in the process. + (define (iset-delete! iset . args) (for-each (lambda (i) (iset-delete1! iset i)) args) iset) +;;> Returns an iset with the integers in \var{ls} removed (if present) +;;> from \var{iset}, without changing \var{iset}. + (define (iset-delete iset . args) (apply iset-delete! (iset-copy iset) args)) +;;> Returns an iset composed of the integers resulting from applying +;;> \var{proc} to every element of \var{iset}. + (define (iset-map proc iset) (iset-fold (lambda (i is) (iset-adjoin! is (proc i))) (make-iset) iset)) @@ -255,6 +281,10 @@ (a a) (else (make-iset))))) +;;> Returns an iset containing all integers which occur in any of the +;;> isets \var{args}. If no \var{args} are present returns an empty +;;> iset. + (define (iset-union . args) (if (null? args) (make-iset) @@ -270,9 +300,17 @@ (apply iset-intersection! a (cdr args))) (else a)))) +;;> Returns an iset containing all integers which occur in \var{a} and +;;> every of the isets \var{args}. If no \var{args} are present +;;> returns \var{a}. + (define (iset-intersection a . args) (apply iset-intersection! (iset-copy a) args)) +;;> Returns an iset containing all integers which occur in \var{a}, +;;> but removing those which occur in any of the isets \var{args}. If +;;> no \var{args} are present returns \var{a}. May mutate \var{a}. + (define (iset-difference! a . args) (if (null? args) a @@ -280,5 +318,7 @@ (iset-for-each (lambda (i) (iset-delete1! a i)) (car args)) (apply iset-difference! a (cdr args))))) +;;> As above but doesn't change \var{a}. + (define (iset-difference a . args) (apply iset-difference! (iset-copy a) args)) diff --git a/lib/chibi/iset/iterators.scm b/lib/chibi/iset/iterators.scm index 2814a969..bd43f99c 100644 --- a/lib/chibi/iset/iterators.scm +++ b/lib/chibi/iset/iterators.scm @@ -2,6 +2,8 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Cursors +;;> Returns true iff \var{iset} is empty. + (define (iset-empty? iset) (and (iset? iset) (cond ((iset-bits iset) => zero?) (else #f)) @@ -15,14 +17,15 @@ (pos iset-cursor-pos iset-cursor-pos-set!) (stack iset-cursor-stack iset-cursor-stack-set!)) -;; Create a new iset cursor pointing to the first element of iset, -;; with an optional stack argument. (define (%iset-cursor iset . o) (iset-cursor-advance (make-iset-cursor iset (or (iset-bits iset) (iset-start iset)) (if (pair? o) (car o) '())))) +;;> Create a new iset cursor pointing to the first element of iset, +;;> with an optional stack argument. + (define (iset-cursor iset . o) (let ((stack (if (pair? o) (car o) '()))) (if (iset-left iset) @@ -51,6 +54,10 @@ (iset-cursor-pop cur)) (else cur)))) +;;> Return a new iset cursor pointing to the next element of +;;> \var{iset} after \var{cur}. If \var{cur} is already at +;;> \scheme{end-of-iset?}, the resulting cursor is as well. + (define (iset-cursor-next iset cur) (iset-cursor-advance (let ((node (iset-cursor-node cur)) @@ -59,6 +66,9 @@ (let ((pos (if (iset-bits node) (bitwise-and pos (- pos 1)) (+ pos 1)))) (make-iset-cursor node pos stack))))) +;;> Return the element of iset \var{iset} at cursor \var{cur}. If the +;;> cursor is at \scheme{end-of-iset?}, raises an error. + (define (iset-ref iset cur) (let ((node (iset-cursor-node cur)) (pos (iset-cursor-pos cur))) @@ -74,7 +84,10 @@ (error "cursor reference past end of iset") pos))))) -(define (end-of-iset? cur) +;;> Returns true iff \var{cur} is at the end of \var{iset}, such that +;;> \scheme{iset-ref} is no longer valid. + +(define (end-of-iset? iset cur) (let ((node (iset-cursor-node cur))) (and (if (iset-bits node) (zero? (iset-cursor-pos cur)) @@ -88,8 +101,8 @@ (define (iset2= is1 is2) (let lp ((cur1 (iset-cursor is1)) (cur2 (iset-cursor is2))) - (cond ((end-of-iset? cur1) (end-of-iset? cur2)) - ((end-of-iset? cur2) #f) + (cond ((end-of-iset? is1 cur1) (end-of-iset? is2 cur2)) + ((end-of-iset? is2 cur2) #f) ((= (iset-ref is1 cur1) (iset-ref is2 cur2)) (lp (iset-cursor-next is1 cur1) (iset-cursor-next is2 cur2))) (else @@ -98,8 +111,8 @@ (define (iset2<= is1 is2) (let lp ((cur1 (iset-cursor is1)) (cur2 (iset-cursor is2))) - (cond ((end-of-iset? cur1)) - ((end-of-iset? cur2) #f) + (cond ((end-of-iset? is1 cur1)) + ((end-of-iset? is2 cur2) #f) (else (let ((i1 (iset-ref is1 cur1)) (i2 (iset-ref is1 cur2))) @@ -112,16 +125,29 @@ ;; (< i1 i2) - i1 won't occur in is2 #f))))))) +;;> Returns true iff all arguments contain the same elements. Always +;;> returns true if there are less than two arguments. + (define (iset= . o) (or (null? o) (let lp ((a (car o)) (ls (cdr o))) (or (null? ls) (and (iset2= a (car ls)) (lp (car ls) (cdr ls))))))) +;;> Returns true iff the arguments are monotonically increasing, that +;;> is each argument contains every element of all preceding +;;> arguments. Always returns true if there are less than two +;;> arguments. + (define (iset<= . o) (or (null? o) (let lp ((a (car o)) (ls (cdr o))) (or (null? ls) (and (iset2<= a (car ls)) (lp (car ls) (cdr ls))))))) +;;> Returns true iff the arguments are monotonically decreasing, that +;;> is each argument contains every element of all succeeding +;;> arguments. Always returns true if there are less than two +;;> arguments. + (define (iset>= . o) (apply iset<= (reverse o))) @@ -135,6 +161,10 @@ (right (iset-right is))) (if right (lp right acc) acc)))) +;;> The fundamental iset iterator. Applies \var{kons} to every +;;> element of \var{iset} along with an accumulator, starting with +;;> \var{knil}. Returns \var{knil} if \var{iset} is empty. + (define (iset-fold kons knil iset) (iset-fold-node (lambda (is acc) @@ -156,12 +186,19 @@ (define (iset-for-each-node proc iset) (iset-fold-node (lambda (node acc) (proc node)) #f iset)) +;;> Runs \var{proc} on every element of iset, discarding the results. + (define (iset-for-each proc iset) (iset-fold (lambda (i acc) (proc i)) #f iset)) +;;> Returns a list of every integer in \var{iset} in sorted +;;> (increasing) order. + (define (iset->list iset) (reverse (iset-fold cons '() iset))) +;;> Returns the number of elements in \var{iset}. + (define (iset-size iset) (iset-fold-node (lambda (is acc) diff --git a/lib/chibi/parse.sld b/lib/chibi/parse.sld index b06a4086..0e774f53 100644 --- a/lib/chibi/parse.sld +++ b/lib/chibi/parse.sld @@ -1,4 +1,7 @@ +;;> A parser combinator library with optional memoization and +;;> convenient syntax. + (define-library (chibi parse) (export grammar grammar/unmemoized define-grammar define-grammar/unmemoized call-with-parse parse parse-fully parse-fold diff --git a/lib/chibi/string.scm b/lib/chibi/string.scm index 388ffeab..d9f92117 100644 --- a/lib/chibi/string.scm +++ b/lib/chibi/string.scm @@ -2,6 +2,15 @@ ;; Copyright (c) 2012-2015 Alex Shinn. All rights reserved. ;; BSD-style license: http://synthcode.com/license.txt +;;> \section{High-level API} + +;;> The procedures below are similar to those in SRFI 13 or other +;;> string libraries, except instead of receiving and returning +;;> character indexes they use opaque string cursors. + +;;> \procedure{(string-null? str)} +;;> Returns true iff \var{str} is equal to the empty string \scheme{""}. + (define (string-null? str) (equal? str "")) @@ -13,8 +22,14 @@ (define (complement pred) (lambda (x) (not (pred x)))) -(define (string-any x str) - (let ((pred (make-char-predicate x)) +;;> Returns true iff \var{check} is true for any character in +;;> \var{str}. \var{check} can be a procedure, char (to test for +;;> \scheme{char=?} equivalence) or char-set (to test for +;;> \var{char-set-contains?}). Always returns false if \var{str} is +;;> empty. + +(define (string-any check str) + (let ((pred (make-char-predicate check)) (end (string-cursor-end str))) (and (string-cursor>? end (string-cursor-start str)) (let lp ((i (string-cursor-start str))) @@ -24,11 +39,22 @@ (pred ch) ;; tail call (or (pred ch) (lp i2)))))))) -(define (string-every x str) - (not (string-any (complement (make-char-predicate x)) str))) +;;> Returns true iff \var{check} is true for every character in +;;> \var{str}. \var{check} can be a procedure, char or char-set as in +;;> \scheme{string-any}. Always returns true if \var{str} is empty. -(define (string-find str x . o) - (let ((pred (make-char-predicate x)) +(define (string-every check str) + (not (string-any (complement (make-char-predicate check)) str))) + +;;> Returns a cursor pointing to the first position from the left in +;;> string for which \var{check} is true. \var{check} can be a +;;> procedure, char or char-set as in \scheme{string-any}. The +;;> optional cursors \var{start} and \var{end} can specify a substring +;;> to search, and default to the whole string. Returns a cursor just +;;> past the end of \var{str} if no character matches. + +(define (string-find str check . o) + (let ((pred (make-char-predicate check)) (end (if (and (pair? o) (pair? (cdr o))) (cadr o) (string-cursor-end str)))) @@ -37,15 +63,22 @@ ((pred (string-cursor-ref str i)) i) (else (lp (string-cursor-next str i))))))) -(define (string-find? str x . o) +;;> As above, ignoring the position and returning true iff any +;;> character matches. + +(define (string-find? str check . o) (let ((start (if (pair? o) (car o) (string-cursor-start str))) (end (if (and (pair? o) (pair? (cdr o))) (cadr o) (string-cursor-end str)))) - (< (string-find str x start end) end))) + (< (string-find str check start end) end))) -(define (string-find-right str x . o) - (let ((pred (make-char-predicate x)) +;;> As \scheme{string-find}, but returns the position of the first +;;> character from the right of \var{str}. If no character matches, +;;> returns a string cursor pointing just before \var{start}. + +(define (string-find-right str check . o) + (let ((pred (make-char-predicate check)) (start (if (pair? o) (car o) (string-cursor-start str)))) (let lp ((i (if (and (pair? o) (pair? (cdr o))) (cadr o) @@ -55,14 +88,32 @@ ((pred (string-cursor-ref str i2)) i) (else (lp i2))))))) -(define (string-skip str x . o) - (apply string-find str (complement (make-char-predicate x)) o)) +;;> As \scheme{string-find}, but inverts the check, returning the +;;> position of the first character which doesn't match. -(define (string-skip-right str x . o) - (apply string-find-right str (complement (make-char-predicate x)) o)) +(define (string-skip str check . o) + (apply string-find str (complement (make-char-predicate check)) o)) + +;;> As \scheme{string-find-right}, but inverts the check, returning +;;> the position of the first character which doesn't match. + +(define (string-skip-right str check . o) + (apply string-find-right str (complement (make-char-predicate check)) o)) + +;;> \procedure{(string-join list-of-strings [separator])} +;;> +;;> Concatenates the \var{list-of-strings} and return the result as a +;;> single string. If \var{separator} is provided it is inserted +;;> between each pair of strings. (define string-join string-concatenate) +;;> Split \var{str} into a list of substrings separated by \var{pred}, +;;> which defaults to \scheme{#\\space}. Multiple adjacent characters +;;> which satisy \var{pred} will result in empty strings in the list. +;;> If the optional \var{limit} is provided, splits into at most that +;;> many substrings starting from the left. + (define (string-split str . o) (let ((pred (make-char-predicate (if (pair? o) (car o) #\space))) (limit (if (and (pair? o) (pair? (cdr o))) @@ -83,16 +134,28 @@ (reverse res) (lp (string-cursor-next str j) (+ n 1) res))))))))) +;;> Returns a copy of the string \var{str} with all characters +;;> matching \var{pred} (default \scheme{#\\space}) removed from the +;;> left. + (define (string-trim-left str . o) (let ((pred (make-char-predicate (if (pair? o) (car o) #\space)))) (substring-cursor str (string-skip str pred)))) +;;> Returns a copy of the string \var{str} with all characters +;;> matching \var{pred} (default \scheme{#\\space}) removed from the +;;> right. + (define (string-trim-right str . o) (let ((pred (make-char-predicate (if (pair? o) (car o) #\space)))) (substring-cursor str (string-cursor-start str) (string-skip-right str pred)))) +;;> Returns a copy of the string \var{str} with all characters +;;> matching \var{pred} (default \scheme{#\\space}) removed from both +;;> sides. + (define (string-trim str . o) (let* ((pred (if (pair? o) (car o) #\space)) (left (string-skip str pred)) @@ -126,14 +189,26 @@ ;; TODO: These definitions are specific to the Chibi implementation of ;; cursors. Possibly the mismatch API should be modified to allow an ;; efficient portable definition. + +;;> Returns true iff \var{prefix} is a prefix of \var{str}. + (define (string-prefix? prefix str) (= (string-cursor-end prefix) (string-mismatch prefix str))) +;;> Returns true iff \var{suffix} is a suffix of \var{str}. + (define (string-suffix? suffix str) (= (string-cursor-prev suffix (string-cursor-start suffix)) (- (string-mismatch-right suffix str) (- (string-cursor-end str) (string-cursor-end suffix))))) +;;> The fundamental string iterator. Calls \var{kons} on each +;;> character of \var{str} and an accumulator, starting with +;;> \var{knil}. If multiple strings are provided, calls \var{kons} on +;;> the corresponding characters of all strings, with the accumulator +;;> as the final argument, and terminates when the shortest string +;;> runs out. + (define (string-fold kons knil str . los) (if (null? los) (let ((end (string-cursor-end str))) @@ -153,6 +228,9 @@ (apply kons (append (map string-cursor-ref los is) (list acc))))))))) +;;> Equivalent to \scheme{string-fold}, but iterates over \var{str} +;;> from right to left. + (define (string-fold-right kons knil str) (let ((end (string-cursor-end str))) (let lp ((i (string-cursor-start str))) @@ -160,19 +238,93 @@ knil (kons (string-cursor-ref str i) (lp (string-cursor-next str i))))))) -(define (string-count str x) - (let ((pred (make-char-predicate x))) +;;> \procedure{(string-map proc str)} +;;> +;;> Returns a new string composed of applying the procedure \var{proc} +;;> to every character in \var{string}. + +;;> \procedure{(string-for-each proc str)} +;;> +;;> Apply \var{proc} to every character in \var{str} in order and +;;> discard the result. + +;;> \procedure{(string-count str check)} +;;> +;;> Count the number of characters in \var{str} for which \var{check} +;;> is true. + +(define (string-count str check) + (let ((pred (make-char-predicate check))) (string-fold (lambda (ch count) (if (pred ch) (+ count 1) count)) 0 str))) +;;> \procedure{(string-contain s1 s2)} +;;> +;;> Returns a cursor pointing to the first position in the string +;;> \var{s1} where \var{s2} occurs, or \scheme{#f} if there is no such +;;> match. + +;;> \procedure{(mamke-string-searcher needle)} +;;> +;;> Partial application of \scheme{string-contain}. Return a +;;> procedure of one argument, a string, which runs +;;> \scheme{(string-contain str \var{needle})}. + (define (make-string-searcher needle) (lambda (haystack) (string-contains haystack needle))) +;;> Return a copy of string \var{s} with all 26 upper-case ASCII +;;> characters mapped to their corresponding 26 lower-case ASCII +;;> characters. + (define (string-downcase-ascii s) (call-with-output-string (lambda (out) (string-for-each (lambda (ch) (write-char (char-downcase ch) out)) s)))) +;;> Return a copy of string \var{s} with all 26 lower-case ASCII +;;> characters mapped to their corresponding 26 upper-case ASCII +;;> characters. + (define (string-upcase-ascii s) (call-with-output-string (lambda (out) (string-for-each (lambda (ch) (write-char (char-upcase ch) out)) s)))) + +;;> \section{Cursor API} + +;;> \procedure{(substring-cursor str i [j])} +;;> +;;> Returns the substring of \var{str} between \var{i} (inclusive) and +;;> optional \var{j} (exclusive), which defaults to the end of the +;;> string. + +;;> \procedure{(string-cursor-ref str i)} +;;> +;;> Returns the character of \var{str} at position \var{i}. + +;;> \procedure{(string-cursor-start str)} +;;> +;;> Returns a string cursor pointing to the start of \var{str}. + +;;> \procedure{(string-cursor-end str)} +;;> +;;> Returns a string cursor pointing just past the end of \var{str}. + +;;> \procedure{(string-cursor-next str i)} +;;> +;;> Returns a string cursor to the character in \var{str} just after +;;> the cursor \var{i}. + +;;> \procedure{(string-cursor-prev str i)} +;;> +;;> Returns a string cursor to the character in \var{str} just before +;;> the cursor \var{i}. + +;;> \procedure{(string-cursor \procedure{(string-cursor>? i j)} +;;> \procedure{(string-cursor=? i j)} +;;> \procedure{(string-cursor<=? i j)} +;;> \procedure{(string-cursor>=? i j)} +;;> +;;> String cursor comparators. +;;/ diff --git a/lib/chibi/string.sld b/lib/chibi/string.sld index 5c7256fa..bcda4cf2 100644 --- a/lib/chibi/string.sld +++ b/lib/chibi/string.sld @@ -1,4 +1,8 @@ +;;> A cursor-oriented string library. Provides efficient string +;;> utilities for implementations with or without fast random-access +;;> strings. + (define-library (chibi string) (export string-cursor-start string-cursor-end string-cursor-ref diff --git a/lib/chibi/sxml.scm b/lib/chibi/sxml.scm index a74e9a28..600c614d 100644 --- a/lib/chibi/sxml.scm +++ b/lib/chibi/sxml.scm @@ -77,7 +77,7 @@ (call-with-output-string (lambda (out) (html-display-escaped-string str out)))) -;; utility to render (valid, expanded) sxml as html +;;> Render (valid, expanded) \var{sxml} as html. (define (sxml-display-as-html sxml . o) (let ((out (if (pair? o) (car o) (current-output-port)))) (let lp ((sxml sxml)) @@ -101,11 +101,12 @@ ((null? sxml)) (else (html-display-escaped-string sxml out)))))) +;;> Render \var{sxml} as \var{sxml}. (define (sxml->xml sxml) (call-with-output-string (lambda (out) (sxml-display-as-html sxml out)))) -;; utility to render sxml as simple text, stripping all tags +;;> Render \var{sxml} as simple text, stripping all tags. (define (sxml-strip sxml) (call-with-output-string (lambda (out) @@ -118,7 +119,7 @@ ((string? x) (display x out))))))) -;; utility to render sxml as text for viewing in a terminal +;;> Render \var{sxml} as text for viewing in a terminal. (define (sxml-display-as-text sxml . o) (let ((out (if (pair? o) (car o) (current-output-port)))) (let lp ((sxml sxml)) diff --git a/lib/chibi/sxml.sld b/lib/chibi/sxml.sld index 18d5db11..d74c3dbf 100644 --- a/lib/chibi/sxml.sld +++ b/lib/chibi/sxml.sld @@ -1,4 +1,6 @@ +;;> Utilities to convert sxml to xml or plain text. + (define-library (chibi sxml) (export sxml->xml sxml-display-as-html sxml-display-as-text sxml-strip html-escape html-tag->string) diff --git a/tools/optimize-char-sets.scm b/tools/optimize-char-sets.scm index db9f0214..f617f2ea 100644 --- a/tools/optimize-char-sets.scm +++ b/tools/optimize-char-sets.scm @@ -46,7 +46,7 @@ (do ((cur (iset-cursor value) (iset-cursor-next value cur)) (res '() (cons (iset-ref value cur) res))) - ((end-of-iset? cur) (reverse res))))) + ((end-of-iset? value cur) (reverse res))))) (error "error in iset cursors")) (display " computing intersection\n" (current-error-port)) (let* ((iset1 (if ascii?