(load "pmatch.scm")

(define free?
 (lambda (x exp)
   (pmatch exp
     (,y (guard (symbol? y)) ...)
     ((lambda (,y) ,body) ...)
     ((,rator ,rand) ...))))

(define free?1
  (lambda (x exp)
    (pmatch exp
      (,y (guard (symbol? y)) (eq? x y))
      ((lambda (,y) ,body) (and (not (eq? x y)) (free?1 x body)))
      ((,rator ,rand) (or (free?1 x rator) (free?1 x rand))))))

(define free?2
  (lambda (x exp cenv)
    (pmatch exp
      (,y (guard (symbol? y)) (and (eq? x y) (not (memq y cenv))))
      ((lambda (,y) ,body) (free?2 x body `(,y . ,cenv)))
      ((,rator ,rand) (or (free?2 x rator cenv) (free?2 x rand cenv))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define-syntax test3
  (syntax-rules ()
    ((_ x exp answer)
     (let-values (((b c) (values (free?1 x exp) (free?2 x exp '()))))
       (cond
         ((not (eq? b answer)) (error 'free?1 "~a ~a ~a ~a\n" x exp b answer))
         ((not (eq? c answer)) (error 'free?2 "~a ~a ~a ~a\n" x exp c answer))
         (else (printf "test ~a ~a succeeds\n" x exp)))))))

(test3 'x '(lambda (x) x) #f)
(test3 'x '(lambda (x) y) #f)
(test3 'x '(lambda (y) x) #t)
(test3 'x '(lambda (x) (lambda (y) x)) #f)
(test3 'x 'x #t)
(test3 'x 'y #f)
(test3 'x '(x y) #t)
(test3 'x '(lambda (x) ((lambda (y) (y x)) (lambda (x) y))) #f)
(test3 'x '((lambda (y) (lambda (x) (x y))) (lambda (y) (y x))) #t)
(test3 'x '(car (lambda (y) (y a))) #f)
(test3 'x '(cdr (lambda (y) (y x))) #t)