90 lines
2.4 KiB
Scheme
90 lines
2.4 KiB
Scheme
;;; Random string-hacking procs -*- Scheme -*-
|
|
;;; Copyright (c) 1995 by Olin Shivers.
|
|
;;; Copyright (c) 1997 by Mike Sperber
|
|
|
|
(define (string-map f s)
|
|
(let* ((slen (string-length s))
|
|
(ns (make-string slen)))
|
|
(do ((i (- slen 1) (- i 1)))
|
|
((< i 0) ns)
|
|
(string-set! ns i (f (string-ref s i))))))
|
|
|
|
(define (downcase-string s)
|
|
(string-map char-downcase s))
|
|
|
|
(define (upcase-string s)
|
|
(string-map char-upcase s))
|
|
|
|
|
|
(define (char-set-index str cset . maybe-start)
|
|
(let-optionals maybe-start ((start 0))
|
|
(let ((len (string-length str)))
|
|
(do ((i start (+ 1 i)))
|
|
((or (>= i len)
|
|
(char-set-contains? cset (string-ref str i)))
|
|
(and (< i len) i))))))
|
|
|
|
(define (char-set-rindex str cset . maybe-start)
|
|
(let ((len (string-length str)))
|
|
(let-optionals maybe-start ((start len))
|
|
(do ((i (- start 1) (- i 1)))
|
|
((or (< i 0)
|
|
(char-set-contains? cset (string-ref str i)))
|
|
(and (>= i 0) i))))))
|
|
|
|
(define (string-reduce nil cons s)
|
|
(let ((slen (string-length s)))
|
|
(do ((ans nil (cons (string-ref s i) ans))
|
|
(i 0 (+ i 1)))
|
|
((= i slen) ans))))
|
|
|
|
(define (string-prefix? prefix string)
|
|
(let ((plen (string-length prefix))
|
|
(slen (string-length string)))
|
|
(and (<= plen slen)
|
|
(let lp ((i 0))
|
|
(or (= i plen)
|
|
(and (char=? (string-ref prefix i)
|
|
(string-ref string i))
|
|
(lp (+ i 1))))))))
|
|
|
|
(define (string-suffix? suffix string)
|
|
(let ((slen (string-length suffix))
|
|
(len (string-length string)))
|
|
(and (<= slen len)
|
|
(let lp ((i (- slen 1))
|
|
(j (- len 1)))
|
|
(or (< i 0)
|
|
(and (char=? (string-ref suffix i)
|
|
(string-ref string j))
|
|
(lp (- i 1) (- j 1))))))))
|
|
|
|
(define skip-whitespace
|
|
(let ((non-whitespace (char-set-invert char-set:whitespace)))
|
|
(lambda (s) (char-set-index s non-whitespace))))
|
|
|
|
; Why is this so complicated?
|
|
|
|
(define (trim-spaces string)
|
|
(if (string=? "" string)
|
|
string
|
|
(let* ((length (string-length string))
|
|
(start
|
|
(if (not (char=? #\space (string-ref string 0)))
|
|
0
|
|
(do ((index 0 (+ 1 index)))
|
|
((or (= index length)
|
|
(not (char=? #\space (string-ref string index))))
|
|
index))))
|
|
(end
|
|
(if (not (char=? #\space (string-ref string (- length 1))))
|
|
length
|
|
(do ((index (- length 1) (- index 1)))
|
|
((or (= index 0)
|
|
(not (char=? #\space (string-ref string index))))
|
|
(+ 1 index))))))
|
|
(if (and (= 0 start)
|
|
(= length end))
|
|
string
|
|
(substring string start end)))))
|