[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Chicken-janitors] #11: replace ##sys#strip-syntax with version that han
From: |
Chicken Trac |
Subject: |
[Chicken-janitors] #11: replace ##sys#strip-syntax with version that handles cyclic structures |
Date: |
Sat, 18 Apr 2009 11:11:09 -0000 |
#11: replace ##sys#strip-syntax with version that handles cyclic structures
------------------------+---------------------------------------------------
Reporter: felix | Owner: felix
Type: enhancement | Status: new
Priority: minor | Component: core libraries
Version: 4.0.0 | Keywords:
------------------------+---------------------------------------------------
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)))))
}}}
--
Ticket URL: <http://www.irp.oist.jp/trac/chicken/ticket/11>
Chicken Scheme <http://www.call-with-current-continuation.org/>
Chicken Scheme is a compiler for the Scheme programming language.
- [Chicken-janitors] #11: replace ##sys#strip-syntax with version that handles cyclic structures,
Chicken Trac <=