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 /lib/cuprate/implementation.sld | |
| parent | use srfi-146 when full srfi-225 is available for chibi (diff) | |
fix cycle counter
Diffstat (limited to '')
| -rw-r--r-- | lib/cuprate/implementation.sld | 42 |
1 files changed, 23 insertions, 19 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 |