recitation 18: more object-oriented programming
========================================================================
* multiple inheritance:
(define bob-smith (create-person 'bob))
(ask bob-smith 'FIRST) ==> #f
(ask bob-smith 'LAST) ==> #f
is this the behavior we want? how could we change it?
1. redefine make-handler to look through the later classes first
(this could have a huge impact on the rest of the system)
2. switch the order of the parts in the make-handler call in make-person
(this could have other impacts on person object)
3. add FIRST & LAST methods inside of person to explicitly specify
which inheritance to select
4. change the name of the methods inside of named-object or
container to avoid the collision. (this could be hard to do
if we've already used these methods a lot in other code)
(see code below too!)
* define a new class, person-with-small-bag who can only carry
around n things, n is a parameter to the constructor. What does it
inherit from? Which method should you override to get the appropriate
TAKE behavior?
(define alice-jones (create-person-with-small-bag 'alice 'jones 2))
(define cat (create-named-object 'snow 'ball))
(define pencil (create-named-object 'number 'two))
(define book (create-named-object 'scheme 'manual))
(ask alice-jones 'TAKE cat)
(ask alice-jones 'TAKE pencil)
(ask alice-jones 'TAKE book)
(map (lambda (t) (ask t 'NAME)) (ask alice-jones 'THINGS))
We will extend the person class and need to add an additional state
variable to keep track of capacity. We can override either the TAKE
method or the ADD-THING method. (see code below).
* say we choose to override the ADD-THING method for
person-with-small-bag. now does it matter how we implemented
person's TAKE method?
Yes it does matter how we implemented person's TAKE method. (see code).
* IN GENERAL, it is best to use (ask self _______) instead of (ask
foo-part ________), unless you have a good reason to ask the part.
========================================================================
;; root-object
(define (root-object self)
(make-handler
'root
(make-methods
'IS-A
(lambda (type)
(memq type (ask self 'TYPE))))))
;; named-object
(define (create-named-object first last)
(create-instance named-object first last))
(define (named-object self first last)
(let ((root-part (root-object self)))
(make-handler
'named-object
(make-methods
'NAME (lambda () first)
'FIRST (lambda () first)
'LAST (lambda () last)
'INSTALL (lambda () 'installed)
'DESTROY (lambda () 'destroyed))
root-part)))
;; container
(define (container self)
(let ((root-part (root-object self))
(things '()))
(make-handler
'container
(make-methods
'THINGS (lambda () things)
'FIRST (lambda () (if (null? things) #f (car (reverse things))))
'LAST (lambda () (if (null? things) #f (car things)))
;;
;; design choice 4: rename the method to avoid name conflict
;; 'FIRST-THING (lambda () (if (null? things) #f (car (reverse things))))
;; 'LAST-THING (lambda () (if (null? things) #f (car things)))
;;
'HAVE-THING? (lambda (thing)
(not (null? (memq thing things))))
'ADD-THING (lambda (thing)
(if (not (ask self 'HAVE-THING? thing))
(set! things (cons thing things)))
'DONE)
'DEL-THING (lambda (thing)
(set! things (delq thing things))
'DONE))
root-part)))
;; person
(define (create-person first last)
(create-instance person first last))
(define (person self first last)
(let ((named-object-part (named-object self first last))
(container-part (container self)))
(make-handler
'person
(make-methods
'SAY (lambda (list-of-stuff) (for-each display list-of-stuff) (newline) 'said)
'TAKE (lambda (thing)
(cond ((ask self 'HAVE-THING? thing)
(ask self 'SAY (list "I am already carrying " (ask thing 'NAME))))
((ask thing 'IS-A 'PERSON)
(ask self 'SAY (list "I try but cannot take " (ask thing 'NAME))))
(else
;; does it matter if we ask self or container?
(ask self 'ADD-THING thing)
;;(ask container-part 'ADD-THING thing)
;; yes! if we ask container, we won't ever use the
;; person-with-small-bag's ADD-THING
(ask self 'SAY (list "I take " (ask thing 'NAME))))))
'DROP (lambda (thing)
(display "I drop ")
(display (ask thing 'NAME))
(newline)
(ask self 'DEL-THING thing))
;;
;; design choice 3: explicitly specify the method inheritance
'FIRST (lambda () (ask named-object-part 'FIRST))
'LAST (lambda () (ask named-object-part 'LAST))
'FIRST-THING (lambda () (ask container-part 'FIRST))
'LAST-THING (lambda () (ask container-part 'FIRST))
)
;; design choice 1 & 2: switch the order of container-part & named-object-part
;; either here, or within the code for make-handler.
container-part
named-object-part)))
;; person-with-small-bag
(define (create-person-with-small-bag first last max-things)
(create-instance person-with-small-bag first last max-things))
(define (person-with-small-bag self first last max-things)
(let ((person-part (person self first last)))
(make-handler
'person-with-small-bag
(make-methods
'ADD-THING (lambda (new-thing)
(if (> (length (ask self 'THINGS)) (- max-things 1))
(ask self 'DROP (ask self 'FIRST-THING))
#t)
(ask person-part 'ADD-THING new-thing)))
person-part)))
========================================================================
modified from fall 04 & spring 2003 quiz 2:
;; a THING is an object with a name, a weight, and a volume.
(define (create-thing name weight volume)
(create-instance thing name weight volume))
(define (thing self name weight volume)
(let ((root-part (root-object self)))
(lambda (message)
(case message
((TYPE) (lambda () (type-extend 'thing root-part)))
((NAME) (lambda () name))
((WEIGHT) (lambda () weight))
((VOLUME) (lambda () volume))
((DENSITY) (lambda () (/ weight volume)))
(else (get-method message root-part))))))
;; a CONTAINER is a set of things.
(define (create-container)
(create-instance container))
(define (container self)
(let ((root-part (root-object self))
(things '()))
(lambda (message)
(case message
((TYPE) (lambda () (type-extend 'container root-part)))
((THINGS) (lambda () things))
((ADD-THING) (lambda (thing)
(set! things (cons thing things))
(map (lambda (thing) (ask thing 'NAME)) things)))
((WEIGHT) (lambda ()
(fold-right + 0
(map (lambda (thing) (ask thing 'WEIGHT))
things))))
((VOLUME) (lambda ()
(fold-right + 0
(map (lambda (thing) (ask thing 'VOLUME))
things))))
(else (get-method message root-part))))))
;; a CRATE is a hard-sided wooden crate. its weight varies with its
;; contents, but its volume is always the same.
(define (create-crate name weight-when-empty volume)
(create-instance crate name weight-when-empty volume))
(define (crate self name weight-when-empty volume)
(let ((thing-part (thing self name weight-when-empty volume))
(container-part (container self)))
(lambda (message)
(case message
((TYPE) (lambda () (type-extend 'crate thing-part container-part)))
YOUR-CODE-HERE
(else (get-method message container-part thing part))))))
;; a BAG is a flexible cloth bag. Both its weight and its volume
;; depend on its contents.
(define (create-bag name)
(create-instance bag name))
(define (bag self name)
(let ((thing-part (thing self name 0 0))
(container-part (container self)))
(lambda (message)
(case message
((TYPE) (lambda () (type-extend 'bag thing-part container-part)))
YOUR-CODE-HERE
(else (get-method message container-part thing part))))))
Finish the definitions above. You can make other changes to the code
if you provide proper justification.
(define armoire (create-thing 'old-armoire 200 16))
(define bear (create-thing 'teddy-bear 1 0.5))
(define crate (create-crate 'crate 40 20))
(define bag (create-bag 'bag))
* (ask crate 'WEIGHT) =>
* (ask crate 'ADD-THING armoire) =>
* (ask crate 'WEIGHT) =>
* (ask crate 'VOLUME) =>
* (ask crate 'DENSITY) =>
* (ask bag 'WEIGHT) =>
* (ask bag 'ADD-THING bear) =>
* (ask bag 'WEIGHT) =>
* (ask bag 'VOLUME) =>
========================================================================
modified from spring 2000 quiz II
;; an appliance has an ON/OFF switch, you can query the state of the switch
;; and the appliance can blow its fuse (turning the machine off)
(define my-toaster (create-appliance))
(ask my-toaster 'ON?) ==> #f
(ask my-toaster 'SWITCH 'ON)
(ask my-toaster 'ON?) ==> #t
(ask my-toaster 'BLOW-FUSE)
Bang! Fuse Blown!
(ask my-toaster 'ON?) ==> #f
(define (create-appliance)
(create-instance make-appliance))
(define (make-appliance self)
(let ((root-part (make-root self))
YOUR-CODE-HERE )
(lambda (message)
(case message
((TYPE) (lambda () (type-extend 'appliance root-part)))
((SWITCH) YOUR-CODE HERE )
((ON?) YOUR-CODE HERE )
((BLOW-FUSE) YOUR-CODE HERE )
(else (get-method message root-part)))))
;; a blender is an appliance with a speed setting
(define my-blender (create-blender))
(ask my-blender 'SET-SPEED 5)
(ask my-blender 'SPEED) ==> 5
(ask my-blender 'ON?) ==> #F
(define (create-blender)
(create-instance make-blender))
(define (make-blender self)
(let ((appliance (make-appliance self))
YOUR-CODE-HERE)
(lambda (message)
(case message
((TYPE) (lambda () (type-extend 'blender appliance-part)))
((SET-SPEED) YOUR-CODE-HERE)
((SPEED) YOUR-CODE-HERE)
(else (get-method message appliance-part))))))
;; a tv is an appliance with a channel
(define (create-TV)
(create-instance make-TV))
(define (make-TV self)
(let ((appliance (make-appliance self))
YOUR-CODE-HERE)
(lambda (message)
(case message
((TYPE) (lambda () (type-extend 'tv appliance-part)))
((SET-CHANNEL) YOUR-CODE-HERE)
((CHANNEL) YOUR-CODE-HERE)
(else (get-method message appliance))))))
;; a BL-TV is both a blender AND a TV!
;; One problem with this appliance: whenever the speed of the blender
;; goes above 3, and the TV part and blender part are both on, the
;; fuses in both parts blow.
(define (create-BL-TV)
(create-instance make-BL-TV))
(define (make-BL-TV self)
(let ((BL (make-blender self))
(TV (make-tv self)))
(lambda (message)
(case message
((TYPE) (lambda () (type-extend 'tv appliance-part)))
((BLOW-IF-OVERLOAD) YOUR-CODE-HERE) ;; internal method
((SWITCH) YOUR-CODE-HERE)
((SET-SPEED) YOUR-CODE-HERE)
(else (get-method message TV BL))))))
========================================================================