;; Preis- und Inventarlisten mit Typen versehen

(define prices-type (make-type 'prices))
(define make-prices (typed-value-maker prices-type))
(define prices-alist (typed-value-selector prices-type))

(define drink-price
  (lambda (drink prices)
    (drink-price-1 drink (prices-alist prices))))

(define drink-price-1
  (lambda (drink alist)
    (if (null? alist)
	(error "unfound drink")
	(if (equal? drink (car (car alist)))
	    (cdr (car alist))
	    (drink-price-1 drink (cdr alist))))))

(define inventory-type (make-type 'inventory))
(define make-inventory (typed-value-maker inventory-type))
(define inventory-alist (typed-value-selector inventory-type))

(define inventory-number-of-cans
  (lambda (drink inventory)
    (cdr
     (any (lambda (inventory-entry)
            (equal? drink (car inventory-entry)))
          (inventory-alist inventory)))))

(define display-inventory
  (lambda (inventory)
    (display "The inventory: ")
    (newline)
    (for-each (lambda (inventory-entry)
                (display "drink: ")
                (display (car inventory-entry))
                (display " stock: ")
                (display (cdr inventory-entry))
                (newline))
              (inventory-alist inventory))))

(define empty?
  (lambda (inventory)
    (every? (lambda (inventory-entry)
              (= 0 (cdr inventory-entry)))
            (inventory-alist inventory))))

(define apply-order
  (lambda (order inventory)
    (make-inventory
     (apply-order-1 order (inventory-alist inventory)))))

(define apply-order-1 
  (lambda (order alist)
    (if (null? alist)
	'()
	(let ((alist-entry (car alist)))
	  (if (equal? (car order) (car alist-entry))
	      (cons (cons (car order)
			  (- (cdr alist-entry) (cdr order)))
		    (cdr alist))
	      (cons alist-entry
		    (apply-order-1 order (cdr alist))))))))