Changeset 14398 in project for chicken/trunk
 Timestamp:
 04/23/09 10:22:41 (11 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

chicken/trunk/expand.scm
r14340 r14398 91 91 92 92 (define (##sys#stripsyntax exp #!optional se alias) 93 ;; if se is given, retain bound vars 94 (let walk ((x exp)) 95 (cond ((symbol? x) 96 (let ((x2 (if se 97 (lookup x se) 98 (get x '##core#macroalias) ) ) ) 99 (cond ((get x '##core#realname)) 100 ((and alias (not (assq x se))) 101 (##sys#aliasglobalhook x #f)) 102 ((not x2) x) 103 ((pair? x2) x) 104 (else x2)))) 105 ((pair? x) 106 (cons (walk (car x)) 107 (walk (cdr x)))) 108 ((vector? x) 109 (list>vector (map walk (vector>list x)))) 110 (else x)))) 93 ;; if se is given, retain bound vars 94 (let ((seen '())) 95 (let walk ((x exp)) 96 (cond ((assq x seen) => cdr) 97 ((symbol? x) 98 (let ((x2 (if se 99 (lookup x se) 100 (get x '##core#macroalias) ) ) ) 101 (cond ((get x '##core#realname)) 102 ((and alias (not (assq x se))) 103 (##sys#aliasglobalhook x #f)) 104 ((not x2) x) 105 ((pair? x2) x) 106 (else x2)))) 107 ((pair? x) 108 (let ((cell (cons #f #f))) 109 (set! seen (cons (cons x cell) seen)) 110 (setcar! cell (walk (car x))) 111 (setcdr! cell (walk (cdr x))) 112 cell)) 113 ((vector? x) 114 (let* ((len (##sys#size x)) 115 (vec (makevector len))) 116 (set! seen (cons (cons x vec) seen)) 117 (do ((i 0 (fx+ i 1))) 118 ((fx>= i len) vec) 119 (##sys#setslot vec i (##sys#slot x i))))) 120 (else x))))) 111 121 112 122 (define stripsyntax ##sys#stripsyntax)
Note: See TracChangeset
for help on using the changeset viewer.