[bpt/guile.git] / test-suite / vm / t-closure4.scm

(define (extract-symbols exp)
  (define (process x out cont)
    (cond ((pair? x)
           (process (car x)
                    out
                    (lambda (car-x out)
                      ;; used to have a bug here whereby `x' was
                      ;; modified in the self-tail-recursion to (process
                      ;; (cdr x) ...), because we didn't allocate fresh
                      ;; externals when doing self-tail-recursion.
                      (process (cdr x)
                               out
                               (lambda (cdr-x out)
                                 (cont (cons car-x cdr-x)
                                       out))))))
          ((symbol? x)
           (cont x (cons x out)))
          (else
           (cont x out))))
  (process exp '() (lambda (x out) out)))

(extract-symbols '(a b . c))
Commit	Line	Data
5e390de6 AW	1	(define (extract-symbols exp)
	2	(define (process x out cont)
	3	(cond ((pair? x)
	4	(process (car x)
	5	out
	6	(lambda (car-x out)
	7	;; used to have a bug here whereby `x' was
	8	;; modified in the self-tail-recursion to (process
	9	;; (cdr x) ...), because we didn't allocate fresh
	10	;; externals when doing self-tail-recursion.
	11	(process (cdr x)
	12	out
	13	(lambda (cdr-x out)
	14	(cont (cons car-x cdr-x)
	15	out))))))
	16	((symbol? x)
	17	(cont x (cons x out)))
	18	(else
	19	(cont x out))))
	20	(process exp '() (lambda (x out) out)))
	21
	22	(extract-symbols '(a b . c))