diff options
| author |  Peter McGoron
| 2025-11-15 06:14:11 -0500 |
|---|---|---|
| committer | Peter McGoron
| 2025-11-15 06:14:11 -0500 |
| commit | e6fff3a15c916693a6a5cea1f9ae861b13b1e530 (patch) | |
| tree | fe89ff73f84b34fdd895bc04f6ba6bbc6308d6f2 | |
| parent | use srfi-146 when full srfi-225 is available for chibi (diff) | |
fix cycle counter
| -rw-r--r-- | lib/cuprate/implementation.sld | 42 | ||||
| -rw-r--r-- | lib/cuprate/implementation/alist-eq-map.scm | 2 |
2 files changed, 24 insertions, 20 deletions
diff --git a/lib/cuprate/implementation.sld b/lib/cuprate/implementation.sld index 61849c1..f90e968 100644 --- a/lib/cuprate/implementation.sld +++ b/lib/cuprate/implementation.sld @@ -24,22 +24,26 @@ (cons vector? default-on-vector) (cons error-object? default-on-error)))) (define (rewrite-enter rewriters obj) - (letrec ((eq-map (make-eq-map)) - (rewrite - (lambda (obj) - (if (eq-map 'contains? obj) - (eq-map 'cycle-counter obj) - (begin - (eq-map 'intern! obj) - (let loop ((rewriters rewriters)) - (cond - ((null? rewriters) obj) - (((caar rewriters) obj) - (let ((new-obj ((cdar rewriters) rewrite obj))) - (if (eq-map 'cycle-used? obj) - (list (eq-map 'cycle-counter) - '= - new-obj) - new-obj))) - (else (loop (cdr rewriters)))))))))) - (rewrite obj)))))
\ No newline at end of file + (define eq-map (make-eq-map)) + (define (loop obj rewriters) + (cond + ((null? rewriters) obj) + (((caar rewriters) obj) + (let ((new-obj ((cdar rewriters) rewrite obj))) + (if (eq-map 'cycle-used? obj) + (list (eq-map 'cycle-counter) + '= + new-obj) + new-obj))) + (else (loop obj (cdr rewriters))))) + (define (rewrite obj) + (cond + ((or (symbol? obj) (number? obj) (char? obj) + (null? obj) (boolean? obj)) + obj) + ((eq-map 'contains? obj) + (eq-map 'cycle-counter obj)) + (else + (eq-map 'intern! obj) + (loop obj rewriters)))) + (rewrite obj))))
\ No newline at end of file diff --git a/lib/cuprate/implementation/alist-eq-map.scm b/lib/cuprate/implementation/alist-eq-map.scm index f9841e7..42097c0 100644 --- a/lib/cuprate/implementation/alist-eq-map.scm +++ b/lib/cuprate/implementation/alist-eq-map.scm @@ -4,7 +4,7 @@ (define counter 0) (lambda (msg obj) (case msg - ((contains?) (assq obj alist)) + ((contains?) (pair? (assq obj alist))) ((cycle-counter) (set! interned-alist (cons obj interned-alist)) (let ((num (cdr (assq obj alist)))) |