From 94ae075f75040c0be6057f0cd502280d1a95cf99 Mon Sep 17 00:00:00 2001
From: Da Shen <da@liii.pro>
Date: Tue, 4 Nov 2025 18:52:16 +0800
Subject: [PATCH 1/7] wip

---
 goldfish/liii/rich-list.scm            |   2 +-
 tests/goldfish/liii/lang-test.scm      | 130 -------------------------
 tests/goldfish/liii/rich-list-test.scm |   5 +
 3 files changed, 6 insertions(+), 131 deletions(-)

diff --git a/goldfish/liii/rich-list.scm b/goldfish/liii/rich-list.scm
index 49611da2..2bb8dae3 100644
--- a/goldfish/liii/rich-list.scm
+++ b/goldfish/liii/rich-list.scm
@@ -27,7 +27,7 @@
   (begin
 
 
-    (define-case-class rich-list ((data list?))
+    (define-final-class rich-list ((data list?))
 
       (define (@range start end . step-and-args)
         (chain-apply (if (null? step-and-args) 
diff --git a/tests/goldfish/liii/lang-test.scm b/tests/goldfish/liii/lang-test.scm
index 9f9cdc8a..5214f28b 100644
--- a/tests/goldfish/liii/lang-test.scm
+++ b/tests/goldfish/liii/lang-test.scm
@@ -230,9 +230,6 @@
 (let1 result (rich-list :fill 1000 "x")
   (check (length (result :collect)) => 1000))
 
-(check ($ '(1 2 3) :apply 0) => 1)
-(check ($ '(1 2 3) 0) => 1)
-
 (let1 lst (rich-list '(1 2 3 4 5))
   (check ((lst :find (lambda (x) (= x 3))) :get) => 3)
   (check ((lst :find (lambda (x) (> x 2))) :get) => 3)
@@ -283,8 +280,6 @@
 (check-true ($ (list) :empty?))
 (check-false ($ '(1 2 3) :empty?))
 
-(check ($ (list ($ 1) ($ 2) ($ 3))) => (($ 1 :to 3) :map $))
-
 (let1 lst ($ '(1 2 3 4 5))
   (check (lst :forall (@ > _ 0)) => #t)
   (check (lst :forall (@ > _ 3)) => #f)
@@ -408,131 +403,6 @@
   (check (result :collect) 
     => (hash-table 3 '("cat" "dog") 5 '("apple") 6 '("banana"))))
 
-;; Single-argument sliding for rich-list
-(check ($ '() :sliding 2) => #())
-(check ($ '(1) :sliding 2) => #((1)))
-(check ($ '(1 2) :sliding 2) => #((1 2)))
-(check ($ '(1 2 3) :sliding 2) => #((1 2) (2 3)))
-(check ($ '(1 2 3 4 5) :sliding 3) => #((1 2 3) (2 3 4) (3 4 5)))
-(check ($ '(1 2 3 4 5) :sliding 1) => #((1) (2) (3) (4) (5)))
-(check ($ '(1 2 3) :sliding 3) => #((1 2 3)))
-(check ($ '(1 2 3) :sliding 4) => #((1 2 3)))
-
-;; Error cases for size (single-arg) for rich-list
-(check-catch 'value-error ($ '(1 2 3) :sliding 0))
-(check-catch 'value-error ($ '(1 2 3) :sliding -1))
-(check-catch 'type-error ($ '(1 2 3) :sliding 1.5))
-
-;; Two-argument sliding for rich-list
-(check ($ '() :sliding 2 2) => #())
-(check ($ '(1 2 3 4 5) :sliding 2 2) => #((1 2) (3 4) (5)))
-(check ($ '(1 2 3 4 5 6) :sliding 2 3) => #((1 2) (4 5)))
-(check ($ '(1 2 3 4 5) :sliding 3 1) => #((1 2 3) (2 3 4) (3 4 5) (4 5) (5)))
-(check ($ '(1 2 3 4) :sliding 2 2) => #((1 2) (3 4)))
-(check ($ '(1 2) :sliding 3 1) => #((1 2) (2)))
-(check ($ '(1 2 3 4 5) :sliding 3 2) => #((1 2 3) (3 4 5) (5)))
-(check ($ '(1 2 3 4 5 6 7) :sliding 3 3) => #((1 2 3) (4 5 6) (7)))
-(check ($ '(1 2 3 4 5) :sliding 5 1) => #((1 2 3 4 5) (2 3 4 5) (3 4 5) (4 5) (5)))
-(check ($ '(1 2 3 4 5) :sliding 6 1) => #((1 2 3 4 5) (2 3 4 5) (3 4 5) (4 5) (5)))
-
-
-;; Error cases for step (two-arg) for rich-list
-(check-catch 'value-error ($ '(1 2 3) :sliding 2 0))
-(check-catch 'value-error ($ '(1 2 3) :sliding 2 -1))
-(check-catch 'type-error ($ '(1 2 3) :sliding 2 1.5))
-
-(check (($ '(1 2 3)) :zip '(a b c) :collect) => '((1 . a) (2 . b) (3 . c)))
-(check (($ '(1 2 3)) :zip '(a b) :collect) => '((1 . a) (2 . b)))
-
-(check  ($ '(a b c) :zip-with-index :collect)  
-        => '((0 . a) (1 . b) (2 . c)))
-
-(check  ($ '() :zip-with-index :collect) 
-        => '())
-
-(check  ($ '(1 1 2 2 2 3 4 5 6 7) :zip-with-index :collect)
-        => '((0 . 1) (1 . 1) (2 . 2) (3 . 2) (4 . 2) (5 . 3) (6 . 4) (7 . 5) (8 . 6) (9 . 7)))
-
-(check  ($ '(a a b c b) :distinct :collect) 
-        => '(a b c))
-
-(check  ($ '(1 1 1 2 2 3 3 3 3 5 5 5) :distinct :collect) 
-        => '(1 2 3 5))
-
-(check  ($ '() :distinct :collect) 
-        => '())
-
-(check-catch 'value-error ($ '() :reduce +))
-
-(check ($ '(1 2 3) :reduce +) => 6)  
-(check ($ '(2 3 4) :reduce *) => 24)  
-(check ($ '(5) :reduce (lambda (x y) (+ x y 10))) => 5)
-
-(check ($ '() :reduce-option +) => (none))
-
-(check ($ '(1 2 3) :reduce-option +) => (option 6))  
-(check ($ '(2 3 4) :reduce-option *) => (option 24))  
-(check ($ '(5) :reduce-option (lambda (x y) (+ x y 10))) => (option 5))
-
-(check ($ '(1 2 3 4 5 6 7) :take-while (@ < _ 5) :collect) => '(1 2 3 4))
-(check ($ '() :take-while (@ < _ 5) :collect) => '())
-(check ($ '(1 2 3) :take-while number? :collect) => '(1 2 3))
-(check ($ '(5 1 2 3) :take-while (@ < _ 3) :collect) => '())
-
-(check ($ '(1 2 3 4 5 6 7) :drop-while (@ < _ 5) :collect) => '(5 6 7))
-(check ($ '() :drop-while (@ < _ 5) :collect) => '())
-(check ($ '(1 2 3) :drop-while number? :collect) => '())
-(check ($ '(5 1 2 3) :drop-while (@ < _ 3) :collect) => '(5 1 2 3))
-
-(let ((xs ($ '(1 2 3 4 5))))
-  (check (xs :index-where even?) => 1)
-  (check (xs :index-where (@ > _ 3)) => 3)
-  (check (xs :index-where (@ > _ 5)) => #f)
-  )
-
-(check ($ '(1 2 3) :max-by identity) => 3)
-(check ($ '((1) (3) (2)) :max-by car) => '(3))
-(check-catch 'value-error ($ '() :max-by identity))
-(check-catch 'type-error ($ '(1 2 3) :max-by "not-function"))
-(check-catch 'type-error ($ '("a" "b" "c") :max-by identity))
-
-(check ($ '(1 2 3) :min-by identity) => 1)
-(check ($ '((1) (3) (2)) :min-by car) => '(1))
-(check-catch 'value-error ($ '() :min-by identity))
-(check-catch 'type-error ($ '(1 2 3) :min-by "not-function"))
-(check-catch 'type-error ($ '("a" "b" "c") :min-by identity))
-
-(check (rich-list :empty :append (list 1 2)) => ($ (list 1 2)))
-(check ($ (list 1 2) :append (list )) => ($ (list 1 2)))
-(check ($ (list 1 2) :append (list 3 4)) => ($ (list 1 2 3 4)))
-
-(check ($ '() :max-by-option identity) => (none))
-
-(check ($ '() :min-by-option identity) => (none))
-
-(check (object->string ($ '(1 2 3))) => "(1 2 3)")
-
-(let1 l (rich-list (list 1 2 3))
-  (check (l :make-string) => "123")
-  (check (l :make-string " ") => "1 2 3")
-  (check (l :make-string "[" "," "]") => "[1,2,3]")
-  
-  (check-catch 'wrong-number-of-args (l :make-string "[" ","))
-  (check-catch 'type-error (l :make-string 123 "," "]"))
-  (check-catch 'type-error (l :make-string "[" 123 "]"))
-  (check-catch 'type-error (l :make-string "[" "," 123))
-  )
-
-(check ($ (list "a" "b") :make-string) => "ab")
-(check ($ (list "a" "b") :make-string " ") => "a b")
-
-(let ((lst (rich-list '(1 2 3))))
-  (check (lst :to-vector) =>  #(1 2 3)))
-
-(let ((lst (rich-list '(1 2 3))))
-  (check (lst :to-rich-vector) => (rich-vector #(1 2 3)))
-  (check ((lst :to-rich-vector) :collect) => #(1 2 3)))
-
 (check-true (rich-vector :is-type-of (rich-vector :empty)))
 (check-true (rich-vector :is-type-of (rich-vector #(1 2 3))))
 
diff --git a/tests/goldfish/liii/rich-list-test.scm b/tests/goldfish/liii/rich-list-test.scm
index e7933b0c..335b1435 100644
--- a/tests/goldfish/liii/rich-list-test.scm
+++ b/tests/goldfish/liii/rich-list-test.scm
@@ -2186,4 +2186,9 @@ step : integer (可选)
   (lst :sliding 2)
   (check (lst :collect) => '(1 2 3 4 5)))
 
+(check ($ '(1 2 3) :apply 0) => 1)
+(check ($ '(1 2 3) 0) => 1)
+
+(check ($ (list ($ 1) ($ 2) ($ 3))) => (($ 1 :to 3) :map $))
+
 (check-report)
-- 
Gitee


From 92271c105bf4c09c5c17d0f187779d557ee3fa51 Mon Sep 17 00:00:00 2001
From: Da Shen <da@liii.pro>
Date: Tue, 4 Nov 2025 18:53:28 +0800
Subject: [PATCH 2/7] wip

---
 tests/goldfish/liii/lang-test.scm | 187 ------------------------------
 1 file changed, 187 deletions(-)

diff --git a/tests/goldfish/liii/lang-test.scm b/tests/goldfish/liii/lang-test.scm
index 5214f28b..706b49ad 100644
--- a/tests/goldfish/liii/lang-test.scm
+++ b/tests/goldfish/liii/lang-test.scm
@@ -216,193 +216,6 @@
 (check-false ((right 43) :exists even?))
 (check-false ((right "not-a-number") :exists number?))
 
-(let1 result (rich-list :fill 3 "a")
-  (check (result :collect) => '("a" "a" "a")))
-
-(let1 result (rich-list :fill 0 "a")
-  (check (result :collect) => '()))
-
-(check-catch 'value-error (rich-list :fill -1 "a"))
-
-(let1 result (rich-list :fill 2 42)
-  (check (result :collect) => '(42 42)))
-
-(let1 result (rich-list :fill 1000 "x")
-  (check (length (result :collect)) => 1000))
-
-(let1 lst (rich-list '(1 2 3 4 5))
-  (check ((lst :find (lambda (x) (= x 3))) :get) => 3)
-  (check ((lst :find (lambda (x) (> x 2))) :get) => 3)
-  (check ((lst :find (lambda (x) (> x 10))) :empty?) => #t)
-  (check ((lst :find even?) :get) => 2)
-  (check ((lst :find (lambda (x) (< x 0))) :empty?) => #t))
-
-(let1 lst (rich-list '(1 2 3 4 5))
-  (check ((lst :find-last even?) :get) => 4)  ; 最后一个偶数是4
-  (check ((lst :find-last (@ > _ 3)) :get) => 5)  ; 最后一个大于3的元素是5
-  (check ((lst :find-last (@ > _ 5)) :empty?) => #t)  ; 没有大于5的元素
-  (check ((lst :find-last zero?) :empty?) => #t)  ; 没有0
-  (check ((rich-list '()) :find-last even?) => (none)))  ; 空列表返回none
-
-(check ($ (list 1 2 3) :head) => 1)
-(check-catch 'out-of-range (rich-list :empty :head))
-(check ($ (list 1 2 3) :head-option) => (option 1))
-(check (rich-list :empty :head-option) => (none))
-
-(check ($ (list 1 2 3) :last) => 3)
-(check-catch 'index-error (rich-list :empty :last))
-(check ($ (list 1 2 3) :last-option) => (option 3))
-(check (rich-list :empty :last-option) => (none))
-
-(let ((lst ($ '(1 2 3 4 5))))
-  ;; 基本切片
-  (check (lst :slice 1 3 :collect) => '(2 3))
-
-  ;; from超出范围
-  (check (lst :slice 10 3 :collect) => '())
-
-  ;; until超出范围
-  (check (lst :slice 2 10 :collect) => '(3 4 5))
-
-  ;; from > until
-  (check (lst :slice 3 1 :collect) => '())
-
-  ;; 负数索引
-  (check (lst :slice -1 3 :collect) => '(1 2 3))
-
-  ;; 链式调用
-  (check (lst :slice 1 4 :map (@ * _ 2) :collect) => '(4 6 8))
-
-  ;; 空切片
-  (check (lst :slice 2 2 :collect) => '())
-  )
-
-(check-true ($ (list) :empty?))
-(check-false ($ '(1 2 3) :empty?))
-
-(let1 lst ($ '(1 2 3 4 5))
-  (check (lst :forall (@ > _ 0)) => #t)
-  (check (lst :forall (@ > _ 3)) => #f)
-  )
-
-(check (rich-list :empty :forall (@ > _ 0)) => #t)
-
-(let1 l (rich-list '(1 2 3))
-  (check-true (l :exists even?)))
-
-(let1 l (rich-list '(1 2 3))
-  (check-true (l :contains 1))
-  (check-false (l :contains 4)))
-
-(let ((lst (rich-list '(1 2 3 4 5))))
-  (check (lst :reverse :collect) => '(5 4 3 2 1)))
-
-(let ((lst (rich-list '(a b c d e))))
-  (check (lst :reverse :collect) => '(e d c b a)))
-
-(let ((lst (rich-list '())))
-  (check (lst :reverse :collect) => '()))
-
-(let ((lst (rich-list '(1 2 3 4 5))))
-  (check (lst :take -1 :collect) => '())
-  (check (lst :take 0 :collect) => '())
-  (check (lst :take 3 :collect) => '(1 2 3))
-  (check (lst :take 5 :collect) => '(1 2 3 4 5))
-  (check (lst :take 10 :collect) => '(1 2 3 4 5))
-  )
-
-(let ((lst (rich-list '(1 2 3 4 5))))
-  (check (lst :drop -1 :collect) => '(1 2 3 4 5))
-  (check (lst :drop 0 :collect) => '(1 2 3 4 5))
-  (check (lst :drop 3 :collect) => '(4 5))
-  (check (lst :drop 5 :collect) => '())
-  (check (lst :drop 10 :collect) => '())
-  )
-
-(let ((lst (rich-list '(1 2 3 4 5))))
-  (check (lst :take-right -1 :collect) => '())
-  (check (lst :take-right 0 :collect) => '())
-  (check (lst :take-right 3 :collect) => '(3 4 5))
-  (check (lst :take-right 5 :collect) => '(1 2 3 4 5))
-  (check (lst :take-right 10 :collect) => '(1 2 3 4 5))
-  )
-
-(let ((lst (rich-list '(1 2 3 4 5))))
-  (check (lst :drop-right -1 :collect) => '(1 2 3 4 5))
-  (check (lst :drop-right 0 :collect) => '(1 2 3 4 5))
-  (check (lst :drop-right 3 :collect) => '(1 2))
-  (check (lst :drop-right 5 :collect) => '())
-  (check (lst :drop-right 10 :collect) => '())
-  )
-
-(check ((rich-list (list 1 2 3)) :count) => 3)
-(check ((rich-list (list 1 2 3)) :count (cut > <> 1)) => 2)
-
-(check ($ '() :length) => 0)
-(check ($ '(1) :length) => 1)
-(check ($ '(1 2) :length) => 2)
-(check ($ '(1 2 3) :length) => 3)
-(check ($ '(1 2 3 4 5) :length) => 5)
-(check ($ '(1 2 3 4 5 6 7 8 9 10) :length) => 10)
-
-(let ((lst (rich-list '(1 2 3 4 5))))
-  (check (lst :fold 0 +) => 15)
-  (check (lst :fold '() (lambda (x acc) (cons x acc))) => '(5 4 3 2 1))
-
-  (check (lst :fold-right 0 +) => 15)
-  (check (lst :fold-right '() (lambda (x acc) (cons x acc))) => '(1 2 3 4 5))
-  )
-
-(check ($ '(3 1 2 4 5)
-        :sort-with (lambda (x y) (< x y)))
-  => ($ '(1 2 3 4 5)))
-
-(check ($ (list 1 3 4 2 5) :sort-with < :take 2) => (list 1 2))
-
-(check 
-  ($ (list 1 3 4 2 5) 
-     :sort-with <
-     :take 2
-     :collect)
-  => '(1 2))
-
-(check 
-  ($ '((3 . a) (1 . b) (2 . c) (1 . d))
-     :sort-with (lambda (x y) (< (car x) (car y)))  ;; 按 car 排序
-     :collect)
-  => '((1 . b) (1 . d) (2 . c) (3 . a)))
-
-;; 测试按绝对值排序
-(check ($ '(-3 1 -2 4 0) :sort-by abs :collect) => '(0 1 -2 -3 4))
-  
-;; 测试按结构体字段排序
-(let ((people ($ '((name . "Alice") (name . "Bob") (name . "Charlie")))))
-  (check (people :sort-by (lambda (p) (string-length (cdr p))) :collect)
-         => '((name . "Bob") (name . "Alice") (name . "Charlie"))))
-  
-;; 测试空列表
-(check ($ '() :sort-by identity :collect) => '())
-  
-;; 测试链式调用
-(check ($ '(-3 1 -2 4 0) 
-         :sort-by abs 
-         :filter positive? 
-         :collect)
-       => '(1 4))
-
-(check  (($ '(1 2 3 4 5 6) :group-by (@ modulo _ 2)) :collect)
-        =>  (hash-table 0 '(2 4 6) 1 '(1 3 5)))
-
-(check  (($ '(1 2 3 4 5 6) :group-by (@ modulo _ 3)) :collect)
-        =>  (hash-table 0 '(3 6) 1 '(1 4) 2 '(2 5)))
-
-(check  (($ '(1 2 3 4 5 6 7) :group-by (@ modulo _ 3)) :collect)
-        =>  (hash-table 0 '(3 6) 1 '(1 4 7) 2 '(2 5)))
-
-(let ((result ($ '("apple" "banana" "cat" "dog") :group-by (@ string-length _))))
-  (check (result :collect) 
-    => (hash-table 3 '("cat" "dog") 5 '("apple") 6 '("banana"))))
-
 (check-true (rich-vector :is-type-of (rich-vector :empty)))
 (check-true (rich-vector :is-type-of (rich-vector #(1 2 3))))
 
-- 
Gitee


From a1167e2dea8b28b1bf4ce43d4da0fd32993acdee Mon Sep 17 00:00:00 2001
From: Da Shen <da@liii.pro>
Date: Tue, 4 Nov 2025 18:57:28 +0800
Subject: [PATCH 3/7] wip

---
 goldfish/liii/rich-list.scm | 3 ---
 1 file changed, 3 deletions(-)

diff --git a/goldfish/liii/rich-list.scm b/goldfish/liii/rich-list.scm
index 2bb8dae3..db97082e 100644
--- a/goldfish/liii/rich-list.scm
+++ b/goldfish/liii/rich-list.scm
@@ -71,9 +71,6 @@
 
       (define (%collect) data)
 
-      (define (%apply n)
-        (list-ref data n))
-
       (define (%find pred)
         (let loop ((lst data))
           (cond
-- 
Gitee


From 6f0baceacdf1b1e5c05abaab6bf3a7d6f3214b00 Mon Sep 17 00:00:00 2001
From: Da Shen <da@liii.pro>
Date: Tue, 4 Nov 2025 19:03:23 +0800
Subject: [PATCH 4/7] Revert "wip"

This reverts commit a1167e2dea8b28b1bf4ce43d4da0fd32993acdee.
---
 goldfish/liii/rich-list.scm | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/goldfish/liii/rich-list.scm b/goldfish/liii/rich-list.scm
index db97082e..2bb8dae3 100644
--- a/goldfish/liii/rich-list.scm
+++ b/goldfish/liii/rich-list.scm
@@ -71,6 +71,9 @@
 
       (define (%collect) data)
 
+      (define (%apply n)
+        (list-ref data n))
+
       (define (%find pred)
         (let loop ((lst data))
           (cond
-- 
Gitee


From 355376f2f8698d063dc6815dd8bed4971b33b8af Mon Sep 17 00:00:00 2001
From: Da Shen <da@liii.pro>
Date: Tue, 4 Nov 2025 19:05:43 +0800
Subject: [PATCH 5/7] wip

---
 goldfish/liii/oop.scm | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/goldfish/liii/oop.scm b/goldfish/liii/oop.scm
index 847c42e9..d4be055c 100644
--- a/goldfish/liii/oop.scm
+++ b/goldfish/liii/oop.scm
@@ -669,7 +669,7 @@
              (define (%apply . args)
                (cond ((null? args)
                       (value-error ,class-name "Apply on zero args is not implemented"))
-                     ((equal? ((symbol->string (car args)) 0) #\:)
+                     ((keyword? (car args))
                       (value-error ,class-name "No such method: " (car args)))
                      (else (value-error ,class-name "No such field: " (car args)))))
          
-- 
Gitee


From 6d70cb197844274c49db39b40e65dd0ba8e98831 Mon Sep 17 00:00:00 2001
From: Da Shen <da@liii.pro>
Date: Tue, 4 Nov 2025 19:26:57 +0800
Subject: [PATCH 6/7] wip

---
 goldfish/liii/oop.scm | 18 +++++++++++++++++-
 1 file changed, 17 insertions(+), 1 deletion(-)

diff --git a/goldfish/liii/oop.scm b/goldfish/liii/oop.scm
index d4be055c..f1873602 100644
--- a/goldfish/liii/oop.scm
+++ b/goldfish/liii/oop.scm
@@ -544,9 +544,22 @@
                                                                (if (= (length conflicts-names) 1) "" "s"))))))
          
              (instance-methods
-              (filter (lambda (method) (string-starts? (symbol->string (caadr method)) "%"))
+              (filter (lambda (method)
+                        (let ((method-name (symbol->string (caadr method))))
+                          (and (string-starts? method-name "%")
+                               (not (equal? method-name "%equals"))
+                               (not (equal? method-name "%apply")))))
                       methods))
              (instance-method-symbols (map caadr instance-methods))
+
+             ;; 筛选出 %equals 和 %apply 方法
+             (equals-methods
+              (filter (lambda (method) (equal? (symbol->string (caadr method)) "%equals"))
+                      methods))
+             (apply-methods
+              (filter (lambda (method) (equal? (symbol->string (caadr method)) "%apply"))
+                      methods))
+
              (instance-messages
               (map (lambda (method)
                      (let ((name (string-remove-prefix (symbol->string method) "%")))
@@ -673,12 +686,15 @@
                       (value-error ,class-name "No such method: " (car args)))
                      (else (value-error ,class-name "No such field: " (car args)))))
          
+             ,@equals-methods
+             ,@apply-methods
 
              (define (instance-dispatcher)
                (lambda (msg . args)
                  (cond
                    ((eq? msg :is-instance-of) (apply %is-instance-of args))
                    ((eq? msg :equals) (apply %equals args))
+                   ((eq? msg :apply) (apply %apply args))
                    ((eq? msg :to-string) (apply (,object-name :to-string ,@field-names)))
                    ,@(map (lambda (field key-field)
                             `((eq? msg ,key-field)
-- 
Gitee


From 0521ea2bc37c363895d9665d456e84c4d2df0018 Mon Sep 17 00:00:00 2001
From: Da Shen <da@liii.pro>
Date: Tue, 4 Nov 2025 19:46:45 +0800
Subject: [PATCH 7/7] wip

---
 bench/rich-list.scm | 67 ++++++++++++++++++++++++++++++++++-----------
 devel/202_4.md      | 13 +++++++++
 2 files changed, 64 insertions(+), 16 deletions(-)

diff --git a/bench/rich-list.scm b/bench/rich-list.scm
index 6ef81698..8f1aa7e5 100644
--- a/bench/rich-list.scm
+++ b/bench/rich-list.scm
@@ -14,19 +14,54 @@
 ; under the License.
 ;
 
-(import (liii rich-list))
-(import (scheme time))
-
-(define (timing msg thunk)
-  (let* ((start (current-jiffy))
-         (val (thunk))
-         (end (current-jiffy)))
-    (display* msg (number->string (- end start)) "\n")))
-
-(define (repeat n proc)
-  (when (>= n 0)
-        (proc)
-        (repeat (- n 1) proc)))
-
-(timing "rich-list%empty%length:\t"
-  (lambda () (repeat 10000 (lambda () (rich-list :empty :length)))))
+(import (liii timeit)
+        (liii rich-list)
+        (liii lang))
+
+(define (run-rich-list-benchmarks)
+  (display "=== Rich List 模块性能基准测试 ===\n\n")
+
+  ; 创建测试数据
+  (define test-list (rich-list :range 1 100))
+  (define small-list (rich-list :range 1 10))
+
+  ; 测试 rich-list%empty%length 性能
+  (let ((time (timeit (lambda () (rich-list :empty :length)) :number 10000)))
+    (display* "rich-list%empty%length: \t\t" (number->string time) " 秒\n"))
+
+  ; 测试 rich-list%map 性能
+  (let ((time (timeit (lambda () (test-list :map (lambda (x) (* x 2)))) :number 10000)))
+    (display* "rich-list%map: \t\t\t" (number->string time) " 秒\n"))
+
+  ; 测试 rich-list%take 性能
+  (let ((time (timeit (lambda () (test-list :take 50)) :number 10000)))
+    (display* "rich-list%take: \t\t\t" (number->string time) " 秒\n"))
+
+  ; 测试 rich-list%slice 性能
+  (let ((time (timeit (lambda () (test-list :slice 20 80)) :number 10000)))
+    (display* "rich-list%slice: \t\t\t" (number->string time) " 秒\n"))
+
+  ; 测试 rich-list%exists 性能
+  (let ((time (timeit (lambda () (test-list :exists (lambda (x) (> x 50)))) :number 10000)))
+    (display* "rich-list%exists: \t\t" (number->string time) " 秒\n"))
+
+  ; 测试 rich-list%reverse 性能
+  (let ((time (timeit (lambda () (test-list :reverse)) :number 10000)))
+    (display* "rich-list%reverse: \t\t" (number->string time) " 秒\n"))
+
+  ; 测试 rich-list%filter 性能
+  (let ((time (timeit (lambda () (test-list :filter even?)) :number 10000)))
+    (display* "rich-list%filter: \t\t" (number->string time) " 秒\n"))
+
+  ; 测试 rich-list%fold 性能
+  (let ((time (timeit (lambda () (test-list :fold 0 +)) :number 10000)))
+    (display* "rich-list%fold: \t\t\t" (number->string time) " 秒\n"))
+
+  ; 测试 rich-list%length 性能
+  (let ((time (timeit (lambda () (test-list :length)) :number 10000)))
+    (display* "rich-list%length: \t\t" (number->string time) " 秒\n"))
+
+  (display "\n=== 测试完成 ===\n"))
+
+; 运行基准测试
+(run-rich-list-benchmarks)
diff --git a/devel/202_4.md b/devel/202_4.md
index 8b5a8f3d..4f895f38 100644
--- a/devel/202_4.md
+++ b/devel/202_4.md
@@ -40,6 +40,19 @@
 | **比较方法** | | | | |
 | %equals 方法 | 1.6711 | 0.6679 | 1.0032 | 60.0% |
 
+## rich-list的性能评估
+| 操作                       | 使用 `define-final-class` | 使用 `define-case-class` | 差值（秒）                   | 性能变化百分比 | 更快的实现                |
+| ------------------------ | ----------------------- | ---------------------- | ----------------------- | ------- | -------------------- |
+| `rich-list%empty%length` | 0.058030128479003906 秒  | 0.12981200218200684 秒  | 0.07178187370300293 秒   | +123.7% | `define-final-class` |
+| `rich-list%map`          | 0.12200188636779785 秒   | 0.1729259490966797 秒   | 0.05092406272888185 秒   | +41.7%  | `define-final-class` |
+| `rich-list%take`         | 0.09894680976867676 秒   | 0.15306591987609863 秒  | 0.05411911010742187 秒   | +54.7%  | `define-final-class` |
+| `rich-list%slice`        | 0.12421488761901855 秒   | 0.18832921981811523 秒  | 0.06411433219909668 秒   | +51.6%  | `define-final-class` |
+| `rich-list%exists`       | 0.1015160083770752 秒    | 0.11061310768127441 秒  | 0.00909709930419921 秒   | +9.0%   | `define-case-class`  |
+| `rich-list%reverse`      | 0.06714797019958496 秒   | 0.1388568878173828 秒   | 0.07170891761779784 秒   | +106.8% | `define-final-class` |
+| `rich-list%filter`       | 0.35752105712890625 秒   | 0.46900510787963867 秒  | 0.11148405075073242 秒   | +31.2%  | `define-final-class` |
+| `rich-list%fold`         | 0.08075690269470215 秒   | 0.07579803466796875 秒  | -0.0049588680267334 秒   | -6.1%   | `define-case-class`  |
+| `rich-list%length`       | 0.011996984481811523 秒  | 0.01043701171875 秒     | -0.001559972763061523 秒 | -13.0%  | `define-case-class`  |
+
 ## 性能分析总结
 
 ### 性能提升显著的项目
-- 
Gitee