[210_10] 实现 bag 构造器、访问器与谓词

devel/210_10.md

@@ -0,0 +1,36 @@
+# [210_10] 实现 bag 基础能力（SRFI-113）
+
+## 任务相关的代码文件
+- goldfish/srfi/srfi-113.scm
+- goldfish/liii/bag.scm
+- tests/goldfish/liii/bag-test.scm
+
+## 如何测试
+```bash
+bin/goldfish tests/goldfish/liii/bag-test.scm
+```
+
+## 2026/01/29 实现 bag 构造器、访问器与谓词
+### What
+实现 SRFI-113 的 bag 基础构造、访问与谓词函数，并在 (liii bag) 中提供默认比较器封装与测试用例。
+
+1. 在 goldfish/srfi/srfi-113.scm 中实现 bag / bag-unfold / bag-member / bag-element-comparator / bag->list，并添加到导出列表
+2. 在 goldfish/liii/bag.scm 中提供默认比较器版本的 bag，并导出上述函数
+3. 在 tests/goldfish/liii/bag-test.scm 中添加文档注释与覆盖测试（含错误分支）
+4. 在 goldfish/srfi/srfi-113.scm 中实现 bag? / bag-contains? / bag-empty? / bag-disjoint? 并添加到导出列表
+5. 在 goldfish/liii/bag.scm 中导出以上谓词
+6. 在 tests/goldfish/liii/bag-test.scm 中添加注释与测试（含类型错误分支）
+
+### Why
+提供多重集（bag）的最小可用接口，用于存储重复元素并支持基础查询与遍历输出。
+
+### How
+1. bag 使用 comparator 构造，插入时按 comparator 相等性累加计数
+2. bag-unfold 使用 unfold 模式生成 bag
+3. bag-member 返回 bag 中等价元素，未命中返回默认值
+4. bag->list 将元素按计数展开为列表
+5. bag? 使用 record-type 生成的谓词
+6. bag-contains? 使用 comparator 相等性在线性扫描 entries
+7. bag-empty? 检查 entries 是否为空
+8. bag-disjoint? 逐元素比对，找到相等元素立即返回 #f
+9. 关键路径与类型错误通过测试覆盖

goldfish/liii/bag.scm

@@ -0,0 +1,33 @@
+;
+; Copyright (C) 2026 The Goldfish Scheme Authors
+;
+; Licensed under the Apache License, Version 2.0 (the "License");
+; you may not use this file except in compliance with the License.
+; You may obtain a copy of the License at
+;
+; http://www.apache.org/licenses/LICENSE-2.0
+;
+; Unless required by applicable law or agreed to in writing, software
+; distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
+; WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
+; License for the specific language governing permissions and limitations
+; under the License.
+;
+
+(define-library (liii bag)
+  (import (rename (srfi srfi-113)
+                  (bag make-bag-with-comparator))
+          (only (srfi srfi-113)
+                bag-unfold bag-member bag-comparator bag->list
+                bag? bag-contains? bag-empty? bag-disjoint?)
+          (srfi srfi-128))
+  (export bag bag-unfold bag-member bag-comparator
+          bag->list
+          bag? bag-contains? bag-empty? bag-disjoint?)
+
+  (define comp (make-default-comparator))
+
+  (define (bag . elements)
+    (apply make-bag-with-comparator comp elements))
+
+) ; end of define-library

goldfish/srfi/srfi-113.scm

@@ -37,7 +37,9 @@
           set-partition set-partition! set-union set-intersection set-difference set-xor
           set-union! set-intersection! set-difference! set-xor!
           set-adjoin set-adjoin! set-replace set-replace!
-          set-delete set-delete! set-delete-all set-delete-all!)
+          set-delete set-delete! set-delete-all set-delete-all!
+          bag bag-unfold bag-member bag-comparator bag->list
+          bag? bag-contains? bag-empty? bag-disjoint?)
   (begin
 
     (define-record-type set-impl
@@ -550,5 +552,97 @@
     (define (set-delete-all set element-list)
       (apply set-delete set element-list))
 
+    (define-record-type bag-impl
+      (%make-bag entries comparator)
+      bag?
+      (entries bag-entries set-bag-entries!)
+      (comparator bag-comparator))
+
+    (define (check-bag obj)
+      (when (not (bag? obj)) (type-error "not a bag" obj)))
+
+    (define (make-bag/comparator comparator)
+      (if (comparator? comparator)
+          (%make-bag (make-hash-table comparator) comparator)
+          (type-error "make-bag/comparator")))
+
+    (define (bag-increment! bag element count)
+      (check-bag bag)
+      (unless (and (exact-integer? count) (>= count 0))
+          (type-error "bag-increment!" count))
+      (if (= count 0)
+          bag
+          (let* ((entries (bag-entries bag))
+                 (entry (hash-table-ref/default entries element 0)))
+            (hash-table-set! entries element (+ count entry))
+            bag)))
+
+    (define (bag-decrement! bag element count)
+      (check-bag bag)
+      (if (not (and (exact-integer? count) (>= count 0)))
+          (type-error "bag-decrement!" count))
+      (if (= count 0)
+          bag
+          (let* ((entries (bag-entries bag))
+                 (entry (hash-table-ref/default entries element 0)))
+              (if (> entry count)
+                  (hash-table-set! entries element (- entry count))
+                  (hash-table-delete! entries element))
+            bag)))
+
+    (define (bag-contains? bag element)
+      (check-bag bag)
+      (hash-table-contains? (bag-entries bag) element))
+
+    (define (bag-empty? bag)
+      (check-bag bag)
+      (hash-table-empty? (bag-entries bag)))
+
+    (define (bag-disjoint? a b)
+      (check-bag a)
+      (check-bag b)
+      (let ((entries-a (bag-entries a))
+            (entries-b (bag-entries b)))
+        (call/cc
+          (lambda (return)
+            (hash-table-for-each
+             (lambda (k entry)
+               (when (hash-table-contains? entries-b k)
+                 (return #f)))
+             entries-a)
+            #t))))
+
+    (define (bag comparator . elements)
+      (let ((result (make-bag/comparator comparator)))
+        (for-each (lambda (x) (bag-increment! result x 1)) elements)
+        result))
+
+    (define (bag-unfold stop? mapper successor seed comparator)
+      (let ((result (make-bag/comparator comparator)))
+        (let loop ((seed seed))
+          (if (stop? seed)
+              result
+              (begin
+                (bag-increment! result (mapper seed) 1)
+                (loop (successor seed)))))))
+
+    (define (bag-member bag element default)
+      (check-bag bag)
+      (if (hash-table-contains? (bag-entries bag) element)
+          element
+          default))
+
+    (define (bag->list bag)
+      (check-bag bag)
+      (let ((result '()))
+        (hash-table-for-each
+         (lambda (k entry)
+           (let loop ((i 0))
+             (when (< i entry)
+               (set! result (cons k result))
+               (loop (+ i 1)))))
+         (bag-entries bag))
+        result))
+
     ) ; end of begin
   ) ; end of define-library

goldfish/srfi/srfi-125.scm

@@ -15,7 +15,7 @@
 ;
 
 (define-library (srfi srfi-125)
-  (import (srfi srfi-1) (liii base) (liii error))
+  (import (srfi srfi-1) (srfi srfi-128) (liii base) (liii error))
   (export make-hash-table hash-table hash-table-unfold alist->hash-table hash-table?
           hash-table-contains? hash-table-empty? hash-table=? hash-table-mutable? hash-table-ref
           hash-table-ref/default hash-table-set! hash-table-delete! hash-table-intern!
@@ -139,4 +139,3 @@
     (define hash-table->alist
       (typed-lambda ((ht hash-table?))
         (append-map (lambda (x) (list (car x) (cdr x))) (map values ht))))))
-