summaryrefslogtreecommitdiff
path: root/Alpha/String.scm
diff options
context:
space:
mode:
authorBen Sima <ben@bsima.me>2020-05-09 15:02:55 -0700
committerBen Sima <ben@bsima.me>2020-05-09 15:03:30 -0700
commitf0f74f93d6cce751a4aef2576f7bce837f7b23c2 (patch)
tree87faa28bcc6a4ac411b302e8750166c3fabea81c /Alpha/String.scm
parent423a5778c62a3c6a47e4466e9b5f581e0dcb3c5e (diff)
Add proper replace
- replace was actually replace-char - backported string-replace-substring because it's only in Guile 3
Diffstat (limited to 'Alpha/String.scm')
-rw-r--r--Alpha/String.scm37
1 files changed, 35 insertions, 2 deletions
diff --git a/Alpha/String.scm b/Alpha/String.scm
index 779c2fb..c7ad61f 100644
--- a/Alpha/String.scm
+++ b/Alpha/String.scm
@@ -1,12 +1,15 @@
(define-module (Alpha String)
- #:export (replace to-string str capitalize))
+ #:export (replace replace-char to-string str capitalize))
-(define (replace s match repl)
+(define (replace-char s match repl)
(let ((f (lambda (a b)
(let ((next-char (if (eq? a match) repl a)))
(string-concatenate (list b (string next-char)))))))
(string-fold f "" s)))
+(define (replace s match repl)
+ (string-replace-substring s match repl))
+
(define (to-string x)
(format #f "~a" x))
@@ -22,3 +25,33 @@
(string-upcase s)
(str (string-upcase (substring s 0 1))
(substring s 1 )))))
+
+
+;;; {String Fun: string-replace-substring}
+;;;
+
+;; string-replace-substring By A. Wingo in
+;; https://lists.gnu.org/archive/html/guile-devel/2014-03/msg00058.html
+;; also in string-replace-substring guix:guix/utils.scm.
+
+(define (string-replace-substring str substring replacement)
+ "Return a new string where every instance of @var{substring} in string
+ @var{str} has been replaced by @var{replacement}. For example:
+
+ @lisp
+ (string-replace-substring \"a ring of strings\" \"ring\" \"rut\")
+ @result{} \"a rut of struts\"
+ @end lisp
+ "
+ (let ((sublen (string-length substring)))
+ (with-output-to-string
+ (lambda ()
+ (let lp ((start 0))
+ (cond
+ ((string-contains str substring start)
+ => (lambda (end)
+ (display (substring/shared str start end))
+ (display replacement)
+ (lp (+ end sublen))))
+ (else
+ (display (substring/shared str start)))))))))