Make generic referencer work on <mv-box>

#1038

ChangeLog

@@ -1,5 +1,8 @@
 2024-06-05  Shiro Kawai  <shiro@acm.org>
 
+	* src/libobj.scm (ref): Make generic referencer work on <mv-box>.
+	  https://github.com/shirok/Gauche/issues/1038.
+
 	* lib/gauche/interactive/completion.scm (%complete-symbol): Exclude
 	  verbose method names from completion candidates.
 	  Cf. https://github.com/shirok/Gauche/issues/1039

src/libobj.scm

@@ -791,16 +791,25 @@
 (define-method (setter ref) :locked ((obj <tree-map>) key value)
   (tree-map-put! obj key value))
 
-(define-method ref  ((obj <box>) field) ; SRFI-123
-  (unless (eq? field '*)
-    (error "Box content can be accessed with a field name '*, but got:"
-           field))
-  (unbox obj))
+(define-method ref :locked ((obj <box>) field)
+  (case field
+    [(* 0) (unbox obj)]                 ;'* for srfi-123
+    [else
+     (error "Bad field name for box reference. Exact integer or '*, but got:"
+            field)]))
 (define-method (setter ref) :locked ((obj <box>) field value)
-  (unless (eq? field '*)
-    (error "Box content can be accessed with a field name '*, but got:"
-           field))
-  (set-box! obj value))
+  (case field
+    [(* 0) (set-box! obj value)]        ;'* for srfi-123
+    [else
+     (error "Bad field name for box reference. Exact integer or '*, but got:"
+            field)]))
+
+(define-method ref :locked ((obj <mv-box>) field)
+  (assume (exact-integer? field))
+  (unbox-value obj field))
+(define-method (setter ref) :locked ((obj <mv-box>) field value)
+  (assume (exact-integer? field))
+  (set-box-value! obj field value))
 
 ;; gauche.sequence has the generic version for <sequence>, but these
 ;; shortcuts would be faster.

test/srfi.scm

@@ -1720,6 +1720,27 @@
          (let1 b (box 1 2)
            (set-box! b 0 b)
            (write-to-string b)))
+
+  ;; Gauche specific - generic referencer
+  (let ([b0 (box 1)]
+        [b1 (box 1 2 3)])
+    (test* "box generic referencer" '(1 1 2 3)
+           (let ([a (~ b0 '*)]          ;srfi-122
+                 [b (~ b0 0)])
+             (set! (~ b0 0) 2)
+             (let ([c (~ b0 '*)])
+               (set! (~ b0 '*) 3)
+               (let ([d (~ b0 0)])
+                 (list a b c d)))))
+    (test* "mvbox generic referencer" '(1 2 3 10 20 30)
+           (let ([a (~ b1 0)]
+                 [b (~ b1 1)]
+                 [c (~ b1 2)])
+             (set! (~ b1 0) 10)
+             (set! (~ b1 1) 20)
+             (set! (~ b1 2) 30)
+             (list* a b c (values->list (unbox b1)))))
+    )
   )
 
 ;;-----------------------------------------------------------------------