;;; This collects the vars bound in a pattern.
 
 (define-walker collect-pattern-vars ast-td-collect-pattern-vars-walker)
 
 (define (collect-pattern-vars x)
   (collect-pattern-vars-1 x '()))
 
 (define (collect-pattern-vars-1 x vars-so-far)
   (call-walker collect-pattern-vars x vars-so-far))
 
 (define (collect-pattern-vars/list l vars-so-far)
   (if (null? l)
       vars-so-far
       (collect-pattern-vars/list (cdr l)
 		        (collect-pattern-vars-1 (car l) vars-so-far))))
 
 (define-local-syntax (collect-pattern-vars-processor
 		        slot type object-form accum-form)
   (let ((stype  (sd-type slot))
 	(sname  (sd-name slot)))
     (cond ((eq? stype 'var-ref)
 	   `(cons (struct-slot ',type ',sname ,object-form) ,accum-form))
 	  ((eq? stype 'pattern)
 	   `(collect-pattern-vars-1
 	       (struct-slot ',type ',sname ,object-form)
 	       ,accum-form))
 	  ((equal? stype '(list pattern))
 	   `(collect-pattern-vars/list
 	       (struct-slot ',type ',sname ,object-form) ,accum-form))
 	  (else
 ;	   (format '#t "Collect-pattern-vars: skipping slot ~A in ~A~%"
 ;		   sname
 ;		   type)
 	   accum-form)
 	  )))
 
 (define-collecting-walker-methods collect-pattern-vars
   (as-pat irr-pat var-pat wildcard-pat const-pat plus-pat pcon list-pat
 	  pp-pat-list pp-pat-plus pp-pat-negated)
   collect-pattern-vars-processor)