recitation 16: object-oriented programming ======================================================================== * class: the common structure of a type of object * instance: a particular object of a given class * inheritance: a subclass can extend the functionality of one or more superclasses * "is-a": given a generic object, you can investigate its type, an object "is-a" anything in its inheritance hierarchy. * "has-a": an object may store pointers to other objects as part of its state. * shadowing of methods, objects as "frames" -- lookup method/variable by following up a chain and finding first handler for that message * if there's a method that does what you want, use it! (not using it is an abstraction violation) * template for class definitions * asking self to do something vs. asking a part to do something * create vs. make: why do some objects have a create-foo & a make-foo and other objects just have a make-foo? * type method: why is the type method required? ======================================================================== exercises (refer to the code below) * draw the inheritance hierarchy for the code below. there are 3 things you should look for in a sub/super-class relationship: 1. there's a let statement with a call to make-superclass-part 2. TYPE extends the superclass type 3. if the subclass doesn't implement a method, get-method from the superclass * multiple inheritance: draw the environment diagram for: (define bob-smith (create-person 'bob)) (ask bob-smith 'FIRST) (ask bob-smith 'LAST) * is this the behavior we want? how could we change it? 1. redefine get-method 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 get-method 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) * say we choose the 3rd option and add this to person: ((FIRST) (lambda () (ask named-object-part 'FIRST))) is this the same as writing ((FIRST) (lambda () (ask self 'FIRST))) ? no! the 2nd version enters an infinite loop! * finish the code for person's TAKE method, use display to print stuff. people can't take things they already have, and they can't take other people. (define bob-smith (create-person 'bob)) (define pset (create-named-object 'adventure-game 'pset)) (define ice-cream (create-named-object 'chocolate 'swirl)) (ask bob-smith 'TAKE pset) (ask bob-smith 'TAKE pset) (ask bob-smith 'TAKE ice-cream) (map (lambda (t) (ask t 'NAME)) (ask bob-smith 'THINGS)) * so TAKE should call container's ADD-THING method. does it matter if we ask self or container-part to TAKE? (ask self 'ADD-THING thing) (ask container-part 'ADD-THING thing) not yet, but... * 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 jane-smith (create-person-with-small-bag 'jane 2)) (define cat (create-named-object 'snow 'ball)) (define pencil (create-named-object 'number 'two)) (define book (create-named-object 'scheme 'manual)) (ask jane-smith 'TAKE cat) (ask jane-smith 'TAKE pencil) (ask jane-smith 'TAKE book) (map (lambda (t) (ask t 'NAME)) (ask jane-smith 'THINGS)) * 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, if we (ask container-part 'ADD-THING thing) we won't use person-with-small-bag's ADD-THING method and it will behave just like a person. so instead we should use (ask self 'ADD-THING thing) * IN GENERAL: It is best to use (ask self _______) instead of (ask foo-part ________), unless you have a good reason to ask the part. ======================================================================== MODIFIED CODE FROM LECTURE / PROJECT 4 ;; root-object (define (make-root-object self) (lambda (message) (case message ((TYPE) (lambda () '(root))) ((IS-A) (lambda (type) (if (memq type (ask self 'TYPE)) #t #f))) (else (no-method))))) ;; named-object (define (create-named-object first last) (create-instance make-named-object first last)) (define (make-named-object self first last) (let ((root-part (make-root-object self))) (lambda (message) (case message ((TYPE) (lambda () (type-extend 'named-object root-part))) ((NAME) (lambda () first)) ((FIRST) (lambda () first)) ((LAST) (lambda () last)) (else (get-method message root-part)))))) ;; container (define (make-container self) (let ((root-part (make-root-object self)) (things '())) (lambda (message) (case message ((TYPE) (lambda () (type-extend 'container root-part))) ((THINGS) (lambda () things)) ((HAVE-THING?) (lambda (thing) (not (null? (memq thing things))))) ((ADD-THING) (lambda (new-thing) (if (not (ask self 'HAVE-THING? new-thing)) (set! things (cons new-thing things))) 'DONE)) ((DEL-THING) (lambda (thing) (set! things (delq thing things)) 'DONE)) ((FIRST) (lambda () (if (null? things) #f (car (reverse things))))) ((LAST) (lambda () (if (null? things) #f (car things)))) (else (get-method message root-part)))))) ;; person (define (create-person name) (create-instance make-person name)) (define (make-person self name) (let ((container-part (make-container self)) (named-object-part (make-named-object self name 'smith))) (lambda (message) (case message ((TYPE) (lambda () (type-extend 'person named-object-part container-part))) ((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 ;; small-person'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 method inheritance ;; does it matter if we ask self or ask container? ;;((FIRST) (lambda () (ask named-object-part 'FIRST))) ;;((FIRST) (lambda () (ask self 'FIRST))) ;; yes! if we ask self we'll get an infinite loop! ;; ;; design choice 4: rename to avoid conflict ((FIRST-THING) (lambda () (ask container-part 'FIRST))) ((LAST-THING) (lambda () (ask container-part 'LAST))) ;; (else (get-method message container-part named-object-part)))))) ;; person-with-small-bag (define (create-person-with-small-bag name max-things) (create-instance make-person-with-small-bag name max-things)) (define (make-person-with-small-bag self name max-things) (let ((person-part (make-person self name))) (lambda (message) (case message ((TYPE) (lambda () (type-extend 'person-with-small-bag person-part))) ((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))) (else (get-method message person-part)))))) ======================================================================== CODE FROM LECTURE / PROJECT 4 -- NOT MODIFIED ;; Instance (define (make-instance) (let ((handler #f)) (lambda (message) (case message ((SET-HANDLER!) (lambda (handler-proc) (set! handler handler-proc))) (else (get-method message handler)))))) (define (create-instance maker . args) (let* ((instance (make-instance)) (handler (apply maker instance args))) (ask instance 'SET-HANDLER! handler) (if (method? (get-method 'INSTALL instance)) (ask instance 'INSTALL)) instance)) ;; Method Interface (define (ask object message . args) (let ((method (get-method message object))) (cond ((method? method) (apply method args)) (else (error "No method for" message 'in (safe-ask 'UNNAMED-OBJECT object 'NAME)))))) (define (safe-ask default-value obj msg . args) (let ((method (get-method msg obj))) (if (method? method) (apply ask obj msg args) default-value))) (define (get-method message . objects) (define (try objects) (if (null? objects) (no-method) (let ((method ((car objects) message))) (if (not (eq? method (no-method))) method (try (cdr objects)))))) (try objects)) (define (method? x) (cond ((procedure? x) #t) ((eq? x (no-method)) #f) (else (error "Object returned this non-message:" x)))) (define no-method (let ((tag (list 'NO-METHOD))) (lambda () tag))) ;; Types (define (type-extend type . parents) (cons type (remove-duplicates (append-map (lambda (parent) (ask parent 'TYPE)) parents)))) ;; Utils (define (remove-duplicates lst) (if (null? lst) '() (cons (car lst) (remove-duplicates (filter (lambda (x) (not (eq? x (car lst)))) lst))))) (define (filter predicate lst) (cond ((null? lst) '()) ((predicate (car lst)) (cons (car lst) (filter predicate (cdr lst)))) (else (filter predicate (cdr lst))))) ======================================================================== new stuff: * write a procedure foo that takes in a symbol ('one 'two 'three ... ) and returns the integer it maps to (1 2 3). use case. (define (foo sym) (case sym ((one) 1) ((two) 2) ((three) 3) (else (error "unknown sym" sym)))) (foo 'one) -> 1 (foo 'two) -> 2 (foo 'three) -> 3 * write a procedure truncate-lists! that takes in a list of lists and modifies each sublist so it only has the first element. use for-each. for-each is like map except it throws away the result. so op must be executed for it's side effect... (define thing (list (list 1 2 3 4) (list 5 6) (list 7))) (define (truncate-lists! lsts) (for-each (lambda (lst) (set-cdr! lst nil)) lsts)) thing -> ((1 2 3 4) (5 6) (7)) (truncate-lists! thing) thing -> ((1) (5) (7)) * named-let: used in the project code. it's in the scheme manual, but you don't need to know it. (let loop ((count 5)) (if (> count 0) (begin (display count) (loop (- count 1))) 'done)) ========================================================================