
(require (lib "eopl.ss" "eopl"))
(define-datatype Container Container?
                 (a-Container (contents (list-of Item?)) (capacity number?) (total-weight vector?)))
(define-datatype Item Item?
                 (Cont (c Container?))
                 (Simple (name string?) (weight number?)))

  ;; --- MF added ---
  ;; A Container is (make-Container (Listof Item) Number).
  ;;
  ;; An Item is one of:
  ;;  -- (make-Simple Symbol Number)
  ;;  -- Container
  ;; --- end added ---

  ;; Test object c1 in Scheme

  ;; --- MF changed ---
  (define c-1
    (a-Container (list (Simple "apple" 1))
      1 (vector 0)))

  (define c0
    (a-Container (list (Simple "pencil" 1)
                      (Cont c-1)
                      (Simple "orange" 1))
      1 (vector 0)))

  (define c1
    (a-Container (list (Simple "apple" 1)
                      (Cont c0)
                      (Simple "orange" 1)
                      (Simple "kiwi" 1))
      5 (vector 0)))
  ;; --- end changed ---

  ;; -- mw changed --

  (define-struct wv (weight violations))
  
  (define (foldr2 f seed l)
    (if (null? l) seed
      (f (car l) (foldr2 f seed (cdr l)))))
           

  ;; check returns the total number of capacity violations in a container
  ;; check: Container -> int

  (define (check ac)
    ;; item -> (pair weight nviolations)
    (define (weight-and-violations-of-item it)
      (cases Item it
        (Simple (name weight) (make-wv weight 0))
        (Cont (c) (weight-and-violations-of-container c))))
    ;; container -> (pair weight nviolations)
    (define (weight-and-violations-of-container c)
      (cases Container c
         (a-Container (contents capacity total-weight) (weight-and-violations-of-items contents capacity))))
    ;; here we want to pass the capacity down: a variation of the template
    (define (weight-and-violations-of-items cont cap)
      (let ((wvs
              (map weight-and-violations-of-item cont)))
        (let ((total-weight (foldr + 0 (map wv-weight wvs)))
              (total-viols  (foldr + 0 (map wv-violations wvs))))
          (make-wv
            total-weight
            (if (> total-weight cap)
              (+ 1 total-viols)
              total-viols)))))
    (wv-violations (weight-and-violations-of-container ac)))
  
  (define (sum ac)
    ;; item -> (pair weight nviolations)
    (define (weight-and-violations-of-item it)
      (cases Item it
        (Simple (name weight) weight)
        (Cont (c) (weight-and-violations-of-container c))))
    ;; container -> (pair weight nviolations)
    (define (weight-and-violations-of-container c)
      (cases Container c
         (a-Container (contents capacity total-weight) (let ((cw (weight-and-violations-of-items contents capacity))) (vector-set! total-weight 0 cw) cw))))
    ;; here we want to pass the capacity down: a variation of the template
    (define (weight-and-violations-of-items cont cap)
      (let ((wvs
              (map weight-and-violations-of-item cont)))
        (let ((total-weight (foldr + 0  wvs))) total-weight )))
    (weight-and-violations-of-container ac))

(define (viol ac)
    ;; item -> (pair weight nviolations)
    (define (weight-and-violations-of-item it)
      (cases Item it
        (Simple (name weight) 0)
        (Cont (c) (weight-and-violations-of-container c))))
    ;; container -> (pair weight nviolations)
    (define (weight-and-violations-of-container c)
      (cases Container c
         (a-Container (contents capacity total-weight) (weight-and-violations-of-items contents capacity (vector-ref total-weight 0)))))
    ;; here we want to pass the capacity down: a variation of the template
    (define (weight-and-violations-of-items cont cap total-weight)
      (let ((wvs
              (map weight-and-violations-of-item cont)))
        (let ((total-viols  (foldr + 0 wvs)))       
            (if (> total-weight cap)
              (+ 1 total-viols)
              total-viols))))
    (weight-and-violations-of-container ac))

 (check c1)
 c1
 (sum c1)
 'Total_viols 
 (viol c1)
 c1
