From 7cfd7faf0969e6db2e38b9cfb91ed5f674ec1f79 Mon Sep 17 00:00:00 2001
From: josh <josh@joshua-a-betts.com>
Date: Sat, 3 Jun 2023 16:16:59 +0700
Subject: [PATCH] Have replace-* work with characters. Add a compiler macro for
 this.

Add 3 aliases for the replace-* called substitute-* because
cl-user:replace is destructive.
---
 str.lisp           | 40 +++++++++++++++++++++++++++++++++++++---
 test/test-str.lisp |  4 +++-
 2 files changed, 40 insertions(+), 4 deletions(-)

diff --git a/str.lisp b/str.lisp
index 081b392..fb96d0a 100644
--- a/str.lisp
+++ b/str.lisp
@@ -19,8 +19,11 @@
   #:shorten
   #:repeat
   #:replace-first
+  #:substitute-first
   #:replace-all
+  #:substitute-all
   #:replace-using
+  #:substitute-using
   #:concat
   #:emptyp
   #:non-empty-string-p
@@ -294,7 +297,7 @@ It uses `subseq' with differences:
 (defun words (s &key (limit 0))
   "Return list of words, which were delimited by white space. If the optional limit is 0 (the default), trailing empty strings are removed from the result list (see cl-ppcre)."
   (when s
-      (ppcre:split "\\s+" (trim-left s) :limit limit)))
+    (ppcre:split "\\s+" (trim-left s) :limit limit)))
 
 (defun unwords (strings)
   "Join the list of strings with a whitespace."
@@ -320,15 +323,41 @@ It uses `subseq' with differences:
       (setf result (cons s result)))
     (apply #'concat result)))
 
+;;;the names here are misleading
+;;;replace in the clhs is destructive... these are not.
+(defun replace-first-character (old-char new-char string)
+  (substitute new-char old-char string :test #'char= :count 1))
+
+(define-compiler-macro replace-first (&whole form &rest args)
+  (declare (ignore form))
+  (destructuring-bind (old new string)
+      args 
+    (if (and (characterp old)
+             (characterp new))
+        `(replace-first-character ,old ,new ,string)
+        `(replace-first ,old ,new ,string))))
+        
 (defun replace-first (old new s)
-  "Replace the first occurence of `old` by `new` in `s`. Arguments are not regexs."
+  "Replace the first occurrence of `old` by `new` in `s`. Arguments are not regexs."
   (let* ((ppcre:*allow-quoting* t)
          (old (concatenate 'string "\\Q" old))) ;; treat metacharacters as normal.
     ;; We need the (list new): see !52
     (ppcre:regex-replace old s (list new))))
 
+(defun replace-all-character (old-char new-char string)
+  (substitute new-char old-char string :test #'char=))
+
+(define-compiler-macro replace-all (&whole form &rest args)
+  (declare (ignore form))
+  (destructuring-bind (old new string)
+      args 
+    (if (and (characterp old)
+             (characterp new))
+        `(replace-all-character ,old ,new ,string)
+        `(replace-all ,old ,new ,string))))
+
 (defun replace-all (old new s)
-  "Replace all occurences of `old` by `new` in `s`. Arguments are not regexs."
+  "Replace all occurrences of `old` by `new` in `s`. Arguments are not regexs."
   (let* ((ppcre:*allow-quoting* t)
          (old (concatenate 'string "\\Q" old))) ;; treat metacharacters as normal.
     (ppcre:regex-replace-all old s (list new))))
@@ -361,6 +390,11 @@ It uses `subseq' with differences:
     (setf s (str:replace-all (nth i plist) (nth (incf i) plist) s)))
   s)
 
+(setf (fdefinition 'substitute-all) #'replace-all
+      (fdefinition 'substitute-first) #'replace-first
+      (fdefinition 'substitute-using) #'replace-using)
+
+
 (defun emptyp (s)
   "Is s nil or the empty string ?"
   (or (null s) (string-equal "" s)))
diff --git a/test/test-str.lisp b/test/test-str.lisp
index 81cfe0a..84282f5 100644
--- a/test/test-str.lisp
+++ b/test/test-str.lisp
@@ -42,12 +42,14 @@
 (in-suite replace-functions)
 
 (test replace-first
-  (is (string= "fooaa" (replace-first "aa" "oo" "faaaa"))))
+  (is (string= "fooaa" (replace-first "aa" "oo" "faaaa")))
+  (is (string= "foo" (replace-first #\a #\o "fao"))))
 
 (test replace-all
   (is (string= "foo" (replace-all "a" "o" "faa")))
   (is (string= "foo" (replace-all "^a" "o" "fo^a")))
   (is (string= "foo" (replace-all "^aa+" "o" "fo^aa+")))
+  (is (string= "foo" (replace-all #\a #\o "faa")))
   (is (string= "foo'\\'bar" (replace-all "+" "'\\'" "foo+bar"))
       "Edge case with a double backslash and a single quote."))