mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-18 21:29:19 +02:00
More documentation improvements.
This commit is contained in:
parent
452e6f27d7
commit
76ba196fba
15 changed files with 293 additions and 88 deletions
|
@ -1,4 +1,6 @@
|
|||
|
||||
;;> A minimal character set library.
|
||||
|
||||
(define-library (chibi char-set)
|
||||
(import (chibi char-set base) (chibi char-set extras))
|
||||
(export
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -1,4 +1,6 @@
|
|||
|
||||
;;> RSA public key cryptography implementation.
|
||||
|
||||
(define-library (chibi crypto rsa)
|
||||
(import (scheme base) (srfi 27)
|
||||
(chibi bytevector) (chibi math prime))
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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)))
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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<? i j)}
|
||||
;;> \procedure{(string-cursor>? i j)}
|
||||
;;> \procedure{(string-cursor=? i j)}
|
||||
;;> \procedure{(string-cursor<=? i j)}
|
||||
;;> \procedure{(string-cursor>=? i j)}
|
||||
;;>
|
||||
;;> String cursor comparators.
|
||||
;;/
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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?
|
||||
|
|
Loading…
Add table
Reference in a new issue