1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59

; modified `occurs-free?` (Figure 1.1, page 32) which allows `set!` expressions
(define occurs-free?
  (lambda (var exp)
    (cond
      ((symbol? exp) (eqv? var exp))
      ((eqv? (car exp) 'lambda)
       (and (not (eqv? (caadr exp) var))
            (occurs-free? var (caddr exp))))
      ((eqv? (car exp) 'set!)
       (or (eqv? var (cadr exp))
           (occurs-free? var (caddr exp))))
      (else (or (occurs-free? var (car exp))
                (occurs-free? var (cadr exp)))))))

; modified `occurs-bound?` (Figure 1.1, page 32) which allows `set!` expressions
(define occurs-bound?
  (lambda (var exp)
    (cond
      ((symbol? exp) #f)
      ((eqv? (car exp) 'lambda)
       (or (occurs-bound? var (caddr exp))
           (and (eqv? (caadr exp) var)
                (occurs-free? var (caddr exp)))))
      ((eqv? (car exp) 'set!) (occurs-bound? var (caddr exp)))
      (else (or (occurs-bound? var (car exp))
                (occurs-bound? var (cadr exp)))))))



(occurs-free? 'x '(lambda (x) ((set! x (+ a 1)) (set! f (lambda (y) (set! b (+ y 1)))))))
; #f

(occurs-free? 'y '(lambda (x) ((set! x (+ a 1)) (set! f (lambda (y) (set! b (+ y 1)))))))
; #f

(occurs-free? 'a '(lambda (x) ((set! x (+ a 1)) (set! f (lambda (y) (set! b (+ y 1)))))))
; #t

(occurs-free? 'b '(lambda (x) ((set! x (+ a 1)) (set! f (lambda (y) (set! b (+ y 1)))))))
; #t

(occurs-free? 'f '(lambda (x) ((set! x (+ a 1)) (set! f (lambda (y) (set! b (+ y 1)))))))
; #t


(occurs-bound? 'x '(lambda (x) ((set! x (+ a 1)) (set! f (lambda (y) (set! b (+ y 1)))))))
; #t

(occurs-bound? 'y '(lambda (x) ((set! x (+ a 1)) (set! f (lambda (y) (set! b (+ y 1)))))))
; #t

(occurs-bound? 'a '(lambda (x) ((set! x (+ a 1)) (set! f (lambda (y) (set! b (+ y 1)))))))
; #f

(occurs-bound? 'b '(lambda (x) ((set! x (+ a 1)) (set! f (lambda (y) (set! b (+ y 1)))))))
; #f

(occurs-bound? 'f '(lambda (x) ((set! x (+ a 1)) (set! f (lambda (y) (set! b (+ y 1)))))))
; #f