vector-8b-set!)
(export ()
ascii-string-copy
- burst-string
camel-case-string->lisp
char->string
- decorated-string-append
guarantee-substring
guarantee-substring-end-index
guarantee-substring-start-index
string-compare-ci
string-downcase!
string-head!
- string-joiner
- string-joiner*
string-match-backward
string-match-backward-ci
string-match-forward
string-match-forward-ci
string-maximum-length
- string-null?
string-pad-left
string-pad-right
string-replace
string-search-all
string-search-backward
string-search-forward
- string-splitter
string-trim
string-trim-left
string-trim-right
(substring->list string->list)
(substring-move-left! substring-move!)
(substring-move-right! substring-move!)
+ burst-string
+ decorated-string-append
string-find-next-char
string-find-next-char-ci
string-find-next-char-in-set
string-for-primitive ;export to (runtime) after 9.3
string-hash
string-head
+ string-joiner
+ string-joiner*
string-length
string-lower-case?
string-map
+ string-null?
string-prefix-ci?
string-prefix?
string-ref
string-set!
string-slice
+ string-splitter
string-suffix-ci?
string-suffix?
string-tail
(define (make-vector-8b length #!optional ascii)
(make-string length (if (default-object? ascii) ascii (integer->char ascii))))
-(define (string-null? string)
- (guarantee-string string 'STRING-NULL?)
- (%string-null? string))
-
-(define-integrable (%string-null? string)
- (fix:= 0 (string-length string)))
-
(define (ascii-string-copy string)
(guarantee-string string 'ASCII-STRING-COPY)
(%ascii-string-copy string))
(string-set! string j (string-ref string i))
(string-set! string i char)))))
\f
-(define (decorated-string-append prefix infix suffix strings)
- ((string-joiner* infix prefix suffix) strings))
-
-(define (string-joiner infix #!optional prefix suffix)
- (let ((joiner (string-joiner* prefix infix suffix)))
- (lambda strings
- (joiner strings))))
-
-(define (string-joiner* infix #!optional prefix suffix)
- (let ((prefix (if (default-object? prefix) "" prefix))
- (suffix (if (default-object? suffix) "" suffix)))
- (let ((infix (string-append suffix infix prefix)))
-
- (lambda (strings)
- (string-append*
- (if (pair? strings)
- (cons* prefix
- (car strings)
- (let loop ((strings (cdr strings)))
- (if (pair? strings)
- (cons* infix
- (car strings)
- (loop (cdr strings)))
- (list suffix))))
- '()))))))
-
-(define (burst-string string delimiter allow-runs?)
- ((string-splitter delimiter allow-runs?) string))
-
-(define (string-splitter delimiter #!optional allow-runs?)
- (let ((predicate (splitter-delimiter->predicate delimiter))
- (allow-runs? (if (default-object? allow-runs?) #t allow-runs?)))
-
- (lambda (string #!optional start end)
- (let* ((end (fix:end-index end (string-length string) 'string-splitter))
- (start (fix:start-index start end 'string-splitter)))
-
- (define (find-start start)
- (if allow-runs?
- (let loop ((index start))
- (if (fix:< index end)
- (if (predicate (string-ref string index))
- (loop (fix:+ index 1))
- (find-end index (fix:+ index 1)))
- '()))
- (find-end start start)))
-
- (define (find-end start index)
- (let loop ((index index))
- (if (fix:< index end)
- (if (predicate (string-ref string index))
- (cons (string-copy string start index)
- (find-start (fix:+ index 1)))
- (loop (fix:+ index 1)))
- (list (string-copy string start end)))))
-
- (find-start start)))))
-
-(define (splitter-delimiter->predicate delimiter)
- (cond ((char? delimiter) (char=-predicate delimiter))
- ((char-set? delimiter) (char-set-predicate delimiter))
- ((unary-procedure? delimiter) delimiter)
- (else (error:not-a splitter-delimiter? delimiter 'string-splitter))))
-
-(define (splitter-delimiter? object)
- (or (char? object)
- (char-set? object)
- (unary-procedure? object)))
-\f
(define (vector-8b->hexadecimal bytes)
(define-integrable (hex-char k)
(string-ref "0123456789abcdef" (fix:and k #x0F)))
(define (string-ci-hash string #!optional modulus)
(string-hash (string-foldcase string) modulus))
\f
+(define (string-joiner infix #!optional prefix suffix)
+ (let ((joiner (string-joiner* prefix infix suffix)))
+ (lambda strings
+ (joiner strings))))
+
+(define (string-joiner* infix #!optional prefix suffix)
+ (let ((prefix (if (default-object? prefix) "" prefix))
+ (suffix (if (default-object? suffix) "" suffix)))
+ (let ((infix (string-append suffix infix prefix)))
+
+ (lambda (strings)
+ (string-append*
+ (if (pair? strings)
+ (cons* prefix
+ (car strings)
+ (let loop ((strings (cdr strings)))
+ (if (pair? strings)
+ (cons* infix
+ (car strings)
+ (loop (cdr strings)))
+ (list suffix))))
+ '()))))))
+
+(define (string-splitter delimiter #!optional allow-runs?)
+ (let ((predicate (splitter-delimiter->predicate delimiter))
+ (allow-runs? (if (default-object? allow-runs?) #t allow-runs?)))
+
+ (lambda (string #!optional start end)
+ (let* ((end (fix:end-index end (string-length string) 'string-splitter))
+ (start (fix:start-index start end 'string-splitter)))
+
+ (define (find-start start)
+ (if allow-runs?
+ (let loop ((index start))
+ (if (fix:< index end)
+ (if (predicate (string-ref string index))
+ (loop (fix:+ index 1))
+ (find-end index (fix:+ index 1)))
+ '()))
+ (find-end start start)))
+
+ (define (find-end start index)
+ (let loop ((index index))
+ (if (fix:< index end)
+ (if (predicate (string-ref string index))
+ (cons (string-copy string start index)
+ (find-start (fix:+ index 1)))
+ (loop (fix:+ index 1)))
+ (list (string-copy string start end)))))
+
+ (find-start start)))))
+
+(define (splitter-delimiter->predicate delimiter)
+ (cond ((char? delimiter) (char=-predicate delimiter))
+ ((char-set? delimiter) (char-set-predicate delimiter))
+ ((unary-procedure? delimiter) delimiter)
+ (else (error:not-a splitter-delimiter? delimiter 'string-splitter))))
+
+(define (splitter-delimiter? object)
+ (or (char? object)
+ (char-set? object)
+ (unary-procedure? object)))
+
+(define (decorated-string-append prefix infix suffix strings)
+ ((string-joiner* infix prefix suffix) strings))
+
+(define (burst-string string delimiter allow-runs?)
+ ((string-splitter delimiter allow-runs?) string))
+\f
(define (ustring->legacy-string string)
(if (legacy-string? string)
string
(string-lower-case? (string-slice string start end)))
(define (substring-upper-case? string start end)
- (string-upper-case? (string-slice string start end)))
\ No newline at end of file
+ (string-upper-case? (string-slice string start end)))
+
+(define (string-null? string)
+ (fix:= 0 (string-length string)))
\ No newline at end of file
projects / mit-scheme.git / commitdiff