Opened 11 years ago

Closed 11 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)))))

Change History (1)

comment:1 Changed 11 years ago by felix winkelmann

Resolution: fixed
Status: newclosed

Has been replaced in r14398.

Note: See TracTickets for help on using tickets.