!289 Re-implement string-trim, string-trim-both, string-trim-right in…

… (liii base)

GoldfishScheme.tmu

@@ -1,4 +1,4 @@
-<TMU|<tuple|1.1.0|2025.0.4>>
+<TMU|<tuple|1.1.0|2025.0.5>>
 
 <style|<tuple|book|chinese|literate|goldfish|reduced-margins|guile|smart-ref|preview-ref|python|elvish>>
 
@@ -10822,85 +10822,63 @@
   <scm|string-trim>是一个函数，用于去除字符串左端的空白字符。空白字符通常包括空格、制表符、换行符等。当原字符串只包含空白字符，返回空字符串。
 
   <\scm-chunk|goldfish/srfi/srfi-13.scm|true|true>
-    (define (%trim-do str string-trim-sub criterion+start+end)
+    (define (string-trim str . opt)
 
-    \ \ (cond ((null-list? criterion+start+end)
+    \ \ (let ((predicate (cond
 
-    \ \ \ \ \ \ \ \ \ (string-trim-sub str #\\ ))
+    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ((null? opt) char-whitespace?)
 
-    \ \ \ \ \ \ \ \ ((list? criterion+start+end)
+    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ((char? (car opt)) (lambda (c) (char=? c (car opt))))
 
-    \ \ \ \ \ \ \ \ \ (if (char? (car criterion+start+end))
+    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ((procedure? (car opt)) (car opt))
 
-    \ \ \ \ \ \ \ \ \ \ \ \ \ (string-trim-sub
+    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (else (type-error "Invalid second argument: expected character or predicate" (car opt))))))
 
-    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (%string-from-range str (cdr criterion+start+end))
+    \ \ \ \ (let* ((start (if (and (\<gtr\> (length opt) 1) (number? (cadr opt))) (cadr opt) 0))
 
-    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (car criterion+start+end))
+    \ \ \ \ \ \ \ \ \ \ \ (end (if (and (\<gtr\> (length opt) 2) (number? (caddr opt))) (caddr opt) (string-length str)))
 
-    \ \ \ \ \ \ \ \ \ \ \ \ \ (string-trim-sub
+    \ \ \ \ \ \ \ \ \ \ \ (str (substring str start end)))
 
-    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (%string-from-range str criterion+start+end)
+    \ \ \ \ \ \ (let loop ((i 0)
 
-    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ #\\ )))
+    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (len (string-length str)))
 
-    \ \ \ \ \ \ \ \ (else (error 'wrong-type-arg "string-trim"))))
+    \ \ \ \ \ \ \ \ (if (or (\<gtr\>= i len) (not (predicate (string-ref str i))))
 
-    \;
-
-    (define (string-trim str . criterion+start+end)
-
-    \ \ (define (string-trim-sub str space-or-char)
-
-    \ \ \ \ (let loop ((i 0)
-
-    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (len (string-length str)))
+    \ \ \ \ \ \ \ \ \ \ \ \ (substring str i len)
 
-    \ \ \ \ \ \ \ \ \ (if (or (= i len) (not (char=? space-or-char (string-ref str i))))
-
-    \ \ \ \ \ \ \ \ \ \ \ \ \ (substring str i len)
-
-    \ \ \ \ \ \ \ \ \ \ \ \ \ (loop (+ i 1) len))))
-
-    \ \ (%trim-do str string-trim-sub criterion+start+end))
+    \ \ \ \ \ \ \ \ \ \ \ \ (loop (+ i 1) len))))))
 
     \;
   </scm-chunk>
 
   <\scm-chunk|tests/goldfish/liii/string-test.scm|true|true>
-    (check (string-trim " \ 2 4 \ ") =\<gtr\> "2 4 \ ")
-
-    (check (string-trim " \ 2 4 \ " 2) =\<gtr\> "2 4 \ ")
-
-    (check (string-trim " \ 2 4 \ " 3) =\<gtr\> "4 \ ")
-
-    (check (string-trim " \ 2 4 \ " 4) =\<gtr\> "4 \ ")
+    (check (string-trim " \ hello \ ") =\<gtr\> "hello \ ")
 
-    (check (string-trim " \ 2 4 \ " 5) =\<gtr\> "")
+    (check (string-trim "---hello---" #\\-) =\<gtr\> "hello---")
 
-    \;
-
-    (check-catch 'out-of-range (string-trim " \ 2 4 \ " 8))
+    (check (string-trim "123hello123" char-numeric?) =\<gtr\> "hello123")
 
-    \;
+    (check (string-trim " \ \ ") =\<gtr\> "")
 
-    (check (string-trim " \ 2 4 \ " 0 4) =\<gtr\> "2 ")
+    (check (string-trim "") =\<gtr\> "")
 
-    (check (string-trim " \ 2 4 \ " 0 7) =\<gtr\> "2 4 \ ")
+    (check (string-trim "hello" #\\-) =\<gtr\> "hello")
 
-    \;
+    (check (string-trim "abcABC123" char-upper-case?) =\<gtr\> "abcABC123")
 
-    (check-catch 'out-of-range (string-trim " \ 2 4 \ " 0 8))
+    (check (string-trim " \ hello \ " #\\space 2 7) =\<gtr\> "hello")
 
-    \;
+    (check (string-trim " \ \ hello \ \ " #\\space 3) =\<gtr\> "hello \ \ ")
 
-    (check (string-trim " \ 2 4 \ " #\\ ) =\<gtr\> "2 4 \ ")
+    (check (string-trim " \ \ hello \ \ " #\\space 3 8) =\<gtr\> "hello")
 
-    (check (string-trim "-- 2 4 --" #\\-) =\<gtr\> " 2 4 --")
+    (check (string-trim "---hello---" #\\- 3 8) =\<gtr\> "hello")
 
-    (check (string-trim " - 345" #\\- 1) =\<gtr\> " 345")
+    (check (string-trim "123hello123" char-numeric? 3 8) =\<gtr\> "hello")
 
-    (check (string-trim " - 345" #\\- 1 4) =\<gtr\> " 3")
+    (check (string-trim "123hello123" char-numeric? 3) =\<gtr\> "hello123")
 
     \;
   </scm-chunk>
@@ -10910,101 +10888,133 @@
   <scm|string-trim-right>是一个函数，用于去除字符串右端的空白字符。当原字符串只包含空白字符，返回空字符串。
 
   <\scm-chunk|goldfish/srfi/srfi-13.scm|true|true>
-    (define (string-trim-right str . criterion+start+end)
-
-    \ \ (define (string-trim-right-sub str space-or-char)
+    (define (string-trim-right str . opt)
 
-    \ \ \ \ (let loop ((i (- (string-length str) 1)))
+    \ \ (let ((predicate (cond
 
-    \ \ \ \ \ \ (cond ((negative? i) "")
+    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ((null? opt) char-whitespace?)
 
-    \ \ \ \ \ \ \ \ \ \ \ \ ((char=? space-or-char (string-ref str i)) (loop (- i 1)))
+    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ((char? (car opt)) (lambda (c) (char=? c (car opt))))
 
-    \ \ \ \ \ \ \ \ \ \ \ \ (else (substring str 0 (+ i 1))))))
+    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ((procedure? (car opt)) (car opt))
 
-    \ \ (%trim-do str string-trim-right-sub criterion+start+end))
+    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (else (type-error "Invalid second argument: expected character or predicate" (car opt))))))
 
-    \;
-  </scm-chunk>
+    \ \ \ \ (let* ((start (if (and (\<gtr\> (length opt) 1) (number? (cadr opt))) (cadr opt) 0))
 
-  <\scm-chunk|tests/goldfish/liii/string-test.scm|true|true>
-    (check (string-trim-right " \ 2 4 \ ") =\<gtr\> " \ 2 4")
+    \ \ \ \ \ \ \ \ \ \ \ (end (if (and (\<gtr\> (length opt) 2) (number? (caddr opt))) (caddr opt) (string-length str)))
 
-    (check (string-trim-right " \ 2 4 \ " 1) =\<gtr\> " 2 4")
+    \ \ \ \ \ \ \ \ \ \ \ (str (substring str start end)))
 
-    (check (string-trim-right " \ 2 4 \ " 2) =\<gtr\> "2 4")
+    \ \ \ \ \ \ (let loop ((j (- (string-length str) 1)))
 
-    (check (string-trim-right " \ 2 4 \ " 3) =\<gtr\> " 4")
+    \ \ \ \ \ \ \ \ (if (or (\<less\> j 0) (not (predicate (string-ref str j))))
 
-    (check (string-trim-right " \ 2 4 \ " 4) =\<gtr\> "4")
+    \ \ \ \ \ \ \ \ \ \ \ \ (substring str 0 (+ j 1))
 
-    (check (string-trim-right " \ 2 4 \ " 5) =\<gtr\> "")
+    \ \ \ \ \ \ \ \ \ \ \ \ (loop (- j 1)))))))
 
-    (check (string-trim-right " \ 2 4 \ " 6) =\<gtr\> "")
+    \;
+  </scm-chunk>
 
-    (check (string-trim-right " \ 2 4 \ " 7) =\<gtr\> "")
+  <\scm-chunk|tests/goldfish/liii/string-test.scm|true|true>
+    (check (string-trim-right " \ hello \ ") =\<gtr\> " \ hello")
 
-    \;
+    (check (string-trim-right "---hello---" #\\-) =\<gtr\> "---hello")
 
-    (check-catch 'out-of-range (string-trim-right " \ 2 4 \ " 8))
+    (check (string-trim-right "123hello123" char-numeric?) =\<gtr\> "123hello")
 
-    \;
+    (check (string-trim-right " \ \ ") =\<gtr\> "")
 
-    (check (string-trim-right " \ 2 4 \ " 0 4) =\<gtr\> " \ 2")
+    (check (string-trim-right "") =\<gtr\> "")
 
-    (check (string-trim-right " \ 2 4 \ " 0 7) =\<gtr\> " \ 2 4")
+    (check (string-trim-right "hello" #\\-) =\<gtr\> "hello")
 
-    \;
+    (check (string-trim-right "abcABC123" char-upper-case?) =\<gtr\> "abcABC123")
 
-    (check-catch 'out-of-range (string-trim-right " \ 2 4 \ " 0 8))
+    (check (string-trim-right " \ hello \ " #\\space 2 7) =\<gtr\> "hello")
 
-    \;
+    (check (string-trim-right " \ \ hello \ \ " #\\space 3) =\<gtr\> "hello")
 
-    (check (string-trim-right " \ 2 4 \ " #\\ ) =\<gtr\> " \ 2 4")
+    (check (string-trim-right " \ \ hello \ \ " #\\space 3 8) =\<gtr\> "hello")
 
-    (check (string-trim-right "-- 2 4 --" #\\-) =\<gtr\> "-- 2 4 ")
+    (check (string-trim-right "---hello---" #\\- 3 8) =\<gtr\> "hello")
 
-    (check (string-trim-right "012-" #\\- 1) =\<gtr\> "12")
+    (check (string-trim-right "123hello123" char-numeric? 3 8) =\<gtr\> "hello")
 
-    (check (string-trim-right "012-4" #\\- 0 4) =\<gtr\> "012")
+    (check (string-trim-right "123hello123" char-numeric? 3) =\<gtr\> "hello")
 
     \;
   </scm-chunk>
 
   <paragraph|string-trim-both><index|string-trim-both>
 
-  <scm|string-trim-both>是一个函数，用于去除字符串两端的空白字符。当原字符串只包含空白字符，报错。
+  <scm|string-trim-both>是一个函数，用于去除字符串两端的空白字符。
 
   <\scm-chunk|goldfish/srfi/srfi-13.scm|true|true>
-    (define (string-trim-both str . criterion+start+end)
+    (define (string-trim-both str . opt)
 
-    \ \ (define (string-trim-both-sub str space-or-char)
+    \ \ (let ((predicate (cond
 
-    \ \ \ \ (let loop ((i 0)
+    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ((null? opt) char-whitespace?)
+
+    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ((char? (car opt)) (lambda (c) (char=? c (car opt))))
+
+    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ((procedure? (car opt)) (car opt))
+
+    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (else (type-error "Invalid second argument: expected character or predicate" (car opt))))))
+
+    \ \ \ \ (let* ((start (if (and (\<gtr\> (length opt) 1) (number? (cadr opt))) (cadr opt) 0))
+
+    \ \ \ \ \ \ \ \ \ \ \ (end (if (and (\<gtr\> (length opt) 2) (number? (caddr opt))) (caddr opt) (string-length str)))
+
+    \ \ \ \ \ \ \ \ \ \ \ (str (substring str start end)))
 
-    \ \ \ \ \ \ \ \ \ \ \ \ \ (len (string-length str)))
+    \ \ \ \ \ \ (let loop-left ((i 0)
 
-    \ \ \ \ (if (or (= i len) (not (char=? space-or-char (string-ref str i))))
+    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (len (string-length str)))
 
-    \ \ \ \ \ \ \ \ (let loop-end ((j (- len 1)))
+    \ \ \ \ \ \ \ \ (if (or (\<gtr\>= i len) (not (predicate (string-ref str i))))
 
-    \ \ \ \ \ \ \ \ \ \ (if (or (\<less\> j 0) (not (char=? space-or-char (string-ref str j))))
+    \ \ \ \ \ \ \ \ \ \ \ \ (let loop-right ((j (- len 1)))
 
-    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (substring str i (+ j 1))
+    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (or (\<less\> j i) (not (predicate (string-ref str j))))
 
-    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (loop-end (- j 1))))
+    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (substring str i (+ j 1))
 
-    \ \ \ \ \ \ \ \ (loop (+ i 1) len))))
+    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (loop-right (- j 1))))
 
-    \ \ (%trim-do str string-trim-both-sub criterion+start+end))
+    \ \ \ \ \ \ \ \ \ \ \ \ (loop-left (+ i 1) len))))))
 
     \;
   </scm-chunk>
 
   <\scm-chunk|tests/goldfish/liii/string-test.scm|true|true>
-    (check (string-trim-both " \ 2 4 \ ") =\<gtr\> "2 4")
+    (check (string-trim-both " \ hello \ ") =\<gtr\> "hello")
+
+    (check (string-trim-both "---hello---" #\\-) =\<gtr\> "hello")
+
+    (check (string-trim-both "123hello123" char-numeric?) =\<gtr\> "hello")
+
+    (check (string-trim-both " \ \ ") =\<gtr\> "")
+
+    (check (string-trim-both "") =\<gtr\> "")
+
+    (check (string-trim-both "hello" #\\-) =\<gtr\> "hello")
+
+    (check (string-trim-both "abcABC123" char-upper-case?) =\<gtr\> "abcABC123")
+
+    (check (string-trim-both " \ hello \ " #\\space 2 7) =\<gtr\> "hello")
+
+    (check (string-trim-both " \ \ hello \ \ " #\\space 3) =\<gtr\> "hello")
+
+    (check (string-trim-both " \ \ hello \ \ " #\\space 3 8) =\<gtr\> "hello")
+
+    (check (string-trim-both "---hello---" #\\- 3 8) =\<gtr\> "hello")
+
+    (check (string-trim-both "123hello123" char-numeric? 3 8) =\<gtr\> "hello")
 
-    (check (string-trim-both "--2 4--" #\\-) =\<gtr\> "2 4")
+    (check (string-trim-both "123hello123" char-numeric? 3) =\<gtr\> "hello")
 
     \;
   </scm-chunk>

goldfish/srfi/srfi-13.scm

@@ -173,47 +173,52 @@
            (car char+start+end)))
         (else (error 'wrong-type-arg "string-pad"))))
 
-(define (%trim-do str string-trim-sub criterion+start+end)
-  (cond ((null-list? criterion+start+end)
-         (string-trim-sub str #\ ))
-        ((list? criterion+start+end)
-         (if (char? (car criterion+start+end))
-             (string-trim-sub
-               (%string-from-range str (cdr criterion+start+end))
-               (car criterion+start+end))
-             (string-trim-sub
-               (%string-from-range str criterion+start+end)
-               #\ )))
-        (else (error 'wrong-type-arg "string-trim"))))
-
-(define (string-trim str . criterion+start+end)
-  (define (string-trim-sub str space-or-char)
-    (let loop ((i 0)
-               (len (string-length str)))
-         (if (or (= i len) (not (char=? space-or-char (string-ref str i))))
-             (substring str i len)
-             (loop (+ i 1) len))))
-  (%trim-do str string-trim-sub criterion+start+end))
-
-(define (string-trim-right str . criterion+start+end)
-  (define (string-trim-right-sub str space-or-char)
-    (let loop ((i (- (string-length str) 1)))
-      (cond ((negative? i) "")
-            ((char=? space-or-char (string-ref str i)) (loop (- i 1)))
-            (else (substring str 0 (+ i 1))))))
-  (%trim-do str string-trim-right-sub criterion+start+end))
-
-(define (string-trim-both str . criterion+start+end)
-  (define (string-trim-both-sub str space-or-char)
-    (let loop ((i 0)
-             (len (string-length str)))
-    (if (or (= i len) (not (char=? space-or-char (string-ref str i))))
-        (let loop-end ((j (- len 1)))
-          (if (or (< j 0) (not (char=? space-or-char (string-ref str j))))
-              (substring str i (+ j 1))
-              (loop-end (- j 1))))
-        (loop (+ i 1) len))))
-  (%trim-do str string-trim-both-sub criterion+start+end))
+(define (string-trim str . opt)
+  (let ((predicate (cond
+                    ((null? opt) char-whitespace?)
+                    ((char? (car opt)) (lambda (c) (char=? c (car opt))))
+                    ((procedure? (car opt)) (car opt))
+                    (else (type-error "Invalid second argument: expected character or predicate" (car opt))))))
+    (let* ((start (if (and (> (length opt) 1) (number? (cadr opt))) (cadr opt) 0))
+           (end (if (and (> (length opt) 2) (number? (caddr opt))) (caddr opt) (string-length str)))
+           (str (substring str start end)))
+      (let loop ((i 0)
+                 (len (string-length str)))
+        (if (or (>= i len) (not (predicate (string-ref str i))))
+            (substring str i len)
+            (loop (+ i 1) len))))))
+
+(define (string-trim-right str . opt)
+  (let ((predicate (cond
+                    ((null? opt) char-whitespace?)
+                    ((char? (car opt)) (lambda (c) (char=? c (car opt))))
+                    ((procedure? (car opt)) (car opt))
+                    (else (type-error "Invalid second argument: expected character or predicate" (car opt))))))
+    (let* ((start (if (and (> (length opt) 1) (number? (cadr opt))) (cadr opt) 0))
+           (end (if (and (> (length opt) 2) (number? (caddr opt))) (caddr opt) (string-length str)))
+           (str (substring str start end)))
+      (let loop ((j (- (string-length str) 1)))
+        (if (or (< j 0) (not (predicate (string-ref str j))))
+            (substring str 0 (+ j 1))
+            (loop (- j 1)))))))
+
+(define (string-trim-both str . opt)
+  (let ((predicate (cond
+                    ((null? opt) char-whitespace?)
+                    ((char? (car opt)) (lambda (c) (char=? c (car opt))))
+                    ((procedure? (car opt)) (car opt))
+                    (else (type-error "Invalid second argument: expected character or predicate" (car opt))))))
+    (let* ((start (if (and (> (length opt) 1) (number? (cadr opt))) (cadr opt) 0))
+           (end (if (and (> (length opt) 2) (number? (caddr opt))) (caddr opt) (string-length str)))
+           (str (substring str start end)))
+      (let loop-left ((i 0)
+                      (len (string-length str)))
+        (if (or (>= i len) (not (predicate (string-ref str i))))
+            (let loop-right ((j (- len 1)))
+              (if (or (< j i) (not (predicate (string-ref str j))))
+                  (substring str i (+ j 1))
+                  (loop-right (- j 1))))
+            (loop-left (+ i 1) len))))))
 
 (define (string-prefix? prefix str)
   (let* ((prefix-len (string-length prefix))