Resolve example 9.12 using Gauche from Compilers: Principles, Techniques, and Tools (Dragon book)

data-flow-analysis-ex-9.12.scm

(use srfi-1)

(define (bit-or list1 list2)
  (map (lambda (x y)
         (if (or (= 1 x) (= 1 y))
             1 0))
       list1 list2))

(define (bit-and list1 list2)
  (map (lambda (x y)
         (if (and (= 1 x) (= 1 y))
             1 0))
       list1 list2))

(define (bit-reverse list1)
  (map (lambda (x)
         (if (= 1 x) 0 1))
       list1))

(define (bit-diff list1 list2)
  (bit-and list1 (bit-reverse list2)))

(define (display-list l)
  (dotimes (loop-count (length l))
           (dotimes (block-count (length (list-ref l loop-count)))
                    (display (format "B~S ~S "
                                     (+ 1 block-count)
                                     (list-ref (list-ref l loop-count)
                                               block-count))))
           (display (format "~%"))))

(define *gen*
  '((1 1 1 0 0 0 0)
    (0 0 0 1 1 0 0)
    (0 0 0 0 0 1 0)
    (0 0 0 0 0 0 1)))

(define *kill*
  '((0 0 0 1 1 1 1)
    (1 1 0 0 0 0 1)
    (0 0 1 0 0 0 0)
    (1 0 0 1 0 0 0)))

(define *num-block* 4)
(define *num-state* 7)

(define *out*
  '((0 0 0 0 0 0 0)
    (0 0 0 0 0 0 0)
    (0 0 0 0 0 0 0)
    (0 0 0 0 0 0 0)
    ))

(define *in*
  '((0 0 0 0 0 0 0)
    (0 0 0 0 0 0 0)
    (0 0 0 0 0 0 0)
    (0 0 0 0 0 0 0)
    ))

(define *preceding-block*
  '(()
    (1 4)
    (2)
    (2 3)))

(define *in-list* '())
(define *out-list* '())

(push! *in-list* (list-copy *in*))
(push! *out-list* (list-copy *out*))

(begin
  (let loop ((changed? #f))
    (dotimes (index *num-block*)
             (let ((prev-out (list-copy (list-ref *out* index))))
               (set! (list-ref *in* index)
                     (let ((nin '(0 0 0 0 0 0 0)))
                       (for-each (lambda (x)
                                   (set! nin (bit-or nin (list-ref *out* (- x 1)))))
                                 (list-ref *preceding-block* index))
                       nin))
               (set! (list-ref *out* index)
                     (bit-or (list-ref *gen* index)
                             (bit-diff (list-ref *in* index)
                                       (list-ref *kill* index))))
               (if (not (list= = prev-out (list-ref *out* index)))
                   (set! changed? #t))))
    (push! *in-list* (list-copy *in*))
    (push! *out-list* (list-copy *out*))
    (if changed? (loop #f)))

  (set! *in-list* (reverse! *in-list*))
  (set! *out-list* (reverse! *out-list*))
  (display (format "IN ~%"))
  (display-list *in-list*)
  (display (format "OUT ~%"))
  (display-list *out-list*)
  )