Summary

replace ##sys#strip-syntax with version that handles cyclic structures

Metadata

• Id: 494175f9d7c36ecf26afe5f293357cfd41274566
• Trac id: 11
• Type: enhancement
• Reporter: felix
• Owner: felix
• Cc:
• Status: closed
• Component: core libraries
• Estimated difficulty:
• Resolution: fixed
• Priority: minor
• Milestone:
• Version: 4.0.0
• Changetime: 2009-04-23 10:33:42 UTC
• Created: 2009-04-18 13:11:09 UTC
• Keywords:

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

Changes and comments

[2009-04-23 10:33:42 UTC] felix changed status from new to closed

[2009-04-23 10:33:42 UTC] felix set resolution to fixed

[2009-04-23 10:33:42 UTC] felix wrote:

Has been replaced in r14398.