CS 541 Lecture -*- Outline -*- * Inheritance mechanism for incremental programming allows one to extend function of class without changing code ** Hierarchy of classes Stack is subclass of Object, superclass of Stack is Object inherits methods + instance variables ** Example: Adding size to stacks ------------------------------------------ INHERITANCE SIZED STACK class: SizedStack subclass of: Stack instance variables: size "instance methods" initialize ------------------------------------------ ...initialize super initialize. size := 0 push: anElem size := size + 1. super push: anElem pop size := size - 1. super pop size ^size explanation follows *** Inheriting data Show the layout of storage in instances of SizedStack the Stack is *not* contained in the SizedStack (that would be a different design) *** Inheriting operations Explain meaning of self and super -infinite loops from calling with self Q: Where does code execution start from? some method -- always! ------------------------------------------ STEPS IN MESSAGE SENDING let receiver = object that is sent message let static-class = class where code being executed is defined let rc = if receiver is not super, then receiver's (dynamic) class else if receiver is "super" then superclass of static-class 1. [fetch] look for method in class rc (a) if found: (b) if not found and rc is not "Object": (c) if not found and rc is "Object": 2. [execute] bind self to bind super to bind formals to allocate temporary vars (|temp|), execute the code of the method ------------------------------------------ ... 1(a) go to step 2 ... 1(b) set rc to superclass of rc, goto 1 ... 1(c) error (message not understood) ... receiver, receiver, actuals **** semantic examples without super Consider the following session with the Little Smalltalk interpreter: ------------------------------------------ MESSAGE PASSING EXAMPLE class: C subclass of: Object instance variables: "instance methods" m1 ^self m2 m2 ^ #C class: D subclass of: C instance variables: "instance methods" m2 ^ #D ------------------------------------------ Q: what is the result of (D new) m1 ? returns the symbol "D". Discuss how, draw picture Q: What if we added another method to D... m3 ^ super m2 and then ran x m3? Q: What if m2's body was "^ self m2" instead? **** semantic examples with super ------------------------------------------ MESSAGE PASSING EXAMPLE WITH SUPER class: C subclass of: Object instance variables: "instance methods" m1 ^ self m2 m2 ^ 'C' m3 ^ 'm3' class: D subclass of: C instance variables: "instance methods" m2 ^ super m3 m3 ^ 'E' ------------------------------------------ Q: What is the result (if any) of the expression "C new m1"? It's the string 'C'. Q: What is the result (if any) of the expression "(D new) m1"? It's the string 'm3'. If you got 'E' you don't see how super works. ** Example: CachedStack ------------------------------------------ CACHED STACK class: CachedStack subclass of: Stack instance variables: cache "instance methods" ------------------------------------------ "new is inherited" push: anElem (cache notNil) ifTrue: [super push: cache]. cache := anElem pop (cache isNil) ifTrue: [super pop] ifFalse: [cache := nil]. top (cache notNil) ifTrue: [^cache] ifFalse: [^super top] isEmpty ^(cache isNil) and: [super isEmpty] "example of use" c := CachedStack new. c push: 1. c push: 2 *** How to define printString? Smalltalk's "print it" menu item uses printOn:, inherit it? following works, but accesses elems instance variable (coupling between super and subclass) ------------------------------------------ INHERITING METHODS "instance method for CachedStack" printOn: aStream aStream nextPutAll: self class name. aStream nextPut: $(. (cache notNil) ifTrue: [ aStream nextPut: $ . cache printOn: aStream]. elems do: [ :e | s := s , ' ' , e printOn: aStream]. aStream nextPut: $). problems with the above: - ------------------------------------------ ... access to instance variables of super is dangereous ... repeats code, so would like to inherit it *** Inheriting printString by factoring out common parts ------------------------------------------ INHERITANCE BY FACTORING OUT COMMON PARTS "instance methods for Stack" printOn: aStream aStream nextPutAll: self class name. aStream nextPut: $(. self printElementsOn: aStream. aStream nextPut: $). printElementsOn: aStream elems do: [ :e | e printOn: aStream] FOR YOU TO DO Define whatever methods are *needed* to have printString work for CachedStack ------------------------------------------ "instance method for CachedStack" printElementsOn: aStream (cache notNil) ifTrue: [ aStream nextPut: $ . cache printOn: aStream]. super printElementsOn: aStream. "could use elems instead here, but then would have to loop" conclusion: subclassing allows code sharing abstraction Q: What else is needed to make this work? Q: Can you define that? This factoring is already done in Collection. ** exercise Q: Can you write Gague, like Counter, but also has a decrement method? ** Design issue: Single vs. multiple inheritance ------------------------------------------ SINGLE VS. MULTIPLE INHERITANCE def: a language has *single inheritance* if each class has def: a language has *multiple inheritance* if each class may have Motivating problem: what if want SizedCachedStack? ------------------------------------------ ... at most one superclass examples: Smalltalk, Java note, inheritance is thus hierarchical (tree like) (In Smalltalk, class hiererchy is exactly parallel Stack class inherits from Object class) ... more than one superclass examples: CLOS, C++, ... (often such languages also permit a class to have no superclasses) with single inheritance SizedCachedStack has to be subclass of either Sized or Cached problems: what if two (or more) define same instance variable or same method? efficiency (have to hash to get instance vars) initialization make a chart of advantages and disadvantages