[PRL] Accumulator for container capacity

[William D Clinger]

Here is a version of the code that uses the purely functional
Visitor pattern.  If you don't like the use of foldr inside
the check procedure, you can define make-Container-FoldR in
the obvious way and make the obvious changes to check.

Will

--------

;(module container mzscheme

  (define-struct Container (contents capacity))
  (define-struct Simple (name weight))

  ;; --- MF added ---
  ;; A Container is (make-Container (Listof Item) Number).
  ;;
  ;; An Item is one of:
  ;;  -- (make-Simple Symbol Number)
  ;;  -- Container
  ;; --- end added ---

  ;; --- WDC added ---
  ;; 
  ;; A Container-Visitor: Container -> T is
  ;;     (make-Container-Visitor simple-visitor container-visitor)
  ;; where
  ;; simple-visitor: Symbol x Number -> T
  ;; container-visitor: (Listof T) x Number -> T

  (define (make-Container-Visitor simple-visitor container-visitor)
    (define (visitor c)
      (cond ((Simple? c)
             (simple-visitor (Simple-name c) (Simple-weight c)))
            ((Container? c)
             (container-visitor (map visitor (Container-contents c))
                                (Container-capacity c)))
            (else ???)))
    visitor)

  ;; --- end added ---

  ;; Test object c1 in Scheme

  ;; --- MF changed ---
  (define c-1
    (make-Container (list (make-Simple "apple" 1))
      1))

  (define c0
    (make-Container (list (make-Simple "pencil" 1)
                      c-1
                      (make-Simple "orange" 1))
      1))

  (define c1
    (make-Container (list (make-Simple "apple" 1)
                      c0
                      (make-Simple "orange" 1)
                      (make-Simple "kiwi" 1))
      5))
  ;; --- end changed ---

  ;; -- mw changed --

  (define-struct wv (weight violations))
 
  (define (foldr f seed l)
    (if (null? l) seed
      (f (car l) (foldr f seed (cdr l)))))
          

  ;; check returns the total number of capacity violations in a container
  ;; check: Container -> int

  ;; --- WDC changed ---

  (define (check ac)
    (wv-violations
     ((make-Container-Visitor
       (lambda (name weight) (make-wv weight 0))
       (lambda (wvs capacity)
         (let* ((totals
                 (foldr (lambda (wv1 wv2)
                          (make-wv
                           (+ (wv-weight wv1) (wv-weight wv2))
                           (+ (wv-violations wv1) (wv-violations wv2))))
                        (make-wv 0 0)
                        wvs))
                (total-weight (wv-weight totals))
                (total-violations (wv-violations totals)))
           (make-wv total-weight
                    (if (> total-weight capacity)
                        (+ 1 total-violations)
                        total-violations)))))
      ac)))

  ;; --- end changed ---

;  )