1| 2| OBJECT-ORIENTED PROGHRAMMING 3| ============================ 4| 5| PROGRAMMING PARADIGMS 6| ===================== 7| 8| PROCEDURAL PROGRAMMING 9| ~~~~~~~~~~~~~~~~~~~~~~ 10| A program is a set of procedures/functions/operations that are applied 11| when needed. 12| 13| Typical applications: Involve OBJECTs, i.e., entities that have both 14| identity and values. 15| - Most operations are assignment based. 16| - TIME DEPENDENCY. 17| 18| Programs' characteristics: 19| Large number of GLOBAL information (variables/objects). 20| 21| Program development: 22| If there are multiple types, and we consider an operation-types table 23| (like the one used in the data-directed programming approach), where 24| Rows----operations, 25| Columns----types, 26| then program development takes the order of filling LINES in that table. 27| 28| Example applications: 29| ~~~~~~~~~~~~~~~~~~~~~ 30| BANK ACCOUNTS MANAGEMENT: 31| Accounts + transactions. 32| Global array of *bank accounts* (records). 33| Frequent checks for account transactions: 34| Loop over all accounts to see if there is a transaction command. 35| 36| TEMPERATURE CONTROL SYSTEM in a building: 37| A building with rooms, each with a heating thermostat, and temperature 38| sensor. 39| Global arrays for current temperature and heating requirements for all 40| rooms. 41| Frequent checks for differences. 42| 43| WEATHER DATA COLLECTION SYSTEM: 44| Large number of automatic weather stations, that collect local data, 45| and process it locally. 46| Periodically, the local stations send the locally processed data to a 47| central station for further processing. 48| 49| 50| APPROPRIATE: 51| When the data types and the operations are known in advance, and the 52| frequency of operation application is known. 53| 54| Among the 3 applications----the bank accounts is the more appropriate for 55| procedural handling, provided that ALL types of accounts and 56| transactions are known in advance. 57| REASON: Operations and frequency of activation are more or less known. 58| 59| The weather stations example--least appropriate. Operations and 60| frequency of activation are not known. 61| 62| Critic of procedural programming: The mass of global state objects. 63| Dificult to develop and maintain large systems. 64| Serious name collisions problems. 65| Global information is not safe: 66| No guarantee that only allowed operations will be applied. 67| Anyone can access a bank account record and apply an illegal 68| transaction. The bank account itself includes no provision for 69| allowed transactions. 70| 71| 72| PURE FUNCTIONAL PROGRAMMING 73| ~~~~~~~~~~~~~~~~~~~~~~~~~~~ 74| (Example: Substitution model). 75| 76| A program is a set of functions that are applied when needed. 77| Homogeneous treatment of functions and "values/data". 78| Functions can take functions as arguments, and return functions as 79| values. 80| Result: Functions can be dynamically created during computation. 81| 82| Typical applications: Involve VALUES alone. 83| No assignment. 84| TIME INVARIANCE. 85| 86| Applications are not fully specified tasks, but are subject to 87| continuous modifications/corrections/changes/extensions. 88| Such applications can benefit from dynamic creation of functions, and 89| from the homogeneous treatment of functions and "values/data": 90| Typical areas: Artificial intelligence, expert systems, 91| natural language processing. 92| 93| Programs' characteristics: 94| No GLOBAL information (variables/objects). 95| Functions access only their arguments: Free variables must be 96| substituted by the time that a function is applied (dynamic scoping). 97| Functions are TRUE functions: Always return the same output for a given 98| input. 99| Problematic: Version maintenance, as in Text Editor: Should be copied 100| for each version. 101| 102| 103| 104| ENVIRONMENT MODEL without ASSIGNMENT 105| ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 106| Functional programming + lexical scoping. 107| 108| Free variables, internal definitions are properly supported. 109| TIME INVARIANCE. 110| 111| Functions are TRUE functions: Always return the same output for a given 112| input. 113| 114| 115| ENVIRONMENT MODEL WITH ASSIGNMENT 116| ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 117| Functional programming + lexical scoping + local state variables(objects). 118| 119| Local state variables are supported. 120| TIME DEPENDENT. 121| 122| Typical applications: Involve OBJECTs, i.e., entities that have both 123| identity and values. 124| TIME DEPENDENCY. 125| 126| 127| Program development: 128| If there are multiple types, and we consider an operation-types table 129| (like the one used in the data-directed programming approach), where 130| Rows----operations, 131| Columns----types, 132| then data directed programming is natural. 133| Program development then takes the order of filling one ENTRY at a time in 134| that table. 135| 136| The homogeneous treatment of functions and data makes it easy to write a 137| general table manager (operate). 138| The local state variables enable the management of local tables, for 139| different subjects. 140| 141| 142| OBJECT-ORIENTED PROGRAMMING: 143| ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 144| A program is a set of OBJECTS that are ACTIVATED by GENERIC OPERATORS 145| that can send MESSAGES to objects. Objects trigger actions when they 146| receive messages, and can activate other objects(send messages). 147| 148| Programs' characteristics: 149| Breaks the mass of global variables into small, manageable pieces, 150| called OBJECTS. 151| 152| In other styles: A program is a set of actions that manipulate data/ 153| values/objects. (In functional programming Actions can also be data/ 154| values/objects). 155| In OO: Program is viewed as a set of objects that trigger actions that 156| manipulate objects. 157| 158| Computation control is determined by objects: Initiated by trigerring 159| an object, and continues by objects trigerring other objects. 160| 161| Time dependency---major characteristic. 162| 163| No global state. 164| Modularity. 165| 166| Representation Characteristics: 167| Direct modeling of real world problems (most problems are more naturally 168| captured as a set of objects, not as a set of actions). 169| 170| System development: 171| By object: The operations-types table is filled, one column at a time. 172| A column corresponds to an class definition. 173| 174| Flexibility---programs are easy to modify/extend (due to extreme 175| modularity). 176| Appropriate for parallel execution. 177| 178| Typical applications: Partially specified via object's descriptions. 179| Subject to continuous development. 180| 181| Among the 3 examples above: The weather stations example is most 182| appropriate for OO design. 183| 184| OO DESIGN can be implemented in ANY programming language. Some languages 185| supply data structuring tools that support OO design (make the 186| implementation of OO design easier): C++, Smalltalk, LISP's CLOS package. 187| 188| 189| ESSENTIALS OF OBJECT-ORIENTED DESIGN & PROGRAMMING 190| ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 191| 192| "Definition": 193| Object-orientation = Objects + Classes + Inheritance 194| 195| CLASSES: Mutable ADTs + some options (like local state variables). 196| Here all operators (constructors, selectors, predicates, 197| mutators) are called METHODS. 198| 199| Classes may have messages that MARK the methods. 200| (Methods implement the messages). 201| 202| INHERITANCE: As in type hierarchies. 203| A class can "see" all classes above it. 204| "seeing" means capability for inheritance. 205| A class can INHERIT information (methods, local variables) 206| from ALL classes above it. 207| 208| A class is "protected" from all classes above it: It can have 209| PRIVATE information (methods, variables), HIDDEN from all 210| classes above it. 211| 212| OBJECTS 213| ~~~~~~~ 214| An object is an entity that has a STATE, given by PRIVATE state variables 215| ACTIONS/METHODS/OPERATIONS that can manipulate the object's state. 216| These actions can be: 217| constructors, Mutators, predicates, selectors, operators. 218| An object is TRIGGERED by MESSAGES. 219| Methods implement messages. 220| 221| The object is an AUTONOMOUS entity. Its state and actions are HIDDEN form 222| the rest of the world. 223| 224| INFORMATION HIDING is a major principle. 225| 226| An object can be triggered by sending it MESSAGES that trigger its 227| actions. 228| 229| Equivalently, the methods that apply to an object can be made PUBLIC/ 230| GENERIC, and they can trigger its actions (possibly by sending messages). 231| 232| Objects communicate via MESSAGE PASSING. 233| 234| Objects can be INSTANCEs of classes: 235| Objects can INHERIT information (methods, variables) from classes 236| they BELONGS to. 237| 238| The private information of the object is still HIDDEN from the rest 239| of the world. 240| 241| The class information is SHARED by all instances of the class. 242| All instances of a class share the CODE for all methods. The actual 243| methods can be implemented by separate entities (see the example 244| below). 245| This way many objects can have both: 246| COMMON structure & PRIVATE information. 247| 248| 249| EXAMPLE: BANK ACCOUNTS MANAGEMENT 250| ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 251| 252| A solution in regular functional/procedural style: 253| Define a RECORD structure for an account. 254| Provide generic procedures to manipulate an account's structure: 255| increment, decrement the balance, etc. 256| 257| A major problem: The account is GLOBAL, and every procedure can access it. 258| The account has NO CONTROL over the actions that are 259| applied to it. 260| 261| An OO design: 262| ~~~~~~~~~~~~~ 263| A definition of a CLASS Bank-account: 264| 265| (define (make-account balance) 266| (define (withdraw amount) 267| (if (>= balance amount) 268| (begin (set! balance (- balance amount)) 269| balance) 270| "Insufficient funds")) 271| (define (deposit amount) 272| (set! balance (+ balance amount)) 273| balance) 274| (define (dispatch m) 275| (cond ((eq? m 'withdraw) withdraw) 276| ((eq? m 'deposit) deposit) 277| (else (error "Unknown request -- MAKE-ACCOUNT" m)))) 278| dispatch) 279| 280| This class has 2 methods: 'withdraw', 'deposit'. 281| No local variables. 282| The 'withdraw' method implements the 'withdraw message. 283| The 'deposit' method implements the 'deposit message. 284| 285| 286| Definition of an instance 'acc1' of Bank-account: 287| 288| > (define acc1 (make-account 100)) 289| # 290| 291| Definition of another instance 'acc2' of Bank-account: 292| 293| > (define acc2 (make-account 150)) 294| # 295| 296| The 2 instances of class Bank-account SHARE THE CODE of their methods. 297| But they have separate procedures that act as their methods (we know it 298| from the environment model). 299| 300| Sending messages to objects: 301| > ((acc1 'withdraw) 50) 302| 50 303| > ((acc2 'deposit) 30) 304| 180 305| 306| The messages already triggered the methods that i mplement them. 307| 308| A cleaner implementation of OO-objects: 309| Separate METHODS' SELECTION from METHODS' APPLICATION: 310| 311| 1. Methods' selection: 312| 313| > (define (get-method obj m) (obj m)) 314| # 315| > (define withdraw-method (get-method acc1 'withdraw)) 316| # 317| > (withdraw-method 30) 318| 20 319| 320| 321| 2. Methods' application: 322| 323| > (define (send obj message args) (apply (get-method obj message) args)) 324| # 325| 326| 'apply' is a primitive procedure that "applies" the value of its second 327| argument to the list of arguments that MUST be the value of its third 328| argument. 329| 330| > (send acc1 'withdraw '(35)) 331| "Insufficient funds" 332| 333| This definition of methods' application is very general, as it makes no 334| assumption on the methods' arity. 335| 336| 337| 3. Generic methods: 338| Define generic/public methods using get-method: 339| We have a TEMPLATE for defining generic methods: 340| 341| (define ( obj args ...) 342| (apply (get-method obj ') (list args ...))) 343| 344| For example: 345| > (define (withdraw obj amount) 346| (apply (get-method obj 'withdraw) (list amount))) 347| # 348| > (define (deposit obj amount) 349| (apply (get-method obj 'deposit) (list amount))) 350| # 351| > (deposit acc1 70) 352| 90 353| > (withdraw acc1 30) 354| 60 355| > (withdraw acc2 25) 356| 155 357| 358| EXAMPLE of a CLASS with a local state variable that is SHARED by all of 359| the class's instances: 360| 361| A bank account with a fixed interest: 362| 363| > (define make-interest-account 364| (let ((interest 1)) 365| (lambda (balance) 366| (define (withdraw amount) 367| (if (>= balance amount) 368| (begin (set! balance (- balance amount)) 369| balance) 370| "Insufficient funds")) 371| (define (deposit amount) 372| (set! balance (+ balance amount)) balance) 373| (define (compute-interest) 374| (/ (* balance interest) 100)) 375| (define (dispatch m) 376| (cond ((eq? m 'withdraw) withdraw) 377| ((eq? m 'deposit) deposit) 378| ( (eq? m 'interest) compute-interest) 379| (else (error "Unknown request -- MAKE-ACCOUNT" m)))) 380| dispatch))) 381| # 382| > (define acc1 (make-interest-account 100)) 383| # 384| > (send acc1 'interest ()) 385| 1 386| > (define acc2 (make-interest-account 30)) 387| # 388| > (send acc2 'interest () ) 389| 0.3 390| 391| 392| DELEGATION: 393| ~~~~~~~~~~~ 394| Delegation is passing control to another object. 395| 396| Password protected account: 397| 398| > (define (make-passwd-account password acct) 399| ; *************Insert another BETTER version with: 400| ; (let ((acct (make-account balance))) 401| ; ( rest of body. 402| ; Take-of acct from the args, add balance. 403| ; ****Make similar changes in all examples below. 404| (define (change-password new-pass) 405| (set! password new-pass)) 406| (define (dispatch pass message) 407| (if (eq? pass password) 408| (if (eq? message 'change-password) 409| change-password 410| (acct message)) 411| (lambda (x) 'wrong-password))) 412| dispatch) 413| # 414| > (define accp1 (make-passwd-account 'abra-kadabra acc1)) 415| # 416| > ((accp1 'open-sesami 'withdraw) 30) 417| wrong-password 418| > ((accp1 'abra-kadabra 'deposit) 50) 419| 150 420| > ((accp1 'abra-kadabra 'change-password) 'open-sesame) 421| # 422| > ((accp1 'abra-kadabra 'withdraw) 20) 423| wrong-password 424| 425| 426| If we wish not to use explicit message passing: 427| 428| > (define (get-method obj message-list) (apply obj message-list)) 429| # 430| > (send accp1 '(open-sesame withdraw) '(5)) 431| 145 432| > (send accp1 '(open-sesame change-password) '(roses)) 433| # 434| > (send accp1 '(open-sesame withdraw) '(5)) 435| wrong-password 436| 437| 438| We say that every instance of the Passwd-account class DELEGATES tasks to 439| an instance of the account class. 440| 441| 442| INHERITANCE 443| ~~~~~~~~~~~ 444| Another aspect of delegation: 445| 446| Limited account: 447| 448| > (define (make-limited-account limit acct) 449| (define (withdraw amount) 450| (if (> amount limit) 451| 'over-limit 452| ((acct 'withdraw) amount))) 453| (define (dispatch message) 454| (if (eq? message 'withdraw) 455| withdraw 456| (acct message))) 457| dispatch) 458| # 459| > (define accl2 (make-limited-account 30 acc2)) 460| # 461| > (send accl2 '(withdraw) '(50)) 462| over-limit 463| > (send accl2 '(deposit) '(100)) 464| 130 465| > (send accl2 '(withdraw) '(20)) 466| 110 467| 468| 469| Limited-account is a class that INHERITS all methods of Account but 470| 'withdraw. Its local "withdraw' method SHADOWS the 'withdraw method of 471| Account. 472| Similarly, above, Passwd-account inherits all methods of Account, and has 473| a single additional method. 474| 475| 476| MULTIPLE INHERITANCE: 477| 478| Documented account: 479| 480| (define (make-documented-account information acct) 481| (lambda (message) 482| (if (eq? message 'document) 483| (lambda () information) 484| (acct message)))) 485| 486| 487| Documented-limited account: 488| 489| (define (make-documented-limited-account dacct lacct) 490| (lambda (message) 491| (if (eq? message 'document) 492| (dacct message) 493| (lacct message)))) 494| 495| 496| > (define acc1 (make-account 100)) 497| # 498| > (define accl1 (make-limited-account 50 acc1)) 499| # 500| > (define accd1 (make-documented-account '(bob rose) acc1)) 501| # 502| > (define accdl1 (make-documented-limited-account accd1 accl1)) 503| # 504| > (send accdl1 'document ()) 505| (bob rose) 506| > (send accdl1 'withdraw '(60)) 507| over-limit 508| > (send accdl1 'deposit '(50)) 509| 150 510| 511| 512| We say that the Documented-limited-account class inherits from the 513| Limited-account class and from the Documented-account class. 514| This is an example of MULTIPLE INHERITANCE. 515| 516| 517| Limited-password account: 518| 519| (define (make-limited-passwd-account lacct pacct) 520| (lambda (message) 521| (cond ((atom? message) (print "ERROR--wrong message type")) 522| ((and (not (null? (cdr message))) 523| (eq? (cadr message) 'change-password)) 524| (apply pacct message)) 525| (else (lacct (car message)))))) 526| 527| 528| There are several problems here: 529| 1. The above class definition is not what we want: 530| The password is actually overpassed. It is never checked, just 531| changed!! We want a way to "mix" the 'withdraw' method of Limited- 532| account, with that of Passwd-account, that first checks the password. 533| There is no SINGLE 'withdraw' method that we wish to inherit. 534| 2. The arity of the messages that Passwd-account and Limited-account get 535| is different. That's why we have to assume that message is a list of 536| message-arguments. 537| 538| 539| 540| EXAMPLE: Using YASOS (Yet Another Scheme Object System) 541| ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 542| Scheming with Objects 543| ~~~~~~~~~~~~~~~~~~~~~~~ 544| 545| YASOS provides tools for OO programming. 546| 547| *** 1. Generic predicate for already defined characterizing objects: 548| INSTANCE? 549| In order to know what data objects are "instances", we have a predicate - 550| INSTANCE?, which takes a single argument and answers #t or #f. 551| > (instance? sally) 552| #t 553| > (ssn 3 's) 554| 555| ERROR: Operation not handled ssn "3" 556| ; This a message printed by YASOS. 557| 558| *** 2. INTERFACE for a class' methods: 559| DEFINE-PREDICATE 560| For each kind of object is also useful to have a predicate, so we define a 561| predicate maker: (DEFINE-PREDICATE ) which by default answers #f. 562| (define-predicate PERSON?) 563| 564| DEFINE-OPERATION 565| To define operations which operate on any data, we need a default behavior 566| for data objects which don't handle the operation: 567| (DEFINE-OPERATION (opname self arg ...) default-body). 568| If we don't supply a default-behavior, the default default-behavior is to 569| generate an error. 570| (define-operation (NAME obj)) 571| 572| (define-operation (BAD-PASSWORD obj bogus-passwd) 573| ;; assume internal (design) error 574| (error (format #f "Bad Password: ~s given to ~a~%" 575| bogus-passwd 576| (print obj #f)))) 577| 578| *** 3. Tools for classes' definition: 579| The tools provide a way to describe the form of objects in the class. 580| The assumption is that a class is defined as a procedural object, such 581| that each application of the class-object generates an instance object. 582| The class definition tools provide an easy way to describe the objects 583| (instances) of the class, and their methods (since they are all instances 584| of the same class, they have a common structure). 585| 586| There are two tools to define a class' instance: 587| 588| OBJECT 589| ~~~~~~ 590| OBJECT defines objects with specified methods. 591| Syntax: (OBJECT operation... ), 592| where an operation has the form: 593| ((opname self arg ...) body). 594| For example: 595| (object 596| ((PERSON? self) #t) 597| ((NAME self) a-name) 598| ((AGE self) an-age) 599| ((SET-AGE! self val) (set! an-age val) an-age) 600| ((SSN self password) 601| (if (equal? password the-password) 602| a-SSN 603| (bad-password self password))) 604| ((NEW-PASSWORD obj old-passwd new-passwd) 605| (cond 606| ((equal? old-passwd the-password) 607| (set! the-password new-passwd) self) 608| (else (bad-password self old-passwd)))) 609| ((BAD-PASSWORD self bogus-passwd) 610| (format #t "Bad password: ~s~%" bogus-passwd)) ;; let user recover 611| ((PRINT self port) 612| (format port "#" (name self) (age self)))) 613| 614| This application is applied from within the PERSON class, and the values 615| required by the various methods are given in the application. 'self' is a 616| local state variable, created in each object's environment. It represents 617| the object itself (like the 'dispatch' procedure in the previous 618| examples). 619| 620| The full definition for class person is: 621| 622| ;;---------------------- 623| ;; person implementation 624| ;;---------------------- 625| (define (MAKE-PERSON a-name an-age a-SSN the-password) 626| (object 627| ((PERSON? self) #t) 628| ((NAME self) a-name) 629| ((AGE self) an-age) 630| ((SET-AGE! self val) (set! an-age val) an-age) 631| ((SSN self password) 632| (if (equal? password the-password) 633| a-SSN 634| (bad-password self password))) 635| ((NEW-PASSWORD obj old-passwd new-passwd) 636| (cond 637| ((equal? old-passwd the-password) 638| (set! the-password new-passwd) self) 639| (else (bad-password self old-passwd)))) 640| ((BAD-PASSWORD self bogus-passwd) 641| (format #t "Bad password: ~s~%" bogus-passwd)) ;; let user recover 642| ((PRINT self port) 643| (format port "#" (name self) (age self))))) 644| 645| 646| A person's creation is obtained by applying 'make-person" with actual 647| arguments: 648| 649| > (define FRED (make-person "Fred" 19 "573-19-4279" #xFadeCafe)) 650| # 651| 652| 653| OBJECT-WITH-ANCESTORS 654| ~~~~~~~~~~~~~~~~~~~~~ 655| OBJECT-WITH-ANCESTORS defines objects TOGETHER WITH ancestors objects, 656| from to which it can DELEGATE some methods. This way we implement 657| inheritance (possibly multiple). 658| The syntax is a LET-like form: 659| (OBJECT-WITH-ANCESTORS 660| ( (ancestor1 init1) ...) 661| operation ...) 662| 663| In the case of multiple inherited operations with the same identity, the 664| operation used is the one found in the first ancestor in the ancestor 665| list. 666| For example, to implement objects for 2D points and 3D points: 667| 668| (define-operation (PRINT obj port) 669| (format port ;; *** see LISTING: format *** 670| ;; if an instance does not have a PRINT operation.. 671| (if (instance? obj) "#" "~s") 672| obj)) 673| 674| (define-operation (SIZE obj) 675| ;; default behavior 676| (cond 677| ((vector? obj) (vector-length obj)) 678| ((list? obj) (length obj)) 679| ((pair? obj) 2) 680| ((string? obj) (string-length obj)) 681| ((char? obj) 1) 682| (else (error "Operation not supported: size" obj)))) 683| 684| 685| ;;---------------- 686| ;; point interface 687| ;;---------------- 688| (define-predicate POINT?) ;; answers #f (false) by default 689| (define-operation (X obj)) 690| (define-operation (Y obj)) 691| (define-operation (SET-X! obj new-x)) 692| (define-operation (SET-Y! obj new-y)) 693| 694| ;;--------------------- 695| ;; point implementation 696| ;;--------------------- 697| (define (MAKE-POINT the-x the-y) 698| (object 699| ((POINT? self) #t) ;; yes, this is a point object 700| ((X self) the-x) 701| ((Y self) the-y) 702| ((SET-X! self val) (set! the-x val) the-x) 703| ((SET-Y! self val) (set! the-y val) the-y) 704| ((SIZE self) 2) 705| ((PRINT self port) 706| (format port "#" (x self) (y self))))) 707| 708| ;;----------------------------- 709| ;; 3D point interface additions 710| ;;----------------------------- 711| (define-operation (Z obj)) 712| (define-operation (SET-Z! obj new-z)) 713| 714| ;;------------------------ 715| ;; 3D point implementation 716| ;;------------------------ 717| 718| (define (MAKE-POINT-3D the-x the-y the-z) 719| (object-with-ancestors ((a-point (make-point the-x the-y))) 720| ((Z self) the-z) 721| ((SET-Z! self val) (set! the-z val) the-z) 722| ;; override inherited SIZE and PRINT operations 723| ((SIZE self) 3) 724| ((PRINT self port) 725| (format port "#<3D-point: ~a ~a ~a>" (x self) (y self) (z self))))) 726| 727| For example: 728| (define P2 (make-point 123 32131)) 729| (define P3 (make-point-3d 32 121 3232)) 730| (size "a string") -> 8 731| (size p2) -> 2 732| (size p3) -> 3 733| (point? p2) -> #t 734| (point? p3) -> #t 735| (point? "a string") -> #f 736| (x p2) -> 123 737| (x p3) -> 32 738| (x "a string") -> ERROR: Operation not handled: x "a string" 739| (print p2 #t) # 740| (print p3 #t) #<3D-point: 32 121 3232> 741| (print "a string" #t) "a string" 742| 743| 744| 745| OPERATE-AS 746| ~~~~~~~~~~ 747| OPERATE-AS is the "send to super" tool. It enables an object to operate as 748| an ancestor, but maintain its own self identity. It acts like "delegating" 749| to an ancestor a method, triggered with the self identity of the 750| delegator. 751| The syntax is: 752| (OPERATE-AS component operation self arg ...) 753| 754| where 'component' is the ancestor object, 'operation' is the method we 755| wish to inherit, 'self' is the delegating object, and any number of 756| additional arguments can be passed. 757| 758| An example using OPERATE-AS: 759| 760| ;;-------------------------------------------- 761| ;; account-history and bank-account interfaces 762| ;;-------------------------------------------- 763| (define-predicate BANK-ACCOUNT?) 764| (define-operation (CURRENT-BALANCE account pin)) 765| (define-operation (ADD obj amount)) 766| (define-operation (WITHDRAW obj amount pin)) 767| (define-operation (GET-PIN account master-password)) 768| (define-operation (GET-ACCOUNT-HISTORY account master-password)) 769| 770| ;;------------------------------- 771| ;; account-history implementation 772| ;;------------------------------- 773| ;; put access to bank database and report generation here 774| 775| (define (MAKE-ACCOUNT-HISTORY initial-balance a-PIN master-password) 776| ;; history is a simple list of balances -- no transaction times 777| (letrec ((history (list initial-balance)) 778| (balance (lambda () (car history))) ; balance is a function 779| (remember 780| (lambda (datum) (set! history (cons datum history))))) 781| (object 782| ((BANK-ACCOUNT? self) #t) 783| ((ADD self amount) ;; bank will accept money without a password 784| (remember (+ amount (balance))) 785| ;; print new balance 786| (format #t "New balance: $~a~%" (balance))) 787| ((WITHDRAW self amount pin) 788| (cond ((not (equal? pin a-pin)) (bad-password self pin)) 789| ((< (- (balance) amount) 0) 790| (format #t 791| "No overdraft~% Can't withdraw more than you have: $~a~%" 792| (balance))) 793| (else (remember (- (balance) amount)) 794| (format #t "New balance: $~a~%" (balance))))) 795| ((CURRENT-BALANCE self password) 796| (if (or (eq? password master-password) (equal? password a-pin)) 797| (format #t "Your Balance is $~a~%" (balance)) 798| (bad-password self password))) 799| ;; only bank has access to account history 800| ((GET-ACCOUNT-HISTORY account password) 801| (if (eq? password master-password) 802| history 803| (bad-password self password)))))) 804| 805| ;;---------------------------- 806| ;; bank-account implementation 807| ;;---------------------------- 808| (define (MAKE-ACCOUNT a-name an-age a-SSN a-PIN 809| initial-balance master-password) 810| (object-with-ancestors 811| ((customer (make-person a-name an-age a-SSN a-PIN)) 812| (account (make-account-history initial-balance 813| a-PIN master-password))) 814| ((GET-PIN self password) 815| (if (eq? password master-password) 816| a-PIN 817| (bad-password self password))) 818| ((GET-ACCOUNT-HISTORY self password) 819| (operate-as account get-account-history self password)) 820| ;; our bank is very conservative... 821| ((BAD-PASSWORD self bogus-passwd) 822| (format #t "~%CALL THE POLICE!!~%")) 823| ;; protect the customer as well 824| ((SSN self password) 825| (operate-as customer SSN self password)) 826| ((PRINT self port) 827| (format port "#" (name self))))) 828| 829| 830| EXAMPLES: 831| ~~~~~~~~~ 832| (define FRED (make-person "Fred" 19 "573-19-4279" #xFadeCafe)) 833| (define SALLY 834| (make-account "Sally" 26 "629-26-9742" #xFeedBabe 263 'scheme)) 835| 836| (print fred #t) # 837| (print sally #t) # 838| (person? sally) -> #t 839| (bank-account? sally) -> #t 840| (ssn fred #xFadeCafe) -> "573-19-4279" 841| (ssn sally #xFeedBabe) -> "629-26-9742" 842| (add sally 130) New balance: $393 843| (add sally 55) New balance: $448 844| 845| ; the bank can act in Sally's behalf 846| (get-account-history sally 'scheme) --> (448 393 263) 847| (withdraw sally 100 (get-pin sally 'scheme)) New balance: $348 848| (get-account-history sally 'scheme) --> (348 448 393 263) 849| 850| ;; Fred forgets 851| (ssn fred 'bogus) Bad password: bogus ;; Fred gets another chance 852| 853| ;; Sally forgets 854| (ssn sally 'bogus) CALL THE POLICE!! ;; A more serious result.. 855| 856| Now we see the reason we need OPERATE-AS. When the bank-account object 857| delegates the SSN operation to its ancestor, person, SELF is bound to the 858| bank-account object--not the person object. This means that while the 859| code for SSN is inherited from person, the BAD-PASSWORD operation of the 860| bank-account is used. 861| 862| This is an important behavior to have in an object system. If there were 863| no OPERATE-AS, code would have to be duplicated in order to implement the 864| stricter form of BAD-PASSWORD. With OPERATE-AS, we can safely SHARE CODE 865| while keeping operations localized within the inheritance hierarchy. 866| 867| 868| *********************** 869| *LISTING: Bank accounts 870| *********************** 871| 872| ;;----------------- 873| ;; person interface 874| ;;----------------- 875| (define-predicate PERSON?) 876| (define-operation (NAME obj)) 877| (define-operation (AGE obj)) 878| (define-operation (SET-AGE! obj new-age)) 879| (define-operation (SSN obj password)) ;; Social Security # is protected 880| (define-operation (NEW-PASSWORD obj old-passwd new-passwd)) 881| (define-operation (BAD-PASSWORD obj bogus-passwd) 882| ;; assume internal (design) error 883| (error (format #f "Bad Password: ~s given to ~a~%" 884| bogus-passwd 885| (print obj #f)))) 886| 887| ;;---------------------- 888| ;; person implementation 889| ;;---------------------- 890| (define (MAKE-PERSON a-name an-age a-SSN the-password) 891| (object 892| ((PERSON? self) #t) 893| ((NAME self) a-name) 894| ((AGE self) an-age) 895| ((SET-AGE! self val) (set! an-age val) an-age) 896| ((SSN self password) 897| (if (equal? password the-password) 898| a-SSN 899| (bad-password self password))) 900| ((NEW-PASSWORD obj old-passwd new-passwd) 901| (cond 902| ((equal? old-passwd the-password) 903| (set! the-password new-passwd) self) 904| (else (bad-password self old-passwd)))) 905| ((BAD-PASSWORD self bogus-passwd) 906| (format #t "Bad password: ~s~%" bogus-passwd)) ;; let user recover 907| ((PRINT self port) 908| (format port "#" (name self) (age self))))) 909| 910| ;;-------------------------------------------- 911| ;; account-history and bank-account interfaces 912| ;;-------------------------------------------- 913| (define-predicate BANK-ACCOUNT?) 914| (define-operation (CURRENT-BALANCE account pin)) 915| (define-operation (ADD obj amount)) 916| (define-operation (WITHDRAW obj amount pin)) 917| (define-operation (GET-PIN account master-password)) 918| (define-operation (GET-ACCOUNT-HISTORY account master-password)) 919| 920| ;;------------------------------- 921| ;; account-history implementation 922| ;;------------------------------- 923| ;; put access to bank database and report generation here 924| 925| (define (MAKE-ACCOUNT-HISTORY initial-balance a-PIN master-password) 926| ;; history is a simple list of balances -- no transaction times 927| (letrec ((history (list initial-balance)) 928| (balance (lambda () (car history))) ; balance is a function 929| (remember 930| (lambda (datum) (set! history (cons datum history))))) 931| (object 932| ((BANK-ACCOUNT? self) #t) 933| ((ADD self amount) ;; bank will accept money without a password 934| (remember (+ amount (balance))) 935| ;; print new balance 936| (format #t "New balance: $~a~%" (balance))) 937| ((WITHDRAW self amount pin) 938| (cond ((not (equal? pin a-pin)) (bad-password self pin)) 939| ((< (- (balance) amount) 0) 940| (format #t 941| "No overdraft~% Can't withdraw more than you have: $~a~%" 942| (balance))) 943| (else (remember (- (balance) amount)) 944| (format #t "New balance: $~a~%" (balance))))) 945| ((CURRENT-BALANCE self password) 946| (if (or (eq? password master-password) (equal? password a-pin)) 947| (format #t "Your Balance is $~a~%" (balance)) 948| (bad-password self password))) 949| ;; only bank has access to account history 950| ((GET-ACCOUNT-HISTORY account password) 951| (if (eq? password master-password) 952| history 953| (bad-password self password)))))) 954| 955| ;;---------------------------- 956| ;; bank-account implementation 957| ;;---------------------------- 958| (define (MAKE-ACCOUNT a-name an-age a-SSN a-PIN 959| initial-balance master-password) 960| (object-with-ancestors 961| ((customer (make-person a-name an-age a-SSN a-PIN)) 962| (account (make-account-history initial-balance 963| a-PIN master-password))) 964| ((GET-PIN self password) 965| (if (eq? password master-password) 966| a-PIN 967| (bad-password self password))) 968| ((GET-ACCOUNT-HISTORY self password) 969| (operate-as account get-account-history self password)) 970| ;; our bank is very conservative... 971| ((BAD-PASSWORD self bogus-passwd) 972| (format #t "~%CALL THE POLICE!!~%")) 973| ;; protect the customer as well 974| ((SSN self password) 975| (operate-as customer SSN self password)) 976| ((PRINT self port) 977| (format port "#" (name self)))))