From d92104f3941917479c27aacb386c90d8686dfeba Mon Sep 17 00:00:00 2001
From: Da Shen <da@liii.pro>
Date: Tue, 4 Nov 2025 15:59:32 +0800
Subject: [PATCH 1/8] wip

---
 goldfish/liii/oop.scm             | 261 ++++++++++++++++++++++++++++-
 goldfish/liii/oop2.scm            | 263 ------------------------------
 tests/goldfish/liii/oop-test.scm  | 205 +++++++++++++++++++++++
 tests/goldfish/liii/oop2-test.scm | 208 -----------------------
 4 files changed, 464 insertions(+), 473 deletions(-)
 delete mode 100644 goldfish/liii/oop2.scm
 delete mode 100644 tests/goldfish/liii/oop2-test.scm

diff --git a/goldfish/liii/oop.scm b/goldfish/liii/oop.scm
index 487bfea4..c1026d60 100644
--- a/goldfish/liii/oop.scm
+++ b/goldfish/liii/oop.scm
@@ -454,5 +454,262 @@
           (x :to-string)
           (s7-object->string x)))
 
-    ) ; end of begin
-  ) ; end of define-library
+    ;; 转换 instance-methods 中的方法调用
+    ;; 将 (%method-name args...) 转换为 ((object-name :method-name field-names) args...)
+    (define (transform-instance-methods methods object-name field-names)
+
+      ;; 转换方法体中的方法调用
+      (define (transform-method-body body object-name field-names)
+        ;; 转换表达式中的方法调用
+        (define (transform-expr expr object-name field-names)
+          (cond
+            ;; 处理 (%method-name args...) 形式
+            ((and (list? expr)
+                  (>= (length expr) 1)
+                  (symbol? (car expr))
+                  (string-starts? (symbol->string (car expr)) "%"))
+             (let* ((method-sym (car expr))
+                    (method-name (string-remove-prefix (symbol->string method-sym) "%"))
+                    (method-keyword (string->symbol (string-append ":" method-name)))
+                    (args (cdr expr)))
+               `((,object-name ,method-keyword ,@field-names) ,@args)))
+
+            ;; 递归处理嵌套表达式
+            ((list? expr)
+             (map (lambda (sub-expr)
+                    (transform-expr sub-expr object-name field-names))
+                  expr))
+
+            ;; 其他情况直接返回
+            (else expr)))
+        (map (lambda (expr)
+               (if (list? expr)
+                   (transform-expr expr object-name field-names)
+                   expr))
+             body))
+
+      (map (lambda (method)
+             (let* ((method-def (cadr method))
+                    (method-name (car method-def))
+                    (method-params (cdr method-def))
+                    (method-body (cddr method))
+                    (transformed-body (transform-method-body method-body object-name field-names)))
+               `(define ,method-def
+                  ,@transformed-body)))
+           methods))
+
+
+    (define-macro (define-case-class2 class-name fields . private-fields-and-methods)
+      (let* ((key-fields
+               (map (lambda (field) (string->symbol (string-append ":" (symbol->string (car field)))))
+                    fields))
+        
+             (field-names (map car fields))
+             (field-count (length field-names))
+
+             (methods (filter (lambda (x)
+                                (and (list? x)
+                                     (>= (length x) 2)
+                                     (pair? (x 1))))
+                              private-fields-and-methods))
+         
+             (method-names
+               (map (lambda (method)
+                      (let* ((method-sym (caadr method))
+                             (method-name (symbol->string method-sym)))
+                        (cond
+                          ((string-starts? method-name "@")
+                           (string-remove-prefix method-name "@"))
+                          ((string-starts? method-name "%")
+                           (string-remove-prefix method-name "%"))
+                          (else method-name))))
+                    methods))
+         
+             (conflicts-names
+              (filter (lambda (method-name)
+                        (let ((name (string->symbol method-name)))
+                          (member name field-names)))
+                      method-names))
+         
+             (check-conflicts-names (unless (null? conflicts-names)
+                                      (let ((conflict-str (apply string-append 
+                                                            (map (lambda (c) (string-append " <" c ">"))
+                                                                 conflicts-names))))
+                                        (error 'syntax-error (string-append "In class ["
+                                                               (symbol->string class-name)
+                                                               "]: Method name" 
+                                                               (if (= (length conflicts-names) 1) "" "s")
+                                                               conflict-str
+                                                               " conflicts with field name"
+                                                               (if (= (length conflicts-names) 1) "" "s"))))))
+         
+             (instance-methods
+              (filter (lambda (method) (string-starts? (symbol->string (caadr method)) "%"))
+                      methods))
+             (instance-method-symbols (map caadr instance-methods))
+             (instance-messages
+              (map (lambda (method)
+                     (let ((name (string-remove-prefix (symbol->string method) "%")))
+                       (string->symbol (string-append ":" name))))
+                   instance-method-symbols))
+             (static-methods
+              (filter (lambda (method) (string-starts? (symbol->string (caadr method)) "@"))
+                      methods))
+             (static-method-symbols (map caadr static-methods))
+             (static-messages
+              (map (lambda (method)
+                     (let ((name (string-remove-prefix (symbol->string method) "@")))
+                       (string->symbol (string-append ":" name))))
+                   static-method-symbols))
+             ;(default-static-messages '(:is-type-of))
+             (internal-methods
+               (filter (lambda (method) (not (or (string-starts? (symbol->string (caadr method)) "%")
+                                                 (string-starts? (symbol->string (caadr method)) "@"))))
+                       methods))
+             (f-make-case-class (string->symbol (string-append "make-case-class-" (symbol->string class-name))))
+             (object-name (string->symbol (string-append (symbol->string class-name) "-object"))))
+
+        `(begin
+           (define-object ,object-name
+             ,@internal-methods
+
+             (define (@to-string ,@field-names)
+               (define (%to-string)
+                 (let ((field-strings
+                        (list ,@(map (lambda (field key-field)
+                                       `(string-append
+                                         ,(symbol->string key-field) " "
+                                         (object->string ,(car field))))
+                                     fields key-fields))))
+                   (let loop ((strings field-strings)
+                              (acc ""))
+                     (if (null? strings)
+                         (string-append "(" ,(symbol->string class-name) " " acc ")")
+                         (loop (cdr strings)
+                               (if (zero? (string-length acc))
+                                   (car strings)
+                                   (string-append acc " " (car strings))))))))
+               %to-string)
+
+
+             ,@(map (lambda (method)
+                      (let* ((method-def (cadr method))
+                             (method-name (car method-def))
+                             (method-params (cdr method-def))
+                             (method-body (cddr method))
+                             (external-method-name (string->symbol (string-append "@" (string-remove-prefix (symbol->string method-name) "%")))))
+                        `(define (,external-method-name ,@field-names)
+                           ,method
+                           ,method-name)))
+                    (transform-instance-methods instance-methods object-name field-names)))
+
+           (define (,class-name . args)
+
+           (define (@is-type-of obj)
+             (and (case-class? obj)
+                  (obj :is-instance-of ',class-name)))
+   
+           ,@static-methods
+
+           (define (is-normal-function? msg)
+             (and  (symbol? msg) 
+                   (char=? (string-ref (symbol->string msg) 0) #\:)))
+
+           (define (static-dispatcher msg . args)
+             (cond
+              ((eq? msg :is-type-of) (apply @is-type-of args))
+              ,@(map (lambda (method expected) `((eq? msg ,expected) (apply ,method args)))
+                     static-method-symbols static-messages)
+              (else (value-error "No such static method " msg))))
+
+           (define* (,f-make-case-class 
+                      ,@(map  
+                          (lambda (param)
+                            (let  ((param-name (car param))
+                                   (type-pred (cadr param))
+                                   (default-value (cddr param)))
+                                  (if (null? default-value)
+                                      param-name
+                                      `(,param-name ,(car default-value)))))
+                          fields))
+             ,@(map (lambda (param)
+                      (let* ((param-name (car param))
+                             (type-pred (cadr param))
+                             ;;remove the '?' in 'type?'
+                             (type-name-str 
+                               (let ((s (symbol->string type-pred)))
+                                 (if (and (positive? (string-length s))
+                                       (char=? (string-ref s (- (string-length s) 1)) #\?))
+                                     (substring s 0 (- (string-length s) 1))
+                                     s))))
+
+                        `(unless 
+                           (,type-pred ,param-name)
+                           (type-error 
+                             (format #f "In funtion #<~a ~a>: argument *~a* must be *~a*!    **Got ~a**"
+                               ,f-make-case-class
+                               ',field-names
+                               ',param-name
+                               ,type-name-str
+                               (object->string ,param-name))))))
+                 fields)
+
+             (define (%is-instance-of x)
+               (eq? x ',class-name))
+         
+             (define (%equals that)
+               (unless (case-class? that) 
+                 (type-error 
+                   (format #f "In funtion #<~a ~a>: argument *~a* must be *~a*!    **Got ~a**" 
+                     %equals '(that) 'that "case-class" (object->string that))))
+               (and (that :is-instance-of ',class-name)
+                    ,@(map (lambda (field) `(equal? ,(car field) (that ',(car field))))
+                           fields)))
+         
+             (define (%apply . args)
+               (cond ((null? args)
+                      (value-error ,class-name "Apply on zero args is not implemented"))
+                     ((equal? ((symbol->string (car args)) 0) #\:)
+                      (value-error ,class-name "No such method: " (car args)))
+                     (else (value-error ,class-name "No such field: " (car args)))))
+         
+
+             (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 :to-string) (apply (,object-name :to-string ,@field-names)))
+                   ,@(map (lambda (field key-field)
+                            `((eq? msg ,key-field)
+                              (,class-name
+                                ,@(map (lambda (f) (if (eq? (car f) (car field)) '(car args) (car f)))
+                                    fields))))
+                       fields key-fields)
+                   ((is-normal-function? msg)
+                    (case msg
+                      ,@(map (lambda (method expected)
+                               `((,expected) (apply (,object-name ,expected ,@field-names) args)))
+                             instance-method-symbols instance-messages)
+                      (else (value-error ,class-name "No such method: " msg))))
+                   ,@(map (lambda (field) `((eq? msg ',(car field)) ,(car field))) fields)
+                   (else (apply %apply (cons msg args))))))
+
+             (instance-dispatcher)) ; end of the internal typed define
+
+           (if (null? args)
+               (,f-make-case-class)
+               (let ((msg (car args)))
+                 (cond ((member msg (list ,@static-messages :is-type-of))
+                        (apply static-dispatcher args))
+                       ((and (zero? ,field-count) (member :apply (list ,@static-messages)))
+                        (apply static-dispatcher (cons :apply args)))
+                       (else
+                        (apply ,f-make-case-class args)))))
+
+           ) ; end of define
+        ) ; end of let
+      ) ; end of define-macro
+    )
+  ) ; end of begin
+) ; end of define-library
diff --git a/goldfish/liii/oop2.scm b/goldfish/liii/oop2.scm
deleted file mode 100644
index 8ae75ae2..00000000
--- a/goldfish/liii/oop2.scm
+++ /dev/null
@@ -1,263 +0,0 @@
-(define-library (liii oop2)
-  (import (liii oop) (liii list) (liii string))
-  (export define-case-class2 transform-instance-methods)
-  (begin
-    ;; 转换 instance-methods 中的方法调用
-    ;; 将 (%method-name args...) 转换为 ((object-name :method-name field-names) args...)
-    (define (transform-instance-methods methods object-name field-names)
-
-      ;; 转换方法体中的方法调用
-      (define (transform-method-body body object-name field-names)
-        ;; 转换表达式中的方法调用
-        (define (transform-expr expr object-name field-names)
-          (cond
-            ;; 处理 (%method-name args...) 形式
-            ((and (list? expr)
-                  (>= (length expr) 1)
-                  (symbol? (car expr))
-                  (string-starts? (symbol->string (car expr)) "%"))
-             (let* ((method-sym (car expr))
-                    (method-name (string-remove-prefix (symbol->string method-sym) "%"))
-                    (method-keyword (string->symbol (string-append ":" method-name)))
-                    (args (cdr expr)))
-               `((,object-name ,method-keyword ,@field-names) ,@args)))
-
-            ;; 递归处理嵌套表达式
-            ((list? expr)
-             (map (lambda (sub-expr)
-                    (transform-expr sub-expr object-name field-names))
-                  expr))
-
-            ;; 其他情况直接返回
-            (else expr)))
-        (map (lambda (expr)
-               (if (list? expr)
-                   (transform-expr expr object-name field-names)
-                   expr))
-             body))
-
-      (map (lambda (method)
-             (let* ((method-def (cadr method))
-                    (method-name (car method-def))
-                    (method-params (cdr method-def))
-                    (method-body (cddr method))
-                    (transformed-body (transform-method-body method-body object-name field-names)))
-               `(define ,method-def
-                  ,@transformed-body)))
-           methods))
-
-
-    (define-macro (define-case-class2 class-name fields . private-fields-and-methods)
-      (let* ((key-fields
-               (map (lambda (field) (string->symbol (string-append ":" (symbol->string (car field)))))
-                    fields))
-        
-             (field-names (map car fields))
-             (field-count (length field-names))
-
-             (methods (filter (lambda (x)
-                                (and (list? x)
-                                     (>= (length x) 2)
-                                     (pair? (x 1))))
-                              private-fields-and-methods))
-         
-             (method-names
-               (map (lambda (method)
-                      (let* ((method-sym (caadr method))
-                             (method-name (symbol->string method-sym)))
-                        (cond
-                          ((string-starts? method-name "@")
-                           (string-remove-prefix method-name "@"))
-                          ((string-starts? method-name "%")
-                           (string-remove-prefix method-name "%"))
-                          (else method-name))))
-                    methods))
-         
-             (conflicts-names
-              (filter (lambda (method-name)
-                        (let ((name (string->symbol method-name)))
-                          (member name field-names)))
-                      method-names))
-         
-             (check-conflicts-names (unless (null? conflicts-names)
-                                      (let ((conflict-str (apply string-append 
-                                                            (map (lambda (c) (string-append " <" c ">"))
-                                                                 conflicts-names))))
-                                        (error 'syntax-error (string-append "In class ["
-                                                               (symbol->string class-name)
-                                                               "]: Method name" 
-                                                               (if (= (length conflicts-names) 1) "" "s")
-                                                               conflict-str
-                                                               " conflicts with field name"
-                                                               (if (= (length conflicts-names) 1) "" "s"))))))
-         
-             (instance-methods
-              (filter (lambda (method) (string-starts? (symbol->string (caadr method)) "%"))
-                      methods))
-             (instance-method-symbols (map caadr instance-methods))
-             (instance-messages
-              (map (lambda (method)
-                     (let ((name (string-remove-prefix (symbol->string method) "%")))
-                       (string->symbol (string-append ":" name))))
-                   instance-method-symbols))
-             (static-methods
-              (filter (lambda (method) (string-starts? (symbol->string (caadr method)) "@"))
-                      methods))
-             (static-method-symbols (map caadr static-methods))
-             (static-messages
-              (map (lambda (method)
-                     (let ((name (string-remove-prefix (symbol->string method) "@")))
-                       (string->symbol (string-append ":" name))))
-                   static-method-symbols))
-             ;(default-static-messages '(:is-type-of))
-             (internal-methods
-               (filter (lambda (method) (not (or (string-starts? (symbol->string (caadr method)) "%")
-                                                 (string-starts? (symbol->string (caadr method)) "@"))))
-                       methods))
-             (f-make-case-class (string->symbol (string-append "make-case-class-" (symbol->string class-name))))
-             (object-name (string->symbol (string-append (symbol->string class-name) "-object"))))
-
-        `(begin
-           (define-object ,object-name
-             ,@internal-methods
-
-             (define (@to-string ,@field-names)
-               (define (%to-string)
-                 (let ((field-strings
-                        (list ,@(map (lambda (field key-field)
-                                       `(string-append
-                                         ,(symbol->string key-field) " "
-                                         (object->string ,(car field))))
-                                     fields key-fields))))
-                   (let loop ((strings field-strings)
-                              (acc ""))
-                     (if (null? strings)
-                         (string-append "(" ,(symbol->string class-name) " " acc ")")
-                         (loop (cdr strings)
-                               (if (zero? (string-length acc))
-                                   (car strings)
-                                   (string-append acc " " (car strings))))))))
-               %to-string)
-
-
-             ,@(map (lambda (method)
-                      (let* ((method-def (cadr method))
-                             (method-name (car method-def))
-                             (method-params (cdr method-def))
-                             (method-body (cddr method))
-                             (external-method-name (string->symbol (string-append "@" (string-remove-prefix (symbol->string method-name) "%")))))
-                        `(define (,external-method-name ,@field-names)
-                           ,method
-                           ,method-name)))
-                    (transform-instance-methods instance-methods object-name field-names)))
-
-           (define (,class-name . args)
-
-           (define (@is-type-of obj)
-             (and (case-class? obj)
-                  (obj :is-instance-of ',class-name)))
-   
-           ,@static-methods
-
-           (define (is-normal-function? msg)
-             (and  (symbol? msg) 
-                   (char=? (string-ref (symbol->string msg) 0) #\:)))
-
-           (define (static-dispatcher msg . args)
-             (cond
-              ((eq? msg :is-type-of) (apply @is-type-of args))
-              ,@(map (lambda (method expected) `((eq? msg ,expected) (apply ,method args)))
-                     static-method-symbols static-messages)
-              (else (value-error "No such static method " msg))))
-
-           (define* (,f-make-case-class 
-                      ,@(map  
-                          (lambda (param)
-                            (let  ((param-name (car param))
-                                   (type-pred (cadr param))
-                                   (default-value (cddr param)))
-                                  (if (null? default-value)
-                                      param-name
-                                      `(,param-name ,(car default-value)))))
-                          fields))
-             ,@(map (lambda (param)
-                      (let* ((param-name (car param))
-                             (type-pred (cadr param))
-                             ;;remove the '?' in 'type?'
-                             (type-name-str 
-                               (let ((s (symbol->string type-pred)))
-                                 (if (and (positive? (string-length s))
-                                       (char=? (string-ref s (- (string-length s) 1)) #\?))
-                                     (substring s 0 (- (string-length s) 1))
-                                     s))))
-
-                        `(unless 
-                           (,type-pred ,param-name)
-                           (type-error 
-                             (format #f "In funtion #<~a ~a>: argument *~a* must be *~a*!    **Got ~a**"
-                               ,f-make-case-class
-                               ',field-names
-                               ',param-name
-                               ,type-name-str
-                               (object->string ,param-name))))))
-                 fields)
-
-             (define (%is-instance-of x)
-               (eq? x ',class-name))
-         
-             (define (%equals that)
-               (unless (case-class? that) 
-                 (type-error 
-                   (format #f "In funtion #<~a ~a>: argument *~a* must be *~a*!    **Got ~a**" 
-                     %equals '(that) 'that "case-class" (object->string that))))
-               (and (that :is-instance-of ',class-name)
-                    ,@(map (lambda (field) `(equal? ,(car field) (that ',(car field))))
-                           fields)))
-         
-             (define (%apply . args)
-               (cond ((null? args)
-                      (value-error ,class-name "Apply on zero args is not implemented"))
-                     ((equal? ((symbol->string (car args)) 0) #\:)
-                      (value-error ,class-name "No such method: " (car args)))
-                     (else (value-error ,class-name "No such field: " (car args)))))
-         
-
-             (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 :to-string) (apply (,object-name :to-string ,@field-names)))
-                   ,@(map (lambda (field key-field)
-                            `((eq? msg ,key-field)
-                              (,class-name
-                                ,@(map (lambda (f) (if (eq? (car f) (car field)) '(car args) (car f)))
-                                    fields))))
-                       fields key-fields)
-                   ((is-normal-function? msg)
-                    (case msg
-                      ,@(map (lambda (method expected)
-                               `((,expected) (apply (,object-name ,expected ,@field-names) args)))
-                             instance-method-symbols instance-messages)
-                      (else (value-error ,class-name "No such method: " msg))))
-                   ,@(map (lambda (field) `((eq? msg ',(car field)) ,(car field))) fields)
-                   (else (apply %apply (cons msg args))))))
-
-             (instance-dispatcher)) ; end of the internal typed define
-
-           (if (null? args)
-               (,f-make-case-class)
-               (let ((msg (car args)))
-                 (cond ((member msg (list ,@static-messages :is-type-of))
-                        (apply static-dispatcher args))
-                       ((and (zero? ,field-count) (member :apply (list ,@static-messages)))
-                        (apply static-dispatcher (cons :apply args)))
-                       (else
-                        (apply ,f-make-case-class args)))))
-
-           ) ; end of define
-        ) ; end of let
-      ) ; end of define-macro
-    )
-  )
-)
diff --git a/tests/goldfish/liii/oop-test.scm b/tests/goldfish/liii/oop-test.scm
index 8909540d..33a1b177 100644
--- a/tests/goldfish/liii/oop-test.scm
+++ b/tests/goldfish/liii/oop-test.scm
@@ -905,5 +905,210 @@ case-class? 是 (liii oop) 模块中用于类型检查的函数，它判断给
   )
 
 
+;; 测试转换函数
+(let* ((object-name 'person-object)
+       (field-names '(name age))
+       (methods '((define (%to-string)
+                    (string-append "I am " name ", " (number->string age) " years old!"))
+                  (define (%greet other-name)
+                    (string-append "Hi " other-name ", " (%to-string)))))
+       (transformed (transform-instance-methods methods object-name field-names)))
+
+  ;; 检查转换后的方法定义
+  (check (length transformed) => 2)
+
+  ;; 检查第一个方法 (%to-string)
+  (let ((to-string-method (car transformed)))
+    (check (car to-string-method) => 'define)
+    (check (cadr to-string-method) => '(%to-string))
+    (check (caddr to-string-method) => '(string-append "I am " name ", " (number->string age) " years old!")))
+
+  ;; 检查第二个方法 (%greet) - 应该将 (%to-string) 转换为 ((person-object :to-string name age))
+  (let ((greet-method (cadr transformed)))
+    (check (car greet-method) => 'define)
+    (check (cadr greet-method) => '(%greet other-name))
+    (check (caddr greet-method) => '(string-append "Hi " other-name ", " ((person-object :to-string name age))))))
+
+
+(define-case-class2 person
+  ((name string? "Bob")
+   (age integer?)))
+
+(let1 bob (person :name "Bob" :age 21)
+  (check (bob 'name) => "Bob")
+  (check (bob 'age) => 21)
+  (check ((bob :name "hello") 'name) => "hello")
+  (check-catch 'value-error (bob 'sex))
+  (check-catch 'value-error (bob :sex))
+  (check-true (bob :is-instance-of 'person))
+  (check-true (person :is-type-of bob))
+  (check (bob :to-string) => "(person :name \"Bob\" :age 21)"))
+
+(check-catch 'type-error (person 1 21))
+
+(let ((bob (person "Bob" 21))
+      (get-name (lambda (x)
+                 (case* x
+                   ((#<procedure?>) (x 'name))
+                   (else (value-error))))))
+  (check (get-name bob) => "Bob")
+  (check-catch 'value-error (get-name 1)))
+
+(define-case-class2 jerson
+  ((name string?)
+   (age integer?))
+  
+  (define (%to-string)
+    (string-append "I am " name " " (number->string age) " years old!"))
+  (define (%greet x)
+    (string-append "Hi " x ", " (%to-string)))
+  (define (%i-greet x)
+    (string-append name ": " (%greet x))) 
+)
+
+(check-true (procedure? (jerson-object :to-string "name" 21)))
+
+(let1 bob (jerson "Bob" 21)
+  (check (bob :to-string) => "I am Bob 21 years old!")
+  (check (bob :greet "Alice") => "Hi Alice, I am Bob 21 years old!")
+  (check (bob :i-greet "Alice") => "Bob: Hi Alice, I am Bob 21 years old!"))
+
+
+
+(define-case-class2 test-case-class
+  ((name string?))
+  
+  (define (@this-is-a-static-method)
+    (test-case-class "static"))
+  
+  (define (%this-is-a-instance-method)
+    (test-case-class (string-append name "instance")))
+  )
+
+(let1 hello (test-case-class "hello ")
+  (check-catch 'value-error (hello :this-is-a-static-method))
+  (check (test-case-class :this-is-a-static-method) => (test-case-class "static")))
+
+(check-catch 'syntax-error
+  (eval
+    '(define-case-class2 instance-methods-conflict-test
+      ((name string?)
+       (age integer?))
+      (define (%name)
+        name))))
+
+(check-catch 'syntax-error
+  (eval
+    '(define-case-class2 static-methods-conflict-test
+      ((name string?)
+       (age integer?))
+      (define (@name)
+        name))))
+
+(check-catch 'syntax-error
+  (eval
+    '(define-case-class2 internal-methods-conflict-test
+       ((name string?)
+        (test-name string?)
+        (age integer?))
+       (define (test-name str)
+         (string-append str " ")))))
+
+;; 测试自动生成的 %equals 方法
+(let ()
+  (define-case-class2 point
+    ((x integer?)
+     (y integer?)))
+
+  (define p1 (point :x 1 :y 2))
+  (define p2 (point :x 1 :y 2))
+  (define p3 (point :x 3 :y 4))
+
+  ;; 测试相同值的实例相等
+  (check-true (p1 :equals p2))
+  (check-true (p2 :equals p1))
+
+  ;; 测试不同值的实例不相等
+  (check-false (p1 :equals p3))
+  (check-false (p3 :equals p1))
+
+  ;; 测试实例与自身相等
+  (check-true (p1 :equals p1))
+  (check-true (p2 :equals p2))
+  (check-true (p3 :equals p3)))
+
+;; 测试 %equals 方法的类型检查
+(let ()
+  (define-case-class2 person
+    ((name string?)
+     (age integer?)))
+
+  (define bob (person "Bob" 21))
+
+  ;; 测试与非样本类对象比较抛出 type-error
+  (check-catch 'type-error (bob :equals "not-a-sample-class"))
+  (check-catch 'type-error (bob :equals 123))
+  (check-catch 'type-error (bob :equals +)))
+
+;; 测试不同类型样本类实例的比较
+(let ()
+  (define-case-class2 person
+    ((name string?)
+     (age integer?)))
+
+  (define-case-class2 point
+    ((x integer?)
+     (y integer?)))
+
+  (define bob (person "Bob" 21))
+  (define p1 (point :x 1 :y 2))
+
+  ;; 测试不同类型样本类实例不相等
+  (check-false (bob :equals p1))
+  (check-false (p1 :equals bob)))
+
+;; 测试 %equals 方法在复杂样本类中的行为
+(let ()
+  (define-case-class2 complex-class
+    ((name string?)
+     (numbers list?)
+     (flag boolean? #f)))
+
+  (define c1 (complex-class :name "test" :numbers '(1 2 3) :flag #t))
+  (define c2 (complex-class :name "test" :numbers '(1 2 3) :flag #t))
+  (define c3 (complex-class :name "test" :numbers '(4 5 6) :flag #t))
+
+  ;; 测试复杂字段的相等性比较
+  (check-true (c1 :equals c2))
+  (check-false (c1 :equals c3)))
+
+;; 测试 %equals 方法在带有默认值的样本类中的行为
+(let ()
+  (define-case-class2 person-with-default
+    ((name string? "Unknown")
+     (age integer? 0)))
+
+  (define p1 (person-with-default))
+  (define p2 (person-with-default :name "Unknown" :age 0))
+  (define p3 (person-with-default :name "Alice" :age 25))
+
+  ;; 测试默认值实例的相等性
+  (check-true (p1 :equals p2))
+  (check-false (p1 :equals p3)))
+
+;; 测试 %equals 方法在带有私有字段的样本类中的行为
+(let ()
+  (define-case-class2 person-with-private
+    ((name string?)
+     (age integer?))
+
+    (define secret "private"))
+
+  (define p1 (person-with-private "Bob" 21))
+  (define p2 (person-with-private "Bob" 21))
+
+  ;; 测试私有字段不影响相等性比较
+  (check-true (p1 :equals p2)))
+
 (check-report)
 
diff --git a/tests/goldfish/liii/oop2-test.scm b/tests/goldfish/liii/oop2-test.scm
deleted file mode 100644
index 41d0ed3c..00000000
--- a/tests/goldfish/liii/oop2-test.scm
+++ /dev/null
@@ -1,208 +0,0 @@
-(import (liii oop2) (liii check) (liii case) (liii rich-string) (liii oop) (liii base) (liii error))
-
-;; 测试转换函数
-(let* ((object-name 'person-object)
-       (field-names '(name age))
-       (methods '((define (%to-string)
-                    (string-append "I am " name ", " (number->string age) " years old!"))
-                  (define (%greet other-name)
-                    (string-append "Hi " other-name ", " (%to-string)))))
-       (transformed (transform-instance-methods methods object-name field-names)))
-
-  ;; 检查转换后的方法定义
-  (check (length transformed) => 2)
-
-  ;; 检查第一个方法 (%to-string)
-  (let ((to-string-method (car transformed)))
-    (check (car to-string-method) => 'define)
-    (check (cadr to-string-method) => '(%to-string))
-    (check (caddr to-string-method) => '(string-append "I am " name ", " (number->string age) " years old!")))
-
-  ;; 检查第二个方法 (%greet) - 应该将 (%to-string) 转换为 ((person-object :to-string name age))
-  (let ((greet-method (cadr transformed)))
-    (check (car greet-method) => 'define)
-    (check (cadr greet-method) => '(%greet other-name))
-    (check (caddr greet-method) => '(string-append "Hi " other-name ", " ((person-object :to-string name age))))))
-
-
-(define-case-class2 person
-  ((name string? "Bob")
-   (age integer?)))
-
-(let1 bob (person :name "Bob" :age 21)
-  (check (bob 'name) => "Bob")
-  (check (bob 'age) => 21)
-  (check ((bob :name "hello") 'name) => "hello")
-  (check-catch 'value-error (bob 'sex))
-  (check-catch 'value-error (bob :sex))
-  (check-true (bob :is-instance-of 'person))
-  (check-true (person :is-type-of bob))
-  (check (bob :to-string) => "(person :name \"Bob\" :age 21)"))
-
-(check-catch 'type-error (person 1 21))
-
-(let ((bob (person "Bob" 21))
-      (get-name (lambda (x)
-                 (case* x
-                   ((#<procedure?>) (x 'name))
-                   (else (value-error))))))
-  (check (get-name bob) => "Bob")
-  (check-catch 'value-error (get-name 1)))
-
-(define-case-class2 jerson
-  ((name string?)
-   (age integer?))
-  
-  (define (%to-string)
-    (string-append "I am " name " " (number->string age) " years old!"))
-  (define (%greet x)
-    (string-append "Hi " x ", " (%to-string)))
-  (define (%i-greet x)
-    (string-append name ": " (%greet x))) 
-)
-
-(check-true (procedure? (jerson-object :to-string "name" 21)))
-
-(let1 bob (jerson "Bob" 21)
-  (check (bob :to-string) => "I am Bob 21 years old!")
-  (check (bob :greet "Alice") => "Hi Alice, I am Bob 21 years old!")
-  (check (bob :i-greet "Alice") => "Bob: Hi Alice, I am Bob 21 years old!"))
-
-
-
-(define-case-class2 test-case-class
-  ((name string?))
-  
-  (define (@this-is-a-static-method)
-    (test-case-class "static"))
-  
-  (define (%this-is-a-instance-method)
-    (test-case-class (string-append name "instance")))
-  )
-
-(let1 hello (test-case-class "hello ")
-  (check-catch 'value-error (hello :this-is-a-static-method))
-  (check (test-case-class :this-is-a-static-method) => (test-case-class "static")))
-
-(check-catch 'syntax-error
-  (eval
-    '(define-case-class2 instance-methods-conflict-test
-      ((name string?)
-       (age integer?))
-      (define (%name)
-        name))))
-
-(check-catch 'syntax-error
-  (eval
-    '(define-case-class2 static-methods-conflict-test
-      ((name string?)
-       (age integer?))
-      (define (@name)
-        name))))
-
-(check-catch 'syntax-error
-  (eval
-    '(define-case-class2 internal-methods-conflict-test
-       ((name string?)
-        (test-name string?)
-        (age integer?))
-       (define (test-name str)
-         (string-append str " ")))))
-
-;; 测试自动生成的 %equals 方法
-(let ()
-  (define-case-class2 point
-    ((x integer?)
-     (y integer?)))
-
-  (define p1 (point :x 1 :y 2))
-  (define p2 (point :x 1 :y 2))
-  (define p3 (point :x 3 :y 4))
-
-  ;; 测试相同值的实例相等
-  (check-true (p1 :equals p2))
-  (check-true (p2 :equals p1))
-
-  ;; 测试不同值的实例不相等
-  (check-false (p1 :equals p3))
-  (check-false (p3 :equals p1))
-
-  ;; 测试实例与自身相等
-  (check-true (p1 :equals p1))
-  (check-true (p2 :equals p2))
-  (check-true (p3 :equals p3)))
-
-;; 测试 %equals 方法的类型检查
-(let ()
-  (define-case-class2 person
-    ((name string?)
-     (age integer?)))
-
-  (define bob (person "Bob" 21))
-
-  ;; 测试与非样本类对象比较抛出 type-error
-  (check-catch 'type-error (bob :equals "not-a-sample-class"))
-  (check-catch 'type-error (bob :equals 123))
-  (check-catch 'type-error (bob :equals +)))
-
-;; 测试不同类型样本类实例的比较
-(let ()
-  (define-case-class2 person
-    ((name string?)
-     (age integer?)))
-
-  (define-case-class2 point
-    ((x integer?)
-     (y integer?)))
-
-  (define bob (person "Bob" 21))
-  (define p1 (point :x 1 :y 2))
-
-  ;; 测试不同类型样本类实例不相等
-  (check-false (bob :equals p1))
-  (check-false (p1 :equals bob)))
-
-;; 测试 %equals 方法在复杂样本类中的行为
-(let ()
-  (define-case-class2 complex-class
-    ((name string?)
-     (numbers list?)
-     (flag boolean? #f)))
-
-  (define c1 (complex-class :name "test" :numbers '(1 2 3) :flag #t))
-  (define c2 (complex-class :name "test" :numbers '(1 2 3) :flag #t))
-  (define c3 (complex-class :name "test" :numbers '(4 5 6) :flag #t))
-
-  ;; 测试复杂字段的相等性比较
-  (check-true (c1 :equals c2))
-  (check-false (c1 :equals c3)))
-
-;; 测试 %equals 方法在带有默认值的样本类中的行为
-(let ()
-  (define-case-class2 person-with-default
-    ((name string? "Unknown")
-     (age integer? 0)))
-
-  (define p1 (person-with-default))
-  (define p2 (person-with-default :name "Unknown" :age 0))
-  (define p3 (person-with-default :name "Alice" :age 25))
-
-  ;; 测试默认值实例的相等性
-  (check-true (p1 :equals p2))
-  (check-false (p1 :equals p3)))
-
-;; 测试 %equals 方法在带有私有字段的样本类中的行为
-(let ()
-  (define-case-class2 person-with-private
-    ((name string?)
-     (age integer?))
-
-    (define secret "private"))
-
-  (define p1 (person-with-private "Bob" 21))
-  (define p2 (person-with-private "Bob" 21))
-
-  ;; 测试私有字段不影响相等性比较
-  (check-true (p1 :equals p2)))
-
-(check-report)
-- 
Gitee


From 4c5752b5993899fd02e19aeb0f774ee1b5390612 Mon Sep 17 00:00:00 2001
From: Da Shen <da@liii.pro>
Date: Tue, 4 Nov 2025 16:00:23 +0800
Subject: [PATCH 2/8] 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 c1026d60..84847a18 100644
--- a/goldfish/liii/oop.scm
+++ b/goldfish/liii/oop.scm
@@ -19,7 +19,7 @@
   (export
     @ typed-define define-case-class define-object define-class
     case-class? chained-define display* object->string
-    chain-apply
+    chain-apply define-case-class2 transform-instance-methods
     )
   (begin
 
-- 
Gitee


From 835fdcef848467d712c148c7a87a0b39bcf926ea Mon Sep 17 00:00:00 2001
From: Da Shen <da@liii.pro>
Date: Tue, 4 Nov 2025 16:02:29 +0800
Subject: [PATCH 3/8] wip

---
 bench/define-case-class-methods.scm | 12 ++++++------
 goldfish/liii/oop.scm               |  4 ++--
 2 files changed, 8 insertions(+), 8 deletions(-)

diff --git a/bench/define-case-class-methods.scm b/bench/define-case-class-methods.scm
index eb62d296..25708572 100644
--- a/bench/define-case-class-methods.scm
+++ b/bench/define-case-class-methods.scm
@@ -22,7 +22,7 @@
   (display "=== Define-Case-Class Construction Performance Test ===\n\n")
 
   ; Test with 1 instance method
-  (define-case-class2 class-1-method
+  (define-final-class class-1-method
     ((value any?))
     (define (%method1) value))
 
@@ -30,7 +30,7 @@
     (display* "1 instance method:\t\t" (number->string time) " seconds\n"))
 
   ; Test with 2 instance methods
-  (define-case-class2 class-2-methods
+  (define-final-class class-2-methods
     ((value any?))
     (define (%method1) value)
     (define (%method2) (+ value 1)))
@@ -39,7 +39,7 @@
     (display* "2 instance methods:\t\t" (number->string time) " seconds\n"))
 
   ; Test with 4 instance methods
-  (define-case-class2 class-4-methods
+  (define-final-class class-4-methods
     ((value any?))
     (define (%method1) value)
     (define (%method2) (+ value 1))
@@ -50,7 +50,7 @@
     (display* "4 instance methods:\t\t" (number->string time) " seconds\n"))
 
   ; Test with 8 instance methods
-  (define-case-class2 class-8-methods
+  (define-final-class class-8-methods
     ((value any?))
     (define (%method1) value)
     (define (%method2) (+ value 1))
@@ -65,7 +65,7 @@
     (display* "8 instance methods:\t\t" (number->string time) " seconds\n"))
 
   ; Test with 16 instance methods
-  (define-case-class2 class-16-methods
+  (define-final-class class-16-methods
     ((value any?))
     (define (%method1) value)
     (define (%method2) (+ value 1))
@@ -88,7 +88,7 @@
     (display* "16 instance methods:\t\t" (number->string time) " seconds\n"))
 
   ; Test with 32 instance methods
-  (define-case-class2 class-32-methods
+  (define-final-class class-32-methods
     ((value any?))
     (define (%method1) value)
     (define (%method2) (+ value 1))
diff --git a/goldfish/liii/oop.scm b/goldfish/liii/oop.scm
index 84847a18..847c42e9 100644
--- a/goldfish/liii/oop.scm
+++ b/goldfish/liii/oop.scm
@@ -19,7 +19,7 @@
   (export
     @ typed-define define-case-class define-object define-class
     case-class? chained-define display* object->string
-    chain-apply define-case-class2 transform-instance-methods
+    chain-apply define-final-class transform-instance-methods
     )
   (begin
 
@@ -499,7 +499,7 @@
            methods))
 
 
-    (define-macro (define-case-class2 class-name fields . private-fields-and-methods)
+    (define-macro (define-final-class class-name fields . private-fields-and-methods)
       (let* ((key-fields
                (map (lambda (field) (string->symbol (string-append ":" (symbol->string (car field)))))
                     fields))
-- 
Gitee


From 07a44c17e2fe15cc4cf5a221b900d3f90eb9d729 Mon Sep 17 00:00:00 2001
From: Da Shen <da@liii.pro>
Date: Tue, 4 Nov 2025 16:03:49 +0800
Subject: [PATCH 4/8] wip

---
 tests/goldfish/liii/oop-test.scm | 26 +++++++++++++-------------
 1 file changed, 13 insertions(+), 13 deletions(-)

diff --git a/tests/goldfish/liii/oop-test.scm b/tests/goldfish/liii/oop-test.scm
index 33a1b177..f96d7b5d 100644
--- a/tests/goldfish/liii/oop-test.scm
+++ b/tests/goldfish/liii/oop-test.scm
@@ -930,7 +930,7 @@ case-class? 是 (liii oop) 模块中用于类型检查的函数，它判断给
     (check (caddr greet-method) => '(string-append "Hi " other-name ", " ((person-object :to-string name age))))))
 
 
-(define-case-class2 person
+(define-final-class person
   ((name string? "Bob")
    (age integer?)))
 
@@ -954,7 +954,7 @@ case-class? 是 (liii oop) 模块中用于类型检查的函数，它判断给
   (check (get-name bob) => "Bob")
   (check-catch 'value-error (get-name 1)))
 
-(define-case-class2 jerson
+(define-final-class jerson
   ((name string?)
    (age integer?))
   
@@ -975,7 +975,7 @@ case-class? 是 (liii oop) 模块中用于类型检查的函数，它判断给
 
 
 
-(define-case-class2 test-case-class
+(define-final-class test-case-class
   ((name string?))
   
   (define (@this-is-a-static-method)
@@ -991,7 +991,7 @@ case-class? 是 (liii oop) 模块中用于类型检查的函数，它判断给
 
 (check-catch 'syntax-error
   (eval
-    '(define-case-class2 instance-methods-conflict-test
+    '(define-final-class instance-methods-conflict-test
       ((name string?)
        (age integer?))
       (define (%name)
@@ -999,7 +999,7 @@ case-class? 是 (liii oop) 模块中用于类型检查的函数，它判断给
 
 (check-catch 'syntax-error
   (eval
-    '(define-case-class2 static-methods-conflict-test
+    '(define-final-class static-methods-conflict-test
       ((name string?)
        (age integer?))
       (define (@name)
@@ -1007,7 +1007,7 @@ case-class? 是 (liii oop) 模块中用于类型检查的函数，它判断给
 
 (check-catch 'syntax-error
   (eval
-    '(define-case-class2 internal-methods-conflict-test
+    '(define-final-class internal-methods-conflict-test
        ((name string?)
         (test-name string?)
         (age integer?))
@@ -1016,7 +1016,7 @@ case-class? 是 (liii oop) 模块中用于类型检查的函数，它判断给
 
 ;; 测试自动生成的 %equals 方法
 (let ()
-  (define-case-class2 point
+  (define-final-class point
     ((x integer?)
      (y integer?)))
 
@@ -1039,7 +1039,7 @@ case-class? 是 (liii oop) 模块中用于类型检查的函数，它判断给
 
 ;; 测试 %equals 方法的类型检查
 (let ()
-  (define-case-class2 person
+  (define-final-class person
     ((name string?)
      (age integer?)))
 
@@ -1052,11 +1052,11 @@ case-class? 是 (liii oop) 模块中用于类型检查的函数，它判断给
 
 ;; 测试不同类型样本类实例的比较
 (let ()
-  (define-case-class2 person
+  (define-final-class person
     ((name string?)
      (age integer?)))
 
-  (define-case-class2 point
+  (define-final-class point
     ((x integer?)
      (y integer?)))
 
@@ -1069,7 +1069,7 @@ case-class? 是 (liii oop) 模块中用于类型检查的函数，它判断给
 
 ;; 测试 %equals 方法在复杂样本类中的行为
 (let ()
-  (define-case-class2 complex-class
+  (define-final-class complex-class
     ((name string?)
      (numbers list?)
      (flag boolean? #f)))
@@ -1084,7 +1084,7 @@ case-class? 是 (liii oop) 模块中用于类型检查的函数，它判断给
 
 ;; 测试 %equals 方法在带有默认值的样本类中的行为
 (let ()
-  (define-case-class2 person-with-default
+  (define-final-class person-with-default
     ((name string? "Unknown")
      (age integer? 0)))
 
@@ -1098,7 +1098,7 @@ case-class? 是 (liii oop) 模块中用于类型检查的函数，它判断给
 
 ;; 测试 %equals 方法在带有私有字段的样本类中的行为
 (let ()
-  (define-case-class2 person-with-private
+  (define-final-class person-with-private
     ((name string?)
      (age integer?))
 
-- 
Gitee


From cf1758b85a26ac869545081f0ee9ccb71e73e7dc Mon Sep 17 00:00:00 2001
From: Da Shen <da@liii.pro>
Date: Tue, 4 Nov 2025 16:12:10 +0800
Subject: [PATCH 5/8] wip

---
 bench/option.scm | 106 ++++++++++++++++++++++++++++++++++++++++-------
 1 file changed, 90 insertions(+), 16 deletions(-)

diff --git a/bench/option.scm b/bench/option.scm
index d49e9aa9..09d8869f 100644
--- a/bench/option.scm
+++ b/bench/option.scm
@@ -14,19 +14,93 @@
 ; under the License.
 ;
 
-(import (scheme time)
-        (liii option))
-
-(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 "option%map:\t"
-  (lambda () (repeat 10000 (lambda () ((option 65536) :map (lambda (x) (+ x 1)))))))
+(import (liii timeit)
+        (liii option)
+        (liii lang))
+
+(define (run-option-benchmarks)
+  (display "=== Option 模块性能基准测试 ===\n\n")
+
+  ; 测试 option 构造性能
+  (let ((time (timeit (lambda () (option 42)) :number 100000)))
+    (display* "option 构造: \t\t" (number->string time) " 秒\n"))
+
+  ; 测试 none 构造性能
+  (let ((time (timeit (lambda () (none)) :number 100000)))
+    (display* "none 构造: \t\t" (number->string time) " 秒\n"))
+
+  ; 测试 %get 方法性能
+  (let ((opt (option 42)))
+    (let ((time (timeit (lambda () (opt :get)) :number 100000)))
+      (display* "%get 方法: \t\t" (number->string time) " 秒\n")))
+
+  ; 测试 %get-or-else 方法性能（有值情况）
+  (let ((opt (option 42)))
+    (let ((time (timeit (lambda () (opt :get-or-else 0)) :number 100000)))
+      (display* "%get-or-else (有值): \t" (number->string time) " 秒\n")))
+
+  ; 测试 %get-or-else 方法性能（无值情况）
+  (let ((opt (none)))
+    (let ((time (timeit (lambda () (opt :get-or-else 0)) :number 100000)))
+      (display* "%get-or-else (无值): \t" (number->string time) " 秒\n")))
+
+  ; 测试 %defined? 方法性能
+  (let ((opt (option 42)))
+    (let ((time (timeit (lambda () (opt :defined?)) :number 100000)))
+      (display* "%defined? 方法: \t" (number->string time) " 秒\n")))
+
+  ; 测试 %empty? 方法性能
+  (let ((opt (none)))
+    (let ((time (timeit (lambda () (opt :empty?)) :number 100000)))
+      (display* "%empty? 方法: \t\t" (number->string time) " 秒\n")))
+
+  ; 测试 %map 方法性能
+  (let ((opt (option 42)))
+    (let ((time (timeit (lambda () (opt :map (lambda (x) (+ x 1)))) :number 100000)))
+      (display* "%map 方法: \t\t" (number->string time) " 秒\n")))
+
+  ; 测试 %flat-map 方法性能
+  (let ((opt (option 42)))
+    (let ((time (timeit (lambda () (opt :flat-map (lambda (x) (option (+ x 1))))) :number 100000)))
+      (display* "%flat-map 方法: \t" (number->string time) " 秒\n")))
+
+  ; 测试 %filter 方法性能（通过）
+  (let ((opt (option 42)))
+    (let ((time (timeit (lambda () (opt :filter (lambda (x) #t))) :number 100000)))
+      (display* "%filter (通过): \t" (number->string time) " 秒\n")))
+
+  ; 测试 %filter 方法性能（不通过）
+  (let ((opt (option 42)))
+    (let ((time (timeit (lambda () (opt :filter (lambda (x) #f))) :number 100000)))
+      (display* "%filter (不通过): \t" (number->string time) " 秒\n")))
+
+  ; 测试 %forall 方法性能
+  (let ((opt (option 42)))
+    (let ((time (timeit (lambda () (opt :forall (lambda (x) #t))) :number 100000)))
+      (display* "%forall 方法: \t" (number->string time) " 秒\n")))
+
+  ; 测试 %exists 方法性能
+  (let ((opt (option 42)))
+    (let ((time (timeit (lambda () (opt :exists (lambda (x) #t))) :number 100000)))
+      (display* "%exists 方法: \t" (number->string time) " 秒\n")))
+
+  ; 测试 %contains 方法性能
+  (let ((opt (option 42)))
+    (let ((time (timeit (lambda () (opt :contains 42)) :number 100000)))
+      (display* "%contains 方法: \t" (number->string time) " 秒\n")))
+
+  ; 测试 %for-each 方法性能
+  (let ((opt (option 42)))
+    (let ((time (timeit (lambda () (opt :for-each (lambda (x) #t))) :number 100000)))
+      (display* "%for-each 方法: \t" (number->string time) " 秒\n")))
+
+  ; 测试 %equals 方法性能
+  (let ((opt1 (option 42))
+        (opt2 (option 42)))
+    (let ((time (timeit (lambda () (opt1 :equals opt2)) :number 100000)))
+      (display* "%equals 方法: \t" (number->string time) " 秒\n")))
+
+  (display "\n=== 测试完成 ===\n"))
+
+; 运行基准测试
+(run-option-benchmarks)
-- 
Gitee


From f19b95d7e5f6a366c84768d578c77ccc87a0c1c4 Mon Sep 17 00:00:00 2001
From: Da Shen <da@liii.pro>
Date: Tue, 4 Nov 2025 16:15:33 +0800
Subject: [PATCH 6/8] wip

---
 devel/202_4.md           | 45 ++++++++++++++++++++++++++++++++++++++++
 goldfish/liii/option.scm |  2 +-
 2 files changed, 46 insertions(+), 1 deletion(-)
 create mode 100644 devel/202_4.md

diff --git a/devel/202_4.md b/devel/202_4.md
new file mode 100644
index 00000000..7b69fdc8
--- /dev/null
+++ b/devel/202_4.md
@@ -0,0 +1,45 @@
+define-case-class版本的 option的性能
+=== Option 模块性能基准测试 ===
+
+option 构造:            0.24860787391662598 秒
+none 构造:              0.23132801055908203 秒
+%get 方法:              0.02340412139892578 秒
+%get-or-else (有值):    0.031055927276611328 秒
+%get-or-else (无值):    0.03514409065246582 秒
+%defined? 方法:         0.02825307846069336 秒
+%empty? 方法:           0.028138160705566406 秒
+%map 方法:              0.3120708465576172 秒
+%flat-map 方法:         0.2943289279937744 秒
+%filter (通过):         0.2926340103149414 秒
+%filter (不通过):       0.2984180450439453 秒
+%forall 方法:   0.035418033599853516 秒
+%exists 方法:   0.0383150577545166 秒
+%contains 方法:         0.0318148136138916 秒
+%for-each 方法:         0.03927016258239746 秒
+%equals 方法:   1.625101089477539 秒
+
+=== 测试完成 ===
+
+
+define-final-class版本的 option 的性能
+
+=== Option 模块性能基准测试 ===
+
+option 构造:            0.14159512519836426 秒
+none 构造:              0.12361502647399902 秒
+%get 方法:              0.07221794128417969 秒
+%get-or-else (有值):    0.08096098899841309 秒
+%get-or-else (无值):    0.07790994644165039 秒
+%defined? 方法:         0.07638001441955566 秒
+%empty? 方法:           0.0759739875793457 秒
+%map 方法:              0.23376202583312988 秒
+%flat-map 方法:         0.23461604118347168 秒
+%filter (通过):         0.23214292526245117 秒
+%filter (不通过):       0.23892498016357422 秒
+%forall 方法:   0.08304309844970703 秒
+%exists 方法:   0.08419609069824219 秒
+%contains 方法:         0.08438706398010254 秒
+%for-each 方法:         0.08509421348571777 秒
+%equals 方法:   0.6305508613586426 秒
+
+=== 测试完成 ===
diff --git a/goldfish/liii/option.scm b/goldfish/liii/option.scm
index 77dc64bb..08c3433a 100644
--- a/goldfish/liii/option.scm
+++ b/goldfish/liii/option.scm
@@ -19,7 +19,7 @@
   (export option none)
   (begin
 
-    (define-case-class option ((value any?))
+    (define-final-class option ((value any?))
 
       (define (%get)
         (if (null? value)
-- 
Gitee


From c92ecdd6d5094bad991c74a0822d0381768c39c6 Mon Sep 17 00:00:00 2001
From: Da Shen <da@liii.pro>
Date: Tue, 4 Nov 2025 16:33:27 +0800
Subject: [PATCH 7/8] wi

---
 devel/202_4.md | 79 ++++++++++++++++++++++++++------------------------
 1 file changed, 41 insertions(+), 38 deletions(-)

diff --git a/devel/202_4.md b/devel/202_4.md
index 7b69fdc8..f274c189 100644
--- a/devel/202_4.md
+++ b/devel/202_4.md
@@ -1,45 +1,48 @@
-define-case-class版本的 option的性能
-=== Option 模块性能基准测试 ===
+# 202_4: 在 (liii oop) 中新增 define-final-class
+## 2025/11/04 define-final-class
+### What
+新增 define-final-class
++ 在构造器这块性能上比 define-case-class 好
++ 在方法访问上性能上比 define-case-class 差
 
-option 构造:            0.24860787391662598 秒
-none 构造:              0.23132801055908203 秒
-%get 方法:              0.02340412139892578 秒
-%get-or-else (有值):    0.031055927276611328 秒
-%get-or-else (无值):    0.03514409065246582 秒
-%defined? 方法:         0.02825307846069336 秒
-%empty? 方法:           0.028138160705566406 秒
-%map 方法:              0.3120708465576172 秒
-%flat-map 方法:         0.2943289279937744 秒
-%filter (通过):         0.2926340103149414 秒
-%filter (不通过):       0.2984180450439453 秒
-%forall 方法:   0.035418033599853516 秒
-%exists 方法:   0.0383150577545166 秒
-%contains 方法:         0.0318148136138916 秒
-%for-each 方法:         0.03927016258239746 秒
-%equals 方法:   1.625101089477539 秒
+## Option模块的性能测试结果对比
 
-=== 测试完成 ===
+以下表格对比了 `define-case-class`（前）和 `define-final-class`（后）版本的 Option 模块性能差异。测试基于 100,000 次操作，时间单位为秒。
 
+| 测试项目 | define-case-class (前) | define-final-class (后) | 性能提升 | 提升幅度 |
+|---------|----------------------|-----------------------|---------|---------|
+| **构造函数** | | | | |
+| option 构造 | 0.2486 | 0.1416 | 0.1070 | 43.0% |
+| none 构造 | 0.2313 | 0.1236 | 0.1077 | 46.5% |
+| **访问方法** | | | | |
+| %get 方法 | 0.0234 | 0.0722 | -0.0488 | -208.5% |
+| %get-or-else (有值) | 0.0311 | 0.0810 | -0.0499 | -160.5% |
+| %get-or-else (无值) | 0.0351 | 0.0779 | -0.0428 | -121.9% |
+| %defined? 方法 | 0.0283 | 0.0764 | -0.0481 | -170.0% |
+| %empty? 方法 | 0.0281 | 0.0760 | -0.0479 | -170.5% |
+| **转换方法** | | | | |
+| %map 方法 | 0.3121 | 0.2338 | 0.0783 | 25.1% |
+| %flat-map 方法 | 0.2943 | 0.2346 | 0.0597 | 20.3% |
+| %filter (通过) | 0.2926 | 0.2321 | 0.0605 | 20.7% |
+| %filter (不通过) | 0.2984 | 0.2389 | 0.0595 | 19.9% |
+| **谓词方法** | | | | |
+| %forall 方法 | 0.0354 | 0.0830 | -0.0476 | -134.5% |
+| %exists 方法 | 0.0383 | 0.0842 | -0.0459 | -119.8% |
+| %contains 方法 | 0.0318 | 0.0844 | -0.0526 | -165.4% |
+| %for-each 方法 | 0.0393 | 0.0851 | -0.0458 | -116.5% |
+| **比较方法** | | | | |
+| %equals 方法 | 1.6251 | 0.6306 | 0.9945 | 61.2% |
 
-define-final-class版本的 option 的性能
+## 性能分析总结
 
-=== Option 模块性能基准测试 ===
+### 性能提升显著的项目
+- **构造函数**：`define-final-class` 在对象构造方面有显著提升，约 43-46%
+- **转换方法**：`%map`、`%flat-map`、`%filter` 等方法有约 20-25% 的性能提升
+- **%equals 方法**：性能提升最为显著，达到 61.2%
 
-option 构造:            0.14159512519836426 秒
-none 构造:              0.12361502647399902 秒
-%get 方法:              0.07221794128417969 秒
-%get-or-else (有值):    0.08096098899841309 秒
-%get-or-else (无值):    0.07790994644165039 秒
-%defined? 方法:         0.07638001441955566 秒
-%empty? 方法:           0.0759739875793457 秒
-%map 方法:              0.23376202583312988 秒
-%flat-map 方法:         0.23461604118347168 秒
-%filter (通过):         0.23214292526245117 秒
-%filter (不通过):       0.23892498016357422 秒
-%forall 方法:   0.08304309844970703 秒
-%exists 方法:   0.08419609069824219 秒
-%contains 方法:         0.08438706398010254 秒
-%for-each 方法:         0.08509421348571777 秒
-%equals 方法:   0.6305508613586426 秒
+### 性能下降的项目
+- **访问方法**：`%get`、`%get-or-else`、`%defined?`、`%empty?` 等方法性能下降明显，约 120-210%
+- **谓词方法**：`%forall`、`%exists`、`%contains`、`%for-each` 等方法性能下降约 115-170%
 
-=== 测试完成 ===
+### 总体评估
+`define-final-class` 在复杂操作（如构造、转换、比较）方面表现更好，但在简单的访问和谓词方法上性能有所下降。这种性能模式表明 `define-final-class` 在对象生命周期管理方面更高效，但在方法调用开销上可能更高。
-- 
Gitee


From 490eb1ed76c4bba496deaa6d8ff2a71628935ff0 Mon Sep 17 00:00:00 2001
From: Da Shen <da@liii.pro>
Date: Tue, 4 Nov 2025 16:53:44 +0800
Subject: [PATCH 8/8] wip

---
 bench/option.scm         | 50 ++++++++++++++++++++++++++++-------
 devel/202_4.md           | 57 ++++++++++++++++++++++++----------------
 goldfish/liii/option.scm |  2 +-
 3 files changed, 76 insertions(+), 33 deletions(-)

diff --git a/bench/option.scm b/bench/option.scm
index 09d8869f..f12fa7fd 100644
--- a/bench/option.scm
+++ b/bench/option.scm
@@ -29,30 +29,60 @@
   (let ((time (timeit (lambda () (none)) :number 100000)))
     (display* "none 构造: \t\t" (number->string time) " 秒\n"))
 
-  ; 测试 %get 方法性能
+  ; 测试 %get 方法性能（包含构造时间）
+  (let ((time (timeit (lambda ()
+                        (let ((opt (option 42)))
+                          (opt :get))) :number 100000)))
+    (display* "%get 方法（含构造）: \t" (number->string time) " 秒\n"))
+
+  ; 测试 %get 方法性能（纯访问）
   (let ((opt (option 42)))
     (let ((time (timeit (lambda () (opt :get)) :number 100000)))
-      (display* "%get 方法: \t\t" (number->string time) " 秒\n")))
+      (display* "%get 方法（纯访问）: \t" (number->string time) " 秒\n")))
+
+  ; 测试 %get-or-else 方法性能（有值情况，包含构造时间）
+  (let ((time (timeit (lambda ()
+                        (let ((opt (option 42)))
+                          (opt :get-or-else 0))) :number 100000)))
+    (display* "%get-or-else (有值，含构造): " (number->string time) " 秒\n"))
 
-  ; 测试 %get-or-else 方法性能（有值情况）
+  ; 测试 %get-or-else 方法性能（有值情况，纯访问）
   (let ((opt (option 42)))
     (let ((time (timeit (lambda () (opt :get-or-else 0)) :number 100000)))
-      (display* "%get-or-else (有值): \t" (number->string time) " 秒\n")))
+      (display* "%get-or-else (有值，纯访问): " (number->string time) " 秒\n")))
+
+  ; 测试 %get-or-else 方法性能（无值情况，包含构造时间）
+  (let ((time (timeit (lambda ()
+                        (let ((opt (none)))
+                          (opt :get-or-else 0))) :number 100000)))
+    (display* "%get-or-else (无值，含构造): " (number->string time) " 秒\n"))
 
-  ; 测试 %get-or-else 方法性能（无值情况）
+  ; 测试 %get-or-else 方法性能（无值情况，纯访问）
   (let ((opt (none)))
     (let ((time (timeit (lambda () (opt :get-or-else 0)) :number 100000)))
-      (display* "%get-or-else (无值): \t" (number->string time) " 秒\n")))
+      (display* "%get-or-else (无值，纯访问): " (number->string time) " 秒\n")))
 
-  ; 测试 %defined? 方法性能
+  ; 测试 %defined? 方法性能（包含构造时间）
+  (let ((time (timeit (lambda ()
+                        (let ((opt (option 42)))
+                          (opt :defined?))) :number 100000)))
+    (display* "%defined? 方法（含构造）: \t" (number->string time) " 秒\n"))
+
+  ; 测试 %defined? 方法性能（纯访问）
   (let ((opt (option 42)))
     (let ((time (timeit (lambda () (opt :defined?)) :number 100000)))
-      (display* "%defined? 方法: \t" (number->string time) " 秒\n")))
+      (display* "%defined? 方法（纯访问）: \t" (number->string time) " 秒\n")))
+
+  ; 测试 %empty? 方法性能（包含构造时间）
+  (let ((time (timeit (lambda ()
+                        (let ((opt (none)))
+                          (opt :empty?))) :number 100000)))
+    (display* "%empty? 方法（含构造）: \t" (number->string time) " 秒\n"))
 
-  ; 测试 %empty? 方法性能
+  ; 测试 %empty? 方法性能（纯访问）
   (let ((opt (none)))
     (let ((time (timeit (lambda () (opt :empty?)) :number 100000)))
-      (display* "%empty? 方法: \t\t" (number->string time) " 秒\n")))
+      (display* "%empty? 方法（纯访问）: \t" (number->string time) " 秒\n")))
 
   ; 测试 %map 方法性能
   (let ((opt (option 42)))
diff --git a/devel/202_4.md b/devel/202_4.md
index f274c189..305a4ed4 100644
--- a/devel/202_4.md
+++ b/devel/202_4.md
@@ -12,37 +12,50 @@
 | 测试项目 | define-case-class (前) | define-final-class (后) | 性能提升 | 提升幅度 |
 |---------|----------------------|-----------------------|---------|---------|
 | **构造函数** | | | | |
-| option 构造 | 0.2486 | 0.1416 | 0.1070 | 43.0% |
-| none 构造 | 0.2313 | 0.1236 | 0.1077 | 46.5% |
-| **访问方法** | | | | |
-| %get 方法 | 0.0234 | 0.0722 | -0.0488 | -208.5% |
-| %get-or-else (有值) | 0.0311 | 0.0810 | -0.0499 | -160.5% |
-| %get-or-else (无值) | 0.0351 | 0.0779 | -0.0428 | -121.9% |
-| %defined? 方法 | 0.0283 | 0.0764 | -0.0481 | -170.0% |
-| %empty? 方法 | 0.0281 | 0.0760 | -0.0479 | -170.5% |
+| option 构造 | 0.2421 | 0.1465 | 0.0956 | 39.5% |
+| none 构造 | 0.2248 | 0.1396 | 0.0852 | 37.9% |
+| **访问方法（含构造）** | | | | |
+| %get 方法（含构造） | 0.2530 | 0.1863 | 0.0667 | 26.4% |
+| %get-or-else (有值，含构造) | 0.2736 | 0.1954 | 0.0782 | 28.6% |
+| %get-or-else (无值，含构造) | 0.2734 | 0.1964 | 0.0770 | 28.2% |
+| %defined? 方法（含构造） | 0.2582 | 0.2144 | 0.0438 | 17.0% |
+| %empty? 方法（含构造） | 0.2656 | 0.1943 | 0.0713 | 26.8% |
+| **访问方法（纯访问）** | | | | |
+| %get 方法（纯访问） | 0.0239 | 0.0702 | -0.0463 | -193.7% |
+| %get-or-else (有值，纯访问) | 0.0284 | 0.0748 | -0.0464 | -163.4% |
+| %get-or-else (无值，纯访问) | 0.0308 | 0.0764 | -0.0456 | -148.1% |
+| %defined? 方法（纯访问） | 0.0239 | 0.0740 | -0.0501 | -209.6% |
+| %empty? 方法（纯访问） | 0.0235 | 0.0730 | -0.0495 | -210.6% |
 | **转换方法** | | | | |
-| %map 方法 | 0.3121 | 0.2338 | 0.0783 | 25.1% |
-| %flat-map 方法 | 0.2943 | 0.2346 | 0.0597 | 20.3% |
-| %filter (通过) | 0.2926 | 0.2321 | 0.0605 | 20.7% |
-| %filter (不通过) | 0.2984 | 0.2389 | 0.0595 | 19.9% |
+| %map 方法 | 0.3055 | 0.2352 | 0.0703 | 23.0% |
+| %flat-map 方法 | 0.3000 | 0.2280 | 0.0720 | 24.0% |
+| %filter (通过) | 0.3019 | 0.2358 | 0.0661 | 21.9% |
+| %filter (不通过) | 0.3030 | 0.2327 | 0.0703 | 23.2% |
 | **谓词方法** | | | | |
-| %forall 方法 | 0.0354 | 0.0830 | -0.0476 | -134.5% |
-| %exists 方法 | 0.0383 | 0.0842 | -0.0459 | -119.8% |
-| %contains 方法 | 0.0318 | 0.0844 | -0.0526 | -165.4% |
-| %for-each 方法 | 0.0393 | 0.0851 | -0.0458 | -116.5% |
+| %forall 方法 | 0.0349 | 0.0853 | -0.0504 | -144.4% |
+| %exists 方法 | 0.0406 | 0.0873 | -0.0467 | -115.0% |
+| %contains 方法 | 0.0343 | 0.0849 | -0.0506 | -147.5% |
+| %for-each 方法 | 0.0408 | 0.0879 | -0.0471 | -115.4% |
 | **比较方法** | | | | |
-| %equals 方法 | 1.6251 | 0.6306 | 0.9945 | 61.2% |
+| %equals 方法 | 1.6711 | 0.6679 | 1.0032 | 60.0% |
 
 ## 性能分析总结
 
 ### 性能提升显著的项目
-- **构造函数**：`define-final-class` 在对象构造方面有显著提升，约 43-46%
-- **转换方法**：`%map`、`%flat-map`、`%filter` 等方法有约 20-25% 的性能提升
-- **%equals 方法**：性能提升最为显著，达到 61.2%
+- **构造函数**：`define-final-class` 在对象构造方面有显著提升，约 38-40%
+- **访问方法（含构造）**：包含对象构造的访问方法整体性能提升约 17-29%，其中 %get-or-else 方法提升约 28%，%get 方法提升约 26%
+- **转换方法**：`%map`、`%flat-map`、`%filter` 等方法有约 22-24% 的性能提升
+- **%equals 方法**：性能提升最为显著，达到 60.0%
 
 ### 性能下降的项目
-- **访问方法**：`%get`、`%get-or-else`、`%defined?`、`%empty?` 等方法性能下降明显，约 120-210%
-- **谓词方法**：`%forall`、`%exists`、`%contains`、`%for-each` 等方法性能下降约 115-170%
+- **访问方法（纯访问）**：不包含构造的纯方法访问性能下降明显，约 148-211%
+- **谓词方法**：`%forall`、`%exists`、`%contains`、`%for-each` 等方法性能下降约 115-144%
 
 ### 总体评估
 `define-final-class` 在复杂操作（如构造、转换、比较）方面表现更好，但在简单的访问和谓词方法上性能有所下降。这种性能模式表明 `define-final-class` 在对象生命周期管理方面更高效，但在方法调用开销上可能更高。
+
+**关键发现**：
+- 当考虑对象构造时，`define-final-class` 在访问方法上仍然有 17-29% 的性能提升
+- 纯方法调用（不包含构造）的性能下降更加明显，说明 `define-final-class` 的方法调用开销更高
+- 在实际使用场景中，通常需要构造对象后再进行方法调用，因此 `define-final-class` 的整体性能表现可能更好
+
diff --git a/goldfish/liii/option.scm b/goldfish/liii/option.scm
index 08c3433a..77dc64bb 100644
--- a/goldfish/liii/option.scm
+++ b/goldfish/liii/option.scm
@@ -19,7 +19,7 @@
   (export option none)
   (begin
 
-    (define-final-class option ((value any?))
+    (define-case-class option ((value any?))
 
       (define (%get)
         (if (null? value)
-- 
Gitee