pattern-vars.scm

;;; 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)