CS 541 Lecture -*- Outline -*- * Smalltalk ** Message expression syntax *** Basic expressions **** Identifiers ------------------------------------------ SMALLTALK: IDENTIFIERS Identifier Conventions Upper case: ClassNames, ClassVars, Globals lower case: instancevars, messages Pseudo Variables self, super Special Names Instances: true, false, nil Classes: True, False, UndefinedObject Case matters: True (the class) vs. true (the instance) ------------------------------------------ **** Literals ------------------------------------------ LITERALS 3 30.45 $a "the character a" 'a string, don''t laugh!' #aSymbol #aSymbol:composed:ofKeywords: #* "also a symbol" #(1 2 3) "an array constant" #(foo bar 'and me') ------------------------------------------ symbols, arrays are like in LISP/Scheme symbols give a fast comparison as opposed to strings *** messages ------------------------------------------ KINDS OF MESSAGES Unary messages: 1 negated theta sin Pen new home green Binary messages: 3 + 4 5 - 4 * 2 (sum / count) * (reserve amount) Keyword messages: 3 max: 2 anArray at: 2 put: 3 (anArray at: 2) at: 3 ------------------------------------------ binary messages always use operator characters note the colons on keyword messages *** Parsing This really is important for reading existing code! ------------------------------------------ PRECEDENCE unary highest (most tight) binary keyword lowest (least tight) ASSOCITIVITY IS LEFT TO RIGHT 4 - 5 * 3 is (4 - 5) * 3 2 * theta sin is 2 * (theta sin) frame width: otherFrame width * 2 is frame width: ((otherFrame width) * 2) FOR YOU TO DO Parenthesize the following: foo at: 2 negated put: 4 + 3 * 2 negated ------------------------------------------ *** cascaded messages, with semicolons (;) ------------------------------------------ CASCADED MESSAGES Transcript cr; show: 'also sent. '; cr; endEntry. ------------------------------------------ def: the message immediately following the semicolon (;) is to be sent to the same receiver as the previous message. (p. 82 of LaLonde) ** Blocks (closures) a procedure closure *** statically scoped ------------------------------------------ BLOCKS (class BlockContext) Block = Examples: [ Transcript show: i ] [ k := k+1. Transcript show: k. k] [ :x :y | Transcript show: (x + y) ] FOR YOU TO DO What is (a) printed and (b) returned by: [ :y | Transcript show: (y + 2). y ] value: 4 ------------------------------------------ ... a closure = code + envrionment In Squeak, these are called BlockContexts translate into Haskell or ML Q: What are these like in Java? anonymous inner classes, although there are some differences... show how these execute in response to message value, value:value: returns value of last expression (like begin in Scheme) point out formal parameters binds x to 3, then runs x+2 in that environment. Bindings are made to locations, not values: | b k | b := [ Transcript show: k+1 ]. k := 3. b value Squeak and VisualWorks make statically-scoped closures. Q: What good are these blocks? - they are simple objects with one method, which are easy to create without going through the usual class declaration process - they can be used for abstraction (tool-makers) - they can be used to pass methods as arguments - they can be used to synthesize new control structures. ** Control Structures messages sent to Booleans, Blocks, Integers, Intervals give output of the last 3 ------------------------------------------ CONTROL STRUCTURES (x > y) ifTrue: [x printOn: Transcript] ifFalse: [y printOn: Transcript] (x > y) and: [y > z] [i > 0] whileTrue: [i printOn: Transcript. i := i - 1] 3 timesRepeat: [4 printOn: Transcript] (1 to: 5 by: 2) do: [:i | i printOn: Transcript] ------------------------------------------ derived methods built on top of these, invent your own! collections support do:, inject:into:, collect:, select:, ... ------------------------------------------ FOR YOU TO DO 1. Write a statement that prints the numbers from i to 10 in ascending order. 2. Write a statement that prints all the numbers in a set s that are greater than 3 s do: ------------------------------------------ ** Classes Modules that implement abstract types (like a cluster in CLU, package in Ada) *** Stack example ------------------------------------------ MAKING A CLASS Collection subclass: #Stack instanceVariableNames: 'elems' classVariableNames: '' poolDictionaries: '' category: 'ComS541-InClass' Really: From browser, select in category pane, "add item...", then type in "ComS541-InClass". Then in pane shown, edit in the parts that are different. then select "accept". TO ADD METHODS From browser, select instance vs. class and then add a method category, then (without selecting a method) edit the template provided ------------------------------------------ You can also add instance variables later, by editing the template. ------------------------------------------ "class methods" new ^ self basicNew initialize "instance methods" initialize elems := OrderedCollection new push: anElement elems addFirst: anElement pop elems removeFirst top ^ elems first do: aBlock elems do: aBlock printString | s | s := 'Stack('. elems do: [ :e | s := s , ' ', e printString]. ^ s , ')' ------------------------------------------ Another way to do it is to edit in the form used by fileOut... Be careful to get printOn: right! can cause very subtle, hard to find errors Actually, don't usually need to redefine this by hand in Smalltalk, as Collection already defines it, provided we define do:. *** Exercise ------------------------------------------ FOR YOU TO DO Complete the following class for a counter Object subclass: #Counter instanceVariableNames: ' ' classVariableNames: '' poolDictionaries: '' category: 'ComS541-Examples' "class methods" new "instance methods" initialize increment value printOn: aStream ------------------------------------------ ** object creation in Smalltalk ------------------------------------------ OBJECT CREATION How Stack new executes 1. send the "new" message to the class object "Stack" This: - runs the code ------------------------------------------ ... ^ self basicNew initialize which then creates an instance, sets its instance variables to nil and then calls the initialize method on that. You can have a class method that takes arguments and passes them along to the new instance if you want. ** Semantics of variables, assignment, and mutation draw pictures of heap, objects, classes *** object identity ------------------------------------------ OBJECT IDENTITY objects have an identitity = state = EXAMPLE | s | s := Stack new. s push: 1. s push: (Stack new push: 2). s push: s ------------------------------------------ object like a variable in C or Pascal, but allocated on the heap ... identity = address ... state = value (bits) the value may contain other objects (means their value contains the other's identity) so object identities are a subset of object values. *** mutable vs. immutable ------------------------------------------ MUTABLE vs. IMMUTABLE OBJECTS def: an object is *mutable* if otherwise an object is *immutable* ------------------------------------------ ... its state can (be observed to) change over time. draw graph of time vs value Q: are integers mutable in smalltalk? what about i := i + 1? *** variables and assigment environment maps names (of global vars, classes, and locals) to cells (locations) that contain (point to) objects ------------------------------------------ VARIABLES AND ASSIGNMENT def: a variable in Smalltalk is EXAMPLE p1 := p2 like Pascal: type PointStruct = record x,y: integer end; Point = ^PointStruct; var p1, p2: Point; { pointers!} new(p); new(p2); p1 := p2. or C: typedef struct {x,y:int} PointStruct; typedef PointStruct * Point; Point p1, p2; ... p1 = p2; ------------------------------------------ .... changable ref. to an object, not themselves objects (as they are in C++) can't send a message to a variable, only to the object it denotes (like a pointer variable in C or Pascal, but don't have to dereference it) draw picture Q: Does an assigment copy the object in Smalltalk? no, it creates an alias (copies reference to object) Q: What kind of value is in a Smalltalk variable? an object identity