[0019] 优化 string-ref/cursor 性能，消除临时 bytevector 分配 (#785)

da-liii · web-flow · commit c7db56591269 · 2026-05-11T15:58:10.000+08:00
diff --git a/bench/string-cursor.scm b/bench/string-cursor.scm
@@ -0,0 +1,115 @@
+;; string-ref/cursor 性能基准测试
+;; 测试当前实现中 bytevector-copy + utf8->codepoint 的性能开销
+
+(import (liii timeit)
+        (liii string-cursor)
+        (scheme base)
+)
+
+;; 运行单次 benchmark
+(define (bench name stmt number)
+  (let ((elapsed (timeit stmt '() number)))
+    (display name)
+    (display ": ")
+    (display elapsed)
+    (display " 秒 (")
+    (display number)
+    (display " 次)\n")
+  )
+)
+
+;; 使用 string-ref/cursor 遍历字符串的所有字符
+(define (cursor-traverse str)
+  (let ((end (string-cursor-end str)))
+    (let loop ((cur (string-cursor-start str)))
+      (if (string-cursor=? cur end)
+        'done
+        (begin
+          (string-ref/cursor str cur)
+          (loop (string-cursor-next str cur))
+        )
+      )
+    )
+  )
+)
+
+;; 使用原生 string-ref 遍历字符串的所有字符
+(define (native-traverse str)
+  (let ((len (string-length str)))
+    (let loop ((i 0))
+      (if (= i len)
+        'done
+        (begin
+          (string-ref str i)
+          (loop (+ i 1))
+        )
+      )
+    )
+  )
+)
+
+;; 使用 string-fold 遍历（内部使用 string-ref/cursor）
+(define (fold-traverse str)
+  (string-fold (lambda (ch acc) (+ acc 1)) 0 str)
+)
+
+;; 使用 string-every 遍历（内部使用 string-ref/cursor）
+(define (every-traverse str)
+  (string-every char? str)
+)
+
+(define (run-benchmarks)
+  (display "=== string-ref/cursor 性能测试 ===\n\n")
+
+  ;; ASCII 短字符串（50 字符）
+  (let ((ascii-short (make-string 50 #\a)))
+    (display "--- ASCII 短字符串 (50 字符) ---\n")
+    (bench "  cursor 遍历   " (lambda () (cursor-traverse ascii-short)) 10000)
+    (bench "  native 遍历   " (lambda () (native-traverse ascii-short)) 10000)
+    (bench "  string-fold   " (lambda () (fold-traverse ascii-short)) 10000)
+    (bench "  string-every  " (lambda () (every-traverse ascii-short)) 10000)
+    (display "\n")
+  )
+
+  ;; ASCII 长字符串（500 字符）
+  (let ((ascii-long (make-string 500 #\a)))
+    (display "--- ASCII 长字符串 (500 字符) ---\n")
+    (bench "  cursor 遍历   " (lambda () (cursor-traverse ascii-long)) 1000)
+    (bench "  native 遍历   " (lambda () (native-traverse ascii-long)) 1000)
+    (bench "  string-fold   " (lambda () (fold-traverse ascii-long)) 1000)
+    (bench "  string-every  " (lambda () (every-traverse ascii-long)) 1000)
+    (display "\n")
+  )
+
+  ;; 混合 UTF-8 短字符串（20 个汉字，每个 3 字节）
+  (let ((utf8-short (string-tabulate (lambda (i) #\中) 20)))
+    (display "--- UTF-8 短字符串 (20 个汉字) ---\n")
+    (bench "  cursor 遍历   " (lambda () (cursor-traverse utf8-short)) 10000)
+    (bench "  native 遍历   " (lambda () (native-traverse utf8-short)) 10000)
+    (bench "  string-fold   " (lambda () (fold-traverse utf8-short)) 10000)
+    (bench "  string-every  " (lambda () (every-traverse utf8-short)) 10000)
+    (display "\n")
+  )
+
+  ;; 混合 UTF-8 长字符串（200 个汉字）
+  (let ((utf8-long (string-tabulate (lambda (i) #\中) 200)))
+    (display "--- UTF-8 长字符串 (200 个汉字) ---\n")
+    (bench "  cursor 遍历   " (lambda () (cursor-traverse utf8-long)) 1000)
+    (bench "  native 遍历   " (lambda () (native-traverse utf8-long)) 1000)
+    (bench "  string-fold   " (lambda () (fold-traverse utf8-long)) 1000)
+    (bench "  string-every  " (lambda () (every-traverse utf8-long)) 1000)
+    (display "\n")
+  )
+
+  ;; Emoji 短字符串（10 个 emoji，每个 4 字节）
+  (let ((emoji-short (string-tabulate (lambda (i) #\🚀) 10)))
+    (display "--- Emoji 短字符串 (10 个 emoji) ---\n")
+    (bench "  cursor 遍历   " (lambda () (cursor-traverse emoji-short)) 10000)
+    (bench "  native 遍历   " (lambda () (native-traverse emoji-short)) 10000)
+    (bench "  string-fold   " (lambda () (fold-traverse emoji-short)) 10000)
+    (bench "  string-every  " (lambda () (every-traverse emoji-short)) 10000)
+    (display "\n")
+  )
+)
+
+(run-benchmarks)
diff --git a/devel/0019.md b/devel/0019.md
@@ -0,0 +1,90 @@
+# [0019] 优化 string-ref/cursor 性能，消除临时 bytevector 分配
+
+## 任务相关的代码文件
+- `goldfish/liii/unicode.scm` — 新增 `utf8->codepoint-at`
+- `goldfish/liii/string-cursor.scm` — 使用 `utf8->codepoint-at` 替代 `bytevector-copy` + `utf8->codepoint`
+- `goldfish/scheme/char.scm` — 同上
+- `tests/liii/unicode/utf8-to-codepoint-at-test.scm` — 新增测试
+- `bench/string-cursor.scm` — 性能基准测试
+
+## 如何测试
+```bash
+# 1. 构建
+xmake b goldfish
+
+# 2. 运行新增测试
+bin/gf tests/liii/unicode/utf8-to-codepoint-at-test.scm
+
+# 3. 运行 string-cursor 全量测试
+bin/gf test tests/liii/string-cursor/
+
+# 4. 运行 benchmark
+bin/gf bench/string-cursor.scm
+```
+
+## 2026-05-11 优化 string-ref/cursor 临时对象分配
+
+### What
+1. 新增 `utf8->codepoint-at` 函数，支持直接从 bytevector 的指定偏移位置解码 UTF-8 字符，无需创建临时 bytevector。
+2. 修改 `string-ref/cursor`，使用 `utf8->codepoint-at` 替代 `(bytevector-copy bv start end)` + `(utf8->codepoint char-bv)`。
+3. 修改 `string-cursor.scm` 中另外 4 处字符比较代码（`string-prefix-length`、`string-suffix-length`、`string-prefix?` 内部辅助函数）。
+4. 修改 `scheme/char.scm` 中 `utf8-string-map` 的字符解码逻辑。
+5. 新增 `utf8->codepoint-at` 的完整单元测试。
+6. 添加 `bench/string-cursor.scm` 性能基准测试。
+
+### Why
+`string-ref/cursor` 是 `(liii string-cursor)` 模块最底层的字符读取操作，几乎所有基于 cursor 的字符串遍历函数（`string-fold`、`string-every`、`string-index` 等）都会反复调用它。
+
+原实现每次读取一个字符都要：
+1. 通过 `bytevector-copy` 分配一个 1~4 字节的临时 bytevector
+2. 通过 `utf8->codepoint` 解码这个临时对象
+
+当遍历一个包含 N 个字符的字符串时，就会产生 N 次临时 bytevector 分配。对于高频字符串操作，这造成了显著的 GC 压力和性能开销。
+
+### How
+核心思路是**消除临时 bytevector 分配**：
+
+新增 `utf8->codepoint-at bv start`，其解码逻辑与 `utf8->codepoint` 完全一致，但直接从 `bv` 的 `start` 位置开始读取字节，而不是先 `bytevector-copy` 到一个新 bytevector 再解码。
+
+修改后的 `string-ref/cursor`：
+```scheme
+;; 优化前
+(let* (...
+       (start (vector-ref pos idx))
+       (end (vector-ref pos (+ idx 1)))
+       (char-bv (bytevector-copy bv start end)))
+  (integer->char (utf8->codepoint char-bv)))
+
+;; 优化后
+(let* (...
+       (start (vector-ref pos idx)))
+  (integer->char (utf8->codepoint-at bv start)))
+```
+
+### 性能对比
+
+#### string-fold（遍历场景，benchmark 写法未变，对比最公平）
+
+| 测试场景 | 优化前 (秒) | 优化后 (秒) | 提升 |
+|---------|-----------|-----------|------|
+| ASCII 短字符串 (50 字符, 10000 次) | 2.94 | 2.41 | **18%** |
+| ASCII 长字符串 (500 字符, 1000 次) | 2.62 | 2.37 | **10%** |
+| UTF-8 短字符串 (20 汉字, 10000 次) | 1.73 | 1.58 | **9%** |
+| UTF-8 长字符串 (200 汉字, 1000 次) | 1.58 | 1.37 | **13%** |
+| Emoji 短字符串 (10 emoji, 10000 次) | 0.99 | 0.88 | **11%** |
+
+#### cursor 遍历（benchmark 已修正 string-cursor-end 位置）
+
+最初的 benchmark 发现 `cursor-traverse` 比 `native-traverse` 慢 **1000 倍以上**。经分析，发现除 `bytevector-copy` 外，另一个主要开销是 `cursor-traverse` 每次循环都调用 `string-cursor-end` 创建新 cursor 对象。
+
+修正 benchmark（将 `string-cursor-end` 移出循环）后：
+
+| 测试场景 | cursor 遍历 (秒) | native 遍历 (秒) | 差距 |
+|---------|----------------|----------------|------|
+| ASCII 短字符串 (50 字符, 10000 次) | 1.84 | 0.021 | ~87x |
+| ASCII 长字符串 (500 字符, 1000 次) | 1.71 | 0.017 | ~100x |
+| UTF-8 短字符串 (20 汉字, 10000 次) | 1.09 | 0.019 | ~57x |
+| UTF-8 长字符串 (200 汉字, 1000 次) | 1.00 | 0.021 | ~48x |
+| Emoji 短字符串 (10 emoji, 10000 次) | 0.63 | 0.015 | ~42x |
+
+**说明**：修正 benchmark 后，cursor 遍历与 native 遍历仍有数十倍差距，这主要是由 cursor 抽象层（record 访问、vector 索引、cursor 对象创建等）带来的固有开销，而非 `bytevector-copy` 单一因素。`utf8->codepoint-at` 的优化将 `string-fold` 等上层遍历函数提升了 **10~18%**，并彻底消除了每次字符访问的临时对象分配。
diff --git a/goldfish/liii/string-cursor.scm b/goldfish/liii/string-cursor.scm
@@ -307,10 +307,8 @@
                 ) ;when
              ) ;_
              (start (vector-ref pos idx))
-             (end (vector-ref pos (+ idx 1)))
-             (char-bv (bytevector-copy bv start end))
             ) ;
-        (integer->char (utf8->codepoint char-bv))
+        (integer->char (utf8->codepoint-at bv start))
       ) ;let*
     ) ;define
 
@@ -738,11 +736,9 @@
           (if (or (>= i end1-idx) (>= j end2-idx))
             count
             (let* ((b1-start (vector-ref pos1 i))
-                   (b1-end (vector-ref pos1 (+ i 1)))
-                   (ch1 (integer->char (utf8->codepoint (bytevector-copy bv1 b1-start b1-end))))
+                   (ch1 (integer->char (utf8->codepoint-at bv1 b1-start)))
                    (b2-start (vector-ref pos2 j))
-                   (b2-end (vector-ref pos2 (+ j 1)))
-                   (ch2 (integer->char (utf8->codepoint (bytevector-copy bv2 b2-start b2-end))))
+                   (ch2 (integer->char (utf8->codepoint-at bv2 b2-start)))
                   ) ;
               (if (char=? ch1 ch2) (loop (+ i 1) (+ j 1) (+ count 1)) count)
             ) ;let*
@@ -781,11 +777,9 @@
           (if (or (< i start1-idx) (< j start2-idx))
             count
             (let* ((b1-start (vector-ref pos1 i))
-                   (b1-end (vector-ref pos1 (+ i 1)))
-                   (ch1 (integer->char (utf8->codepoint (bytevector-copy bv1 b1-start b1-end))))
+                   (ch1 (integer->char (utf8->codepoint-at bv1 b1-start)))
                    (b2-start (vector-ref pos2 j))
-                   (b2-end (vector-ref pos2 (+ j 1)))
-                   (ch2 (integer->char (utf8->codepoint (bytevector-copy bv2 b2-start b2-end))))
+                   (ch2 (integer->char (utf8->codepoint-at bv2 b2-start)))
                   ) ;
               (if (char=? ch1 ch2) (loop (- i 1) (- j 1) (+ count 1)) count)
             ) ;let*
@@ -858,11 +852,9 @@
         (if (>= j s2-end)
           #t
           (let* ((b1-start (vector-ref pos1 i))
-                 (b1-end (vector-ref pos1 (+ i 1)))
-                 (ch1 (integer->char (utf8->codepoint (bytevector-copy bv1 b1-start b1-end))))
+                 (ch1 (integer->char (utf8->codepoint-at bv1 b1-start)))
                  (b2-start (vector-ref pos2 j))
-                 (b2-end (vector-ref pos2 (+ j 1)))
-                 (ch2 (integer->char (utf8->codepoint (bytevector-copy bv2 b2-start b2-end))))
+                 (ch2 (integer->char (utf8->codepoint-at bv2 b2-start)))
                 ) ;
             (if (char=? ch1 ch2) (loop (+ i 1) (+ j 1)) #f)
           ) ;let*
diff --git a/goldfish/liii/unicode.scm b/goldfish/liii/unicode.scm
@@ -10,6 +10,7 @@
     bytevector-advance-utf8
     codepoint->utf8
     utf8->codepoint
+    utf8->codepoint-at
     utf8-string-trim-right
     utf8-string-trim-left
     utf8-string-trim-both
@@ -362,6 +363,94 @@
       ) ;let
     ) ;define
 
+    (define (utf8->codepoint-at bv start)
+      (unless (bytevector? bv)
+        (error 'type-error "utf8->codepoint-at: expected bytevector")
+      ) ;unless
+
+      (let ((len (bytevector-length bv)))
+        (when (>= start len)
+          (error 'value-error "utf8->codepoint-at: start index past end of bytevector")
+        ) ;when
+
+        (let ((first-byte (bytevector-u8-ref bv start)))
+          (cond ((<= first-byte 127) first-byte)
+
+                ((<= 194 first-byte 223)
+                 (when (> (+ start 2) len)
+                   (error 'value-error "utf8->codepoint-at: incomplete 2-byte sequence")
+                 ) ;when
+                 (let ((byte2 (bytevector-u8-ref bv (+ start 1))))
+                   (unless (<= 128 byte2 191)
+                     (error 'value-error "utf8->codepoint-at: invalid continuation byte")
+                   ) ;unless
+                   (bitwise-ior (ash (bitwise-and first-byte 31) 6) (bitwise-and byte2 63))
+                 ) ;let
+                ) ;
+
+                ((<= 224 first-byte 239)
+                 (when (> (+ start 3) len)
+                   (error 'value-error "utf8->codepoint-at: incomplete 3-byte sequence")
+                 ) ;when
+                 (let ((byte2 (bytevector-u8-ref bv (+ start 1)))
+                       (byte3 (bytevector-u8-ref bv (+ start 2)))
+                      ) ;
+                   (unless (and (<= 128 byte2 191) (<= 128 byte3 191))
+                     (error 'value-error "utf8->codepoint-at: invalid continuation byte")
+                   ) ;unless
+                   (let ((codepoint (bitwise-ior (ash (bitwise-and first-byte 15) 12)
+                                      (ash (bitwise-and byte2 63) 6)
+                                      (bitwise-and byte3 63)
+                                    ) ;bitwise-ior
+                         ) ;codepoint
+                        ) ;
+                     (when (or (<= 55296 codepoint 57343)
+                             (and (= first-byte 224) (< codepoint 2048))
+                             (and (= first-byte 237) (>= codepoint 55296))
+                           ) ;or
+                       (error 'value-error "utf8->codepoint-at: invalid codepoint")
+                     ) ;when
+                     codepoint
+                   ) ;let
+                 ) ;let
+                ) ;
+
+                ((<= 240 first-byte 244)
+                 (when (> (+ start 4) len)
+                   (error 'value-error "utf8->codepoint-at: incomplete 4-byte sequence")
+                 ) ;when
+                 (let ((byte2 (bytevector-u8-ref bv (+ start 1)))
+                       (byte3 (bytevector-u8-ref bv (+ start 2)))
+                       (byte4 (bytevector-u8-ref bv (+ start 3)))
+                      ) ;
+                   (unless (and (<= 128 byte2 191) (<= 128 byte3 191) (<= 128 byte4 191))
+                     (error 'value-error "utf8->codepoint-at: invalid continuation byte")
+                   ) ;unless
+                   (let ((codepoint (bitwise-ior (ash (bitwise-and first-byte 7) 18)
+                                      (ash (bitwise-and byte2 63) 12)
+                                      (ash (bitwise-and byte3 63) 6)
+                                      (bitwise-and byte4 63)
+                                    ) ;bitwise-ior
+                         ) ;codepoint
+                        ) ;
+                     (when (or (< codepoint 65536)
+                             (> codepoint 1114111)
+                             (and (= first-byte 240) (< codepoint 65536))
+                             (and (= first-byte 244) (> codepoint 1114111))
+                           ) ;or
+                       (error 'value-error "utf8->codepoint-at: invalid codepoint")
+                     ) ;when
+                     codepoint
+                   ) ;let
+                 ) ;let
+                ) ;
+
+                (else (error 'value-error "utf8->codepoint-at: invalid UTF-8 sequence"))
+          ) ;cond
+        ) ;let
+      ) ;let
+    ) ;define
+
     (define unicode-max-codepoint 1114111)
     (define unicode-replacement-char 65533)
 
diff --git a/goldfish/scheme/char.scm b/goldfish/scheme/char.scm
@@ -5855,8 +5855,7 @@
           (if (>= pos len)
             (apply utf8-string (reverse result))
             (let* ((next (bytevector-advance-utf8 bv pos len))
-                   (char-bv (bytevector-copy bv pos next))
-                   (ch (integer->char (utf8->codepoint char-bv)))
+                   (ch (integer->char (utf8->codepoint-at bv pos)))
                    (new-ch (proc ch))
                   ) ;
               (loop next (cons new-ch result))
diff --git a/tests/liii/unicode/utf8-to-codepoint-at-test.scm b/tests/liii/unicode/utf8-to-codepoint-at-test.scm
