Opened 17 years ago
Closed 17 years ago
#11 closed enhancement (fixed)
replace ##sys#strip-syntax with version that handles cyclic structures
| Reported by: | felix winkelmann | Owned by: | felix winkelmann |
|---|---|---|---|
| Priority: | minor | Milestone: | |
| Component: | core libraries | Version: | 4.0.0 |
| Keywords: | Cc: | ||
| Estimated difficulty: |
Description
Alex Shinn contributed this enhanced version (verify and replace):
(define (##sys#strip-syntax exp #!optional se alias)
;; if se is given, retain bound vars
(let ((seen '()))
(let walk ((x exp))
(cond ((assq x seen) => cdr)
((symbol? x)
(let ((x2 (if se
(lookup x se)
(get x '##core#macro-alias) ) ) )
(cond ((get x '##core#real-name))
((and alias (not (assq x se)))
(##sys#alias-global-hook x #f))
((not x2) x)
((pair? x2) x)
(else x2))))
((pair? x)
(let ((cell (cons #f #f)))
(set! seen (cons (cons x cell) seen))
(set-car! cell (walk (car x)))
(set-cdr! cell (walk (cdr x)))
cell))
((vector? x)
(let ((vec (make-vector (vector-length x))))
(set! seen (cons (cons x vec) seen))
(do ((ls (map walk (vector->list x)) (cdr ls)) (i 0 (+ i 1)))
((null? ls) vec)
(vector-set! vec i (car ls)))))
(else x)))))
Note: See
TracTickets for help on using
tickets.

Has been replaced in r14398.