Returns str with all uppercase characters converted to lowercase.
(define (case-fold-down str)
;; Returns str shifted to lowercase
(apply string (case-fold-down-charlist (string-to-list str)))) |
Returns str with all lowercase characters converted to uppercase.
(define (case-fold-up str)
;; Returns str shifted to uppercase
(apply string (case-fold-up-charlist (string-to-list str)))) |
Returns the string that is the concatenation of num occurrences of string.
(define (copy-string string num)
;; Return string copied num times
;; (copy-string "x" 3) => "xxx"
(if (<= num 0)
""
(let loop ((str string) (count (- num 1)))
(if (<= count 0)
str
(loop (string-append str string) (- count 1)))))) |
(directory-depth pathname) |
Returns the number of directory levels in the pathname string when the string is interpreted as a Unix-style pathname.
(define (directory-depth pathname)
;; Return the number of directory levels in pathname
;; "filename" => 0
;; "foo/filename" => 1
;; "foo/bar/filename => 2
;; "foo/bar/../filename => 1
(let loop ((count 0) (pathlist (match-split pathname "/")))
(if (null? pathlist)
(- count 1) ;; pathname should always end in a filename
(if (or (equal? (car pathlist) "/") (equal? (car pathlist) "."))
(loop count (cdr pathlist))
(if (equal? (car pathlist) "..")
(loop (- count 1) (cdr pathlist))
(loop (+ count 1) (cdr pathlist))))))) |
(find-first-char string skipchars findchars pos) |
Returns the first character in string that is in findchars and not in skipchars. findchars and skipchars are both strings.
If pos is supplied, the search begins at offset pos within string, otherwise the search begins at offset 0.
(define (find-first-char string skipchars findchars #!optional (pos 0))
;; Finds first character in string that is in findchars, skipping all
;; occurances of characters in skipchars. Search begins at pos. If
;; no such characters are found, returns -1.
;;
;; If skipchars is empty, skip anything not in findchars
;; If skipchars is #f, skip nothing
;; If findchars is empty, the first character not in skipchars is matched
;; It is an error if findchars is not a string.
;; It is an error if findchars is empty and skipchars is not a non-empty
;; string.
;;
(let ((skiplist (if (string? skipchars)
(string-to-list skipchars)
'()))
(findlist (string-to-list findchars)))
(if (and (null? skiplist) (null? findlist))
;; this is an error
-2
(if (or (>= pos (string-length string)) (< pos 0))
-1
(let ((ch (string-ref string pos)))
(if (null? skiplist)
;; try to find first
(if (member ch findlist)
pos
(if (string? skipchars)
(find-first-char string
skipchars findchars (+ 1 pos))
-1))
;; try to skip first
(if (member ch skiplist)
(find-first-char string skipchars findchars (+ 1 pos))
(if (or (member ch findlist) (null? findlist))
pos
-1)))))))) |
Returns #t if a matches the initial substring of b.
;; Is `a' an initial substring of `b'?
(define (initial-substring? a b)
(string=? a (substring b 0 (string-length a)))) |
(match-split string target) |
Returns a list of strings. The strings are string split at every occurrence of target, and the list includes the occurrences of target.
(define (match-split string target)
;; Splits string at every occurrence of target and returns the result
;; as a list. "this is a test" split at "is" returns
;; ("th" "is" " " "is" " a test")
(let loop ((result '()) (current "") (rest string))
(if (< (string-length rest) (string-length target))
(append result (if (equal? (string-append current rest) "")
'()
(list (string-append current rest))))
(if (equal? target (substring rest 0 (string-length target)))
(loop (append result
(if (equal? current "")
'()
(list current))
(list target))
""
(substring rest (string-length target) (string-length rest)))
(loop result
(string-append current (substring rest 0 1))
(substring rest 1 (string-length rest))))))) |
(match-split-string-list string-list target) |
Returns a list of strings. The strings are the each of the strings in string-list split at every occurrence of target, and the list includes the occurrences of target.
(define (match-split-string-list string-list target)
;; Splits each string in string-list at target with match-split,
;; concatenates the results and returns them as a single list
(let loop ((result '()) (sl string-list))
(if (null? sl)
result
(loop (append result (match-split (car sl) target))
(cdr sl))))) |
(match-split-list string target-list) |
Returns a list of strings. The strings are string split at every occurrence of each of the strings in target-list, and the list includes the occurrences of the target strings.
(define (match-split-list string target-list)
;; Splits string at every target in target-list with match-split,
;; returning the whole collection of strings as a list
(let loop ((result (list string)) (tlist target-list))
(if (null? tlist)
result
(loop (match-split-string-list result (car tlist))
(cdr tlist))))) |
(match-substitute-sosofo string assoc-list) |
Returns the sosofo, from the assoc-list associative list of string and sosofo pairs, that matches string, otherwise returns the sosofo of string as a literal string if there is no match.
(define (match-substitute-sosofo string assoc-list)
;; Given a string and an associative list of strings and sosofos,
;; return the sosofo of the matching string, or return the literal
;; string as a sosofo.
(if (assoc string assoc-list)
(car (cdr (assoc string assoc-list)))
(literal string))) |
(pad-string string length padchar) |
Returns string padded in front with the padchar string until it is at least length characters. If string is longer than or the same length as length characters, then string is returned without modification. Note the padchar may be more than a single-character string.
(define (pad-string string length padchar)
;; Returns string, padded in front with padchar to at least length
(let loop ((s string))
(if (>= (string-length s) length)
s
(loop (string-append padchar s))))) |
(repl-substring? string target pos) |
Returns #t if target occurs in string at offset pos.
(define (repl-substring? string target pos)
;; Returns true if target occurs in string at pos
(let* ((could-match (<= (+ pos (string-length target))
(string-length string)))
(match (if could-match
(substring string pos (+ pos (string-length target))) "")))
(and could-match (string=? match target)))) |
(repl-substring string target repl pos) |
Returns string with substring target replaced by repl if target occurs at character offset pos, otherwise returns string unaltered.
(define (repl-substring string target repl pos)
;; Replace target with repl in string at pos
(let ((matches (repl-substring? string target pos)))
(if matches
(string-append
(substring string 0 pos)
repl
(substring string
(+ pos (string-length target))
(string-length string)))
string))) |
(repl-string-list? string replace-list pos) |
Returns #t if any of the target strings in the sequence of target�replacement pairs of strings in replace-list occurs at character offset pos within string.
(define (repl-substring-list? string replace-list pos)
;; Given replace-list, a list of target, replacement pairs, return
;; true if any occurance of target occurs at pos
;; (repl-substring-list? "this is it" ("was" "x" "is" "y") 2)
;; returns true ("is" could be replaced by "y")
(let loop ((list replace-list))
(let ((target (car list))
(repl (car (cdr list)))
(rest (cdr (cdr list))))
(if (repl-substring? string target pos)
#t
(if (null? rest)
#f
(loop rest)))))) |
(repl-substring-list-target string replace-list pos) |
Returns the target string that would be replaced if repl-substring-list were called with the same arguments.
(define (repl-substring-list-target string replace-list pos)
;; Given replace-list, a list of target, replacement pairs, return
;; the target that would be replaced if repl-substring-list was
;; called with the same arguments.
(let loop ((list replace-list))
(let ((target (car list))
(repl (car (cdr list)))
(rest (cdr (cdr list))))
(if (repl-substring? string target pos)
target
(if (null? rest)
#f
(loop rest)))))) |
(repl-string-list-repl string replace-list pos) |
Returns the replacement string that would be inserted if repl-substring-list were called with the same arguments.
(define (repl-substring-list-repl string replace-list pos)
;; Given replace-list, a list of target, replacement pairs, return
;; the replacement that would be used if repl-substring-list was
;; called with the same arguments.
(let loop ((list replace-list))
(let ((target (car list))
(repl (car (cdr list)))
(rest (cdr (cdr list))))
(if (repl-substring? string target pos)
repl
(if (null? rest)
#f
(loop rest)))))) |
(repl-substring-list string replace-list pos) |
Returns string with the first target from the sequence of target�replacement pairs in replace-list that occurs at character offset pos substituted by its replacement.
(define (repl-substring-list string replace-list pos)
;; Replace any single target in string at pos (the first one in
;; replace-list that matches).
(if (repl-substring-list? string replace-list pos)
(let ((target (repl-substring-list-target string replace-list pos))
(repl (repl-substring-list-repl string replace-list pos)))
(repl-substring string target repl pos))
string)) |
(string-list-sosofo string-list assoc-list) |
Returns a sosofo that is each of the sosofos from matching each of the strings in string-list with the string�sosofo pairs in the assoc-list associative list appended together. Strings from string-list that do not have a match in assoc-list are included as literal sosofos.
(define (string-list-sosofo string-list assoc-list)
;; Take a list of strings and an associative list that maps strings
;; to sosofos and return an appended sosofo.
;; Given the string list ("what is " "1" " " "+" " " "1")
;; and the associative list
;; (("1" (literal "one")) ("2" (literal "two")) ("+" (literal "plus")))
;; string-list-sosofo returns the equivalent of the sosofo
;; (literal "what is one plus one")
(if (null? string-list)
(empty-sosofo)
(sosofo-append (match-substitute-sosofo (car string-list) assoc-list)
(string-list-sosofo (cdr string-list) assoc-list)))) |
(string-replace string target repl) |
Returns string with all occurrences of target replaced by repl. Any occurrences of target within repl are not themselves replaced.
(define (string-replace string target repl)
;; Replace all occurances of target with repl in string. If the
;; target occurs in repl, that occurance will _not_ be replaced.
(let loop ((str string) (pos 0))
(if (>= pos (string-length str))
str
(loop (repl-substring str target repl pos)
(if (repl-substring? str target pos)
(+ (string-length repl) pos)
(+ 1 pos)))))) |
(string-replace-list string replace-list) |
Returns string with every occurrence of every target string in the sequence of target�replacement pairs in replace-list substituted by its replacement.
(define (string-replace-list string replace-list)
;; Given replace-list, replace all occurances of every target in string
;; with its replacement.
(let loop ((str string) (pos 0))
(if (>= pos (string-length str))
str
(loop (repl-substring-list str replace-list pos)
(if (repl-substring-list? str replace-list pos)
(+ (string-length
(repl-substring-list-repl str replace-list pos))
pos)
(+ 1 pos)))))) |
Returns a list of the characters in string.
(define (string-to-list string)
;; Returns a list of the characters of string
(let ((length (string-length string)))
(let loop ((i 0))
(if (= i length)
'()
(cons (string-ref string i)
(loop (+ i 1))))))) |
(string-with-space string) |
Returns string with an appended blank, unless string is an empty string, in which case it returns an empty string.
(define (string-with-space string)
;; Returns string with an appended blank if string is not the empty
;; string. Returns the empty string if string is the empty string.
(if (equal? string "")
""
(string-append string " "))) |
(define whitespaced-words
(curry words char-whitespace?)) |
Returns a list of the �words� split from string s. The word delimiters are characters for which predicate pred? returns #t.
;; Split string `s' into words delimited by characters answering #t to
;; predicate `pred?'. After the Haskell prelude. See also Bird and
;; Wadler.
(define (words pred? s)
(letrec ((words (lambda (s)
(let ((dropped (dropwhile pred? s)))
(if (null? dropped)
'()
(let ((broken (break pred? dropped)))
(cons (car broken)
(words (cdr broken)))))))))
(map list->string (words (string->list s))))) |