Lesson Plan - 6.001 SP04 - recitation 16

object system with inheritance

logistics:
- project 4
  warmups due in tutorial
  plans to ta by next wed
  due next friday
- quiz 2
  one week from next tuesday - more next week


problems

(define (make-food self name nutrition good-until)
  (let ((root-part (make-root-object self))
        (age 0))
    (lambda (message)
      (case message
	((TYPE)
	 (lambda () (type-extend 'food root-part)))
	((NAME)
	 (lambda () name))
	((AGE)
	 (lambda () age))
	((SIT-THERE)
	 (lambda (time)
	   (set! age (+ age time))
	   'aged))
	((EAT)
	 (lambda ()
	   (if (< (ask self 'AGE) good-until)
	       nutrition
	       0)))
	(else (get-method message root-part))))))

(define (create-food name nutrition good-until)
  (create-instance make-food name nutrition good-until))


(define (make-aged-food self name nutrition good-until good-after)
  (let ((food-part (make-food self name nutrition good-until)))
    (lambda (message)
      (case message
	((TYPE) (lambda () (type-extend 'aged-food food-part)))
	((SNIFF)
	 (lambda ()
	   (> (ask self 'AGE) good-after)))
	((EAT)
	 (lambda ()
	   (if (ask self 'SNIFF)
	       (ask food-part 'EAT)
	       0)))
	(else (get-method message food-part))))))

(define (create-aged-food name nutrition good-until good-after)
  (create-instance make-aged-food name nutrition good-until good-after))

(define (make-vending-machine self name nutrition good-until)
  (let ((root-part (make-root-object self))
	(age 0))
    (lambda (message)
      (case message
	((TYPE) (lambda () (type-extend 'vending-machine root-part)))
	((SIT-THERE)
	 (lambda (time)
	   (set! age (+ age (/ time 2)))
	   'aged))
	((SELL-FOOD)
	 (lambda ()
	   (let ((f (create-food name nutrition good-until)))
	     (ask f 'SIT-THERE age)
	     f)))
	(else (get-method message root-part))))))

(define (create-vending-machine name nutrition good-until)
  (create-instance make-vending-machine name nutrition good-until))

(define (mapn proc . lsts)
  (if (or (null? lsts) (null? (car lsts)))
      '()
      (cons (apply proc (map car lsts))
	    (apply mapn (cons proc (map cdr lsts))))))

(define a (create-food 'apple 20 3))
(define t (create-food 'twinkie 3 500))
(ask a 'NAME)         ; apple
(ask a 'SIT-THERE 2)
(ask a 'EAT)          ; 20
(ask a 'SIT-THERE 1)
(ask a 'EAT)          ; 0
(define w (create-aged-food 'wine 5 250 50))
(ask w 'SNIFF)        ; #f
(ask w 'SIT-THERE 55)
(ask w 'SNIFF)        ; #t
(ask w 'EAT)          ; 5
(define v (create-vending-machine 'coke 10 250))
(define c1 (ask v 'SELL-FOOD))
(ask c1 'EAT)         ; 10
(ask v 'SIT-THERE 300)
(define c2 (ask v 'SELL-FOOD))
(ask c2 'EAT)         ; 10
(ask c2 'AGE)         ; 150