gambit-libs / tcv-string.scm

;;; Copyright (c) 2009, Taylor Venable
;;; 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.
;;;
;;; 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 OWNER 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.

(tcv-require 'char)

;; Implement a better substring method.  With three arguments, works just like
;; R5RS substring.  With two arguments, returns the string from the given
;; starting position to the end.

(define %substring
  (lambda args
    (if (= (length args) 2)
      (substring (car args) (cadr args) (string-length (car args)))
      (apply substring args))))

;; Find the first position of character 'c' within the supplied string 's' or
;; #f if no such character occurs.

(define string-index
  (lambda (s c)
    (call/cc (lambda (k)
               (let search ((i 0))
                 (if (>= i (string-length s))
                   (k #f)
                   (if (char=? (string-ref s i) c)
                     (k i)
                     (search (+ i 1)))))))))

;; Split a string 's' up into a list of substrings by character 'c'.  If 'c'
;; does not occur, the result is a unary list.

(define string-split
  (lambda (s c)
    (let loop ((result '()) (s s))
      (let ((index (string-index s c)))
        (if index
          (loop (cons (%substring s 0 index) result)
                (%substring s (+ index 1)))
          (reverse (cons s result)))))))

(define string-reverse
  (lambda (s)
    (with-output-to-string '()
      (lambda ()
        (let loop
          ((i (- (string-length s) 1)))
          (if (>= i 0)
            (begin
              (display (string-ref s i))
              (loop (- i 1)))))))))

(define string-trim-left
  (lambda (s)
    (let loop
      ((index 0))
      (let ((c (string-ref s index)))
        (if (char-space? c)
          (loop (+ index 1))
          (%substring s index))))))

(define string-trim-right
  (lambda (s)
    (string-reverse (string-trim-left (string-reverse s)))))

(define string-trim
  (lambda (s)
    (string-trim-right (string-trim-left s))))

(define (string->vector s)
  (let ((v (make-vector (string-length s))))
    (do ((i 0 (+ i 1)))
        ((= i (vector-length v)))
      (vector-set! v i (string-ref s i)))
    v))

(define (string-append* . args)
  (apply string-append
         (map (lambda (x) (or (and (char? x) (string x)) x))
              args)))

(define (string-map f s)
  (let ((result (make-string (string-length s))))
    (do ((i 0 (+ i 1)))
        ((= i (string-length s)) result)
      (string-set! result i (f (string-ref s i))))))

(define (string-for-each f s)
  (do ((i 0 (+ i 1)))
      ((= i (string-length s)) s)
    (f (string-ref s i))))

(define (string-fold f init s)
  (let loop ((result (string-copy init)) (i 0))
    (if (= i (string-length s))
      result
      (loop (f result (string-ref s i)) (+ i 1)))))

(define (vector->string v)
  (with-output-to-string '()
    (lambda ()
      (do ((i 0 (+ i 1)))
          ((= i (vector-length v)))
        (display (vector-ref v i))))))

;; Local Variables:
;; scheme-dialect: gambit
;; End:
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.