summaryrefslogtreecommitdiff
path: root/test-suite/vm/t-closure4.scm
blob: 61258012f99927f1209543c65e1a2d9fb22119e5 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
(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))