Reference implementation attempts to mutate possibly immutable hash table. Zhu Zihao (11 Jul 2025 17:54 UTC)
(missing)

Reference implementation attempts to mutate possibly immutable hash table. Zhu Zihao 11 Jul 2025 17:38 UTC
While packaging SRFI-165 for Guix, I found 4 of tests [SRFI-165-test] are failed.

These tests are all try to mutate an immutable hash-table, take 1 as an example:

Test begin:
  source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld"
  source-line: 91
  source-form: (test-eqv 42 (let ((x (make-computation-environment-variable (quote x) #f #f)) (env (make-computation-environment))) (computation-environment-update! env x 42) (computation-environment-ref env x)))
Test end:
  result-kind: fail
  actual-value: #f
  actual-error: (misc-error #f "Hashtable is immutable. ~S" (#hasheq()) #f)
  expected-value: 42

This is probably caused by attempting to mutate an immutable hash-table
created by 'hash-table' procedure in SRFI-125 [SRFI-125-spec].

At line 85, the source is

```
(define-syntax %define-computation-type
  (syntax-rules ()
    ((_ make-environment run () n ((var default e immutable i) ...))
     (begin
       (define-values (e ...) (values default ...))
       (define var (make-environment-variable 'var e immutable i))
       ...
       (define (make-environment)
	 (let ((env (make-vector (+ n 2))))
	   (environment-set-global! env (hash-table variable-comparator))
            ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
	   (environment-set-local! env (mapping variable-comparator))
	   (vector-set! env (+ i 2) (box e))
```

And at line 134, the source is

```
(define (computation-environment-update! env var val)
  (if (predefined? var)
      (set-box! (environment-cell env var) val)
      (mapping-ref (environment-local env)
		   var
		   (lambda ()
		     (hash-table-set! (environment-global env) var val))
                     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
		   (lambda (cell)
		     (set-box! cell val)))))
```

SRFI-125 specification says:

```
 (hash-table comparator [ key value ] ...)

Returns a newly allocated hash table, created as if by make-hash-table using comparator. For each pair of arguments, an association is added to the new hash table with key as its key and value as its value. If the implementation supports immutable hash tables, this procedure returns an immutable hash table. If the same key (in the sense of the equality predicate) is specified more than once, it is an error.
```

And the reference implementation of SRFI-125 [SRFI-125-source] does return the
immutable one, when attempting to mutate it, Guile raise an exception.

I'm not sure how to fix it, SRFI-125 doesn't provides a good way to
create mutable hash-table (we can only create an immutable one, and copy
it as mutable). Maybe use `make-hash-table`, but it's a deprecated interface.

[SRFI-165-test]: https://gitlab.com/nieper/show/-/blob/master/srfi/165/test.sld?ref_type=heads
[SRFI-125-spec]: https://srfi.schemers.org/srfi-125/srfi-125.html
[SRFI-125-source]: https://github.com/scheme-requests-for-implementation/srfi-125/blob/master/srfi/125.body.scm#L257

Full log attached below:

%%%% Starting test SRFI 165
Group begin: SRFI 165
Test begin:
  source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld"
  source-line: 36
  source-form: (test-assert (not (eqv? (make-computation-environment-variable (quote x) #f #f) (make-computation-environment-variable (quote x) #f #f))))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld"
  source-line: 39
  source-form: (test-assert (make-computation-environment))
Test end:
  result-kind: pass
  actual-value: #(#hasheq() #<<mapping> comparator: #<comparator type-test: #<procedure %environment-variable?-procedure (obj)> equality: #<procedure eq? (#:optional _ _ . _)> ordering: #<procedure 7f07539cbee0 at srfi/srfi-165/165-impl.scm:44:19 (x y)> hash: #<procedure 7f07539cbec0 at srfi/srfi-165/165-impl.scm:47:19 (x . y)> ordering?: #t hash?: #t> tree: #(black #f #f #f)>)
Test begin:
  source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld"
  source-line: 41
  source-form: (test-assert (make-environment))
Test end:
  result-kind: pass
  actual-value: #(#hasheq() #<<mapping> comparator: #<comparator type-test: #<procedure %environment-variable?-procedure (obj)> equality: #<procedure eq? (#:optional _ _ . _)> ordering: #<procedure 7f07539cbee0 at srfi/srfi-165/165-impl.scm:44:19 (x y)> hash: #<procedure 7f07539cbec0 at srfi/srfi-165/165-impl.scm:47:19 (x . y)> ordering?: #t hash?: #t> tree: #(black #f #f #f)> #<box 7f0752577520#f> #<box 7f0752577510#f>)
Test begin:
  source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld"
  source-line: 43
  source-form: (test-eqv #f (let ((x (make-computation-environment-variable (quote x) #f #f))) (computation-environment-ref (make-computation-environment) x)))
Test end:
  result-kind: pass
  actual-value: #f
  expected-value: #f
Test begin:
  source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld"
  source-line: 47
  source-form: (test-eqv 42 (let ((x (make-computation-environment-variable (quote x) 42 #f))) (computation-environment-ref (make-computation-environment) x)))
Test end:
  result-kind: pass
  actual-value: 42
  expected-value: 42
Test begin:
  source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld"
  source-line: 51
  source-form: (test-eqv #f (computation-environment-ref (make-environment) z))
Test end:
  result-kind: pass
  actual-value: #f
  expected-value: #f
Test begin:
  source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld"
  source-line: 54
  source-form: (test-eqv 42 (let ((x (make-computation-environment-variable (quote x) #f #f))) (computation-environment-ref (computation-environment-update (make-computation-environment) x 42) x)))
Test end:
  result-kind: pass
  actual-value: 42
  expected-value: 42
Test begin:
  source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld"
  source-line: 60
  source-form: (test-eqv 10 (let ((x (make-computation-environment-variable (quote x) #f #f)) (y (make-computation-environment-variable (quote y) #f #f))) (computation-environment-ref (computation-environment-update (make-computation-environment) x 42 y 10) y)))
Test end:
  result-kind: pass
  actual-value: 10
  expected-value: 10
Test begin:
  source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld"
  source-line: 67
  source-form: (test-eqv 42 (computation-environment-ref (computation-environment-update (make-environment) z 42) z))
Test end:
  result-kind: pass
  actual-value: 42
  expected-value: 42
Test begin:
  source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld"
  source-line: 72
  source-form: (test-eqv #f (let ((x (make-computation-environment-variable (quote x) #f #f)) (y (make-computation-environment-variable (quote y) #f #f))) (computation-environment-ref (computation-environment-update (make-computation-environment) x 42) y)))
Test end:
  result-kind: pass
  actual-value: #f
  expected-value: #f
Test begin:
  source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld"
  source-line: 79
  source-form: (test-eqv #f (let ((y (make-computation-environment-variable (quote y) #f #f))) (computation-environment-ref (computation-environment-update (make-environment) z 42) y)))
Test end:
  result-kind: pass
  actual-value: #f
  expected-value: #f
Test begin:
  source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld"
  source-line: 85
  source-form: (test-eqv #f (let ((x (make-computation-environment-variable (quote x) #f #f)) (env (make-computation-environment))) (computation-environment-update env x 42) (computation-environment-ref env x)))
Test end:
  result-kind: pass
  actual-value: #f
  expected-value: #f
Test begin:
  source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld"
  source-line: 91
  source-form: (test-eqv 42 (let ((x (make-computation-environment-variable (quote x) #f #f)) (env (make-computation-environment))) (computation-environment-update! env x 42) (computation-environment-ref env x)))
Test end:
  result-kind: fail
  actual-value: #f
  actual-error: (misc-error #f "Hashtable is immutable. ~S" (#hasheq()) #f)
  expected-value: 42
Test begin:
  source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld"
  source-line: 97
  source-form: (test-eqv 42 (let ((env (make-environment))) (computation-environment-update! env z 42) (computation-environment-ref env z)))
Test end:
  result-kind: pass
  actual-value: 42
  expected-value: 42
Test begin:
  source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld"
  source-line: 102
  source-form: (test-eqv 42 (let ((x (make-computation-environment-variable (quote x) #f #f)) (env (make-computation-environment))) (computation-environment-update! env x 42) (computation-environment-update env x 10) (computation-environment-ref env x)))
Test end:
  result-kind: fail
  actual-value: #f
  actual-error: (misc-error #f "Hashtable is immutable. ~S" (#hasheq()) #f)
  expected-value: 42
Test begin:
  source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld"
  source-line: 109
  source-form: (test-eqv 42 (let ((env (make-environment))) (computation-environment-update! env z 42) (computation-environment-update env z 10) (computation-environment-ref env z)))
Test end:
  result-kind: pass
  actual-value: 42
  expected-value: 42
Test begin:
  source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld"
  source-line: 115
  source-form: (test-eqv #f (let ((x (make-computation-environment-variable (quote x) #f #f)) (env (make-computation-environment))) (computation-environment-update! (computation-environment-update env x 10) x 42) (computation-environment-ref env x)))
Test end:
  result-kind: pass
  actual-value: #f
  expected-value: #f
Test begin:
  source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld"
  source-line: 122
  source-form: (test-eqv #f (let ((env (make-environment))) (computation-environment-update! (computation-environment-update env z 10) z 42) (computation-environment-ref env z)))
Test end:
  result-kind: pass
  actual-value: #f
  expected-value: #f
Test begin:
  source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld"
  source-line: 128
  source-form: (test-eqv 42 (let ((x (make-computation-environment-variable (quote x) #f #f)) (y (make-computation-environment-variable (quote y) #f #f)) (env (make-computation-environment))) (computation-environment-update! (computation-environment-update env y 10) x 42) (computation-environment-ref env x)))
Test end:
  result-kind: fail
  actual-value: #f
  actual-error: (misc-error #f "Hashtable is immutable. ~S" (#hasheq()) #f)
  expected-value: 42
Test begin:
  source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld"
  source-line: 136
  source-form: (test-eqv 42 (let ((env (make-environment))) (computation-environment-update! (computation-environment-update env w 10) z 42) (computation-environment-ref env z)))
Test end:
  result-kind: pass
  actual-value: 42
  expected-value: 42
Test begin:
  source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld"
  source-line: 142
  source-form: (test-eqv 42 (let* ((x (make-computation-environment-variable (quote x) #f #f)) (env (computation-environment-update (make-computation-environment) x 42)) (copy (computation-environment-copy env))) (computation-environment-update! env x 10) (computation-environment-ref copy x)))
Test end:
  result-kind: pass
  actual-value: 42
  expected-value: 42
Test begin:
  source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld"
  source-line: 150
  source-form: (test-eqv 42 (let* ((env (computation-environment-update (make-environment) z 42)) (copy (computation-environment-copy env))) (computation-environment-update! env z 10) (computation-environment-ref copy z)))
Test end:
  result-kind: pass
  actual-value: 42
  expected-value: 42
Test begin:
  source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld"
  source-line: 157
  source-form: (test-eqv #f (let ((flag #f)) (make-computation (lambda (compute) (set! flag #t))) flag))
Test end:
  result-kind: pass
  actual-value: #f
  expected-value: #f
Test begin:
  source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld"
  source-line: 164
  source-form: (test-eqv 42 (computation-run (make-computation (lambda (compute) 42))))
Test end:
  result-kind: pass
  actual-value: 42
  expected-value: 42
Test begin:
  source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld"
  source-line: 169
  source-form: (test-eqv 42 (computation-run (make-computation (lambda (compute) (compute (computation-pure 42))))))
Test end:
  result-kind: pass
  actual-value: 42
  expected-value: 42
Test begin:
  source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld"
  source-line: 174
  source-form: (test-equal (quote (10 42)) (call-with-values (lambda () (computation-run (make-computation (lambda (compute) (compute (computation-pure 10 42)))))) list))
Test end:
  result-kind: pass
  actual-value: (10 42)
  expected-value: (10 42)
Test begin:
  source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld"
  source-line: 182
  source-form: (test-equal (quote (42 (b a))) (let* ((acc (quote ())) (result (computation-run (computation-each (make-computation (lambda (compute) (set! acc (cons (quote a) acc)))) (make-computation (lambda (compute) (set! acc (cons (quote b) acc)) 42)))))) (list result acc)))
Test end:
  result-kind: pass
  actual-value: (42 (b a))
  expected-value: (42 (b a))
Test begin:
  source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld"
  source-line: 194
  source-form: (test-equal (quote (42 (b a))) (let* ((acc (quote ())) (result (computation-run (computation-each-in-list (list (make-computation (lambda (compute) (set! acc (cons (quote a) acc)))) (make-computation (lambda (compute) (set! acc (cons (quote b) acc)) 42))))))) (list result acc)))
Test end:
  result-kind: pass
  actual-value: (42 (b a))
  expected-value: (42 (b a))
Test begin:
  source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld"
  source-line: 207
  source-form: (test-equal 83 (computation-run (computation-bind (computation-pure 42) (lambda (x) (computation-pure (* x 2))) (lambda (x) (computation-pure (- x 1))))))
Test end:
  result-kind: pass
  actual-value: 83
  expected-value: 83
Test begin:
  source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld"
  source-line: 214
  source-form: (test-equal (list 42 84) (computation-run (computation-sequence (list (computation-pure 42) (computation-pure 84)))))
Test end:
  result-kind: pass
  actual-value: (42 84)
  expected-value: (42 84)
Test begin:
  source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld"
  source-line: 219
  source-form: (test-equal (quote (42 #f)) (let ((x (make-computation-environment-variable (quote x) #f #f))) (computation-run (make-computation (lambda (compute) (let ((a (compute (computation-local (lambda (env) (computation-environment-update env x 42)) (computation-bind (computation-ask) (lambda (env) (computation-pure (computation-environment-ref env x)))))))) (list a (computation-environment-ref (compute (computation-ask)) x))))))))
Test end:
  result-kind: pass
  actual-value: (42 #f)
  expected-value: (42 #f)
Test begin:
  source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld"
  source-line: 235
  source-form: (test-eqv 42 (let ((x (make-computation-environment-variable (quote x) #f #f))) (computation-run (computation-with ((x 42)) (computation-fn ((y x)) (computation-pure y))))))
Test end:
  result-kind: pass
  actual-value: 42
  expected-value: 42
Test begin:
  source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld"
  source-line: 241
  source-form: (test-eqv 42 (run (computation-with ((z 42)) (computation-fn ((y z)) (computation-pure y)))))
Test end:
  result-kind: pass
  actual-value: 42
  expected-value: 42
Test begin:
  source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld"
  source-line: 246
  source-form: (test-eqv 42 (let ((x (make-computation-environment-variable (quote x) #f #f))) (computation-run (computation-with ((x 42)) (computation-fn (x) (computation-pure x))))))
Test end:
  result-kind: pass
  actual-value: 42
  expected-value: 42
Test begin:
  source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld"
  source-line: 252
  source-form: (test-eqv #f (let ((x (make-computation-environment-variable (quote x) #f #f))) (computation-run (computation-each (computation-with ((x 42)) (computation-fn ((y x)) (computation-pure y))) (computation-fn ((y x)) (computation-pure y))))))
Test end:
  result-kind: pass
  actual-value: #f
  expected-value: #f
Test begin:
  source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld"
  source-line: 260
  source-form: (test-eqv 42 (let ((x (make-computation-environment-variable (quote x) #f #f))) (computation-run (computation-each (computation-with! (x 42)) (computation-fn ((y x)) (computation-pure y))))))
Test end:
  result-kind: fail
  actual-value: #f
  actual-error: (misc-error #f "Hashtable is immutable. ~S" (#hasheq()) #f)
  expected-value: 42
Test begin:
  source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld"
  source-line: 266
  source-form: (test-eqv #f (let ((x (make-computation-environment-variable (quote x) #f #f))) (computation-run (computation-forked (computation-with! (x 42)) (computation-fn ((y x)) (computation-pure y))))))
Test end:
  result-kind: pass
  actual-value: #f
  expected-value: #f
Test begin:
  source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld"
  source-line: 272
  source-form: (test-equal (list #f 2) (let ((x (make-computation-environment-variable (quote x) #f #f))) (computation-run (computation-bind/forked (computation-each (computation-with! (x 42)) (computation-pure 2)) (lambda (z) (computation-fn ((y x)) (computation-pure (list y z))))))))
Test end:
  result-kind: pass
  actual-value: (#f 2)
  expected-value: (#f 2)
Test begin:
  source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld"
  source-line: 282
  source-form: (test-eqv 42 (computation-run (computation-with ((default-computation computation-pure)) 42)))
Test end:
  result-kind: pass
  actual-value: 42
  expected-value: 42
Test begin:
  source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld"
  source-line: 288
  source-form: (test-eqv 42 (let ((x (make-computation-environment-variable (quote x) #f #f))) (computation-run (computation-with ((x 10)) (computation-with ((x 42)) (computation-fn ((x x)) (computation-pure x)))))))
Test end:
  result-kind: pass
  actual-value: 42
  expected-value: 42
Test begin:
  source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld"
  source-line: 295
  source-form: (test-equal (list 10 42) (let ((x (make-computation-environment-variable (quote x) #f #f)) (y (make-computation-environment-variable (quote y) #f #f))) (computation-run (computation-with ((x 10) (y 42)) (computation-fn (x y) (computation-pure (list x y)))))))
Test end:
  result-kind: pass
  actual-value: (10 42)
  expected-value: (10 42)
Test begin:
  source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld"
  source-line: 302
  source-form: (test-equal (list 10 42) (run (computation-with ((z 10) (w 42)) (computation-fn (z w) (computation-pure (list z w))))))
Test end:
  result-kind: pass
  actual-value: (10 42)
  expected-value: (10 42)
Test begin:
  source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld"
  source-line: 307
  source-form: (test-equal (list 10 42) (let () (define-computation-type make-environment run (x 10) (y 42 "immutable")) (run (computation-fn (x y) (computation-pure (list x y))))))
Test end:
  result-kind: pass
  actual-value: (10 42)
  expected-value: (10 42)
Group end: SRFI 165
# of expected passes      39
# of unexpected failures  4
--
Retrieve my PGP public key:
执行下列命令以获取我的 PGP 公有密钥:

  gpg --recv-keys B3EBC086AB0EBC0F45E0B4D433DB374BCEE4D9DC

Zihao