(define (point x y) (define (getx) (lambda () x)) (define (gety) (lambda () y)) (define (type) (lambda () 'point)) (define (setx!) (lambda (nx) (set! x nx))) (define (sety!) (lambda (ny) (set! y ny))) (define (info) (lambda () (list 'point x y))) (define (add) (lambda (p) (let ((px ((p 'getx))) (py ((p 'gety)))) (point (+ x px) (+ y py)) ) )) (define (sub) (lambda (p) (let ((px ((p 'getx))) (py ((p 'gety)))) (point (- x px) (- y py)) ) )) (define (self m) (cond ((eq? m 'getx) (getx)) ((eq? m 'gety) (gety)) ((eq? m 'type) (type)) ((eq? m 'setx!) (setx!)) ((eq? m 'sety!) (sety!)) ((eq? m 'info) (info)) ((eq? m 'add) (add)) ((eq? m 'sub) (sub)) (else (lambda args (display (string-append "Message not understood: " (symbol->string m) "\n")))))) self ) (define (send2 obj . args) (if (procedure? obj) (if (= (length args) 1) ((obj (car args))) ((obj (car args)) (car (cdr args)))) ; Extracting the second argument (display (string-append "Inappropriate receiver object: " (symbol->string obj) "\n")))) (define (method-lookup reciever message) (if (= (length message) 1) ((reciever (car message))) ((reciever (car message)) (car (cdr message))) )) (define (send reciever . message) (if (procedure? reciever) (method-lookup reciever message) (display (string-append "Inappropriate receiver object: " (symbol->string reciever) "\n")) ) ) (define p1 (point 1 2)) (define p2 (point 3 4)) (send p1 'getx) ; 1 (send p1 'gety) ; 2 (send p2 'getx) ; 3 (send p2 'gety) ; 4 (define p (send p1 'add p2)) (send p 'info) ; (point 4 6) (send 'not-a-point 'info) ; should display "Inappropriate receiver object" (send p 'foo) ; should display "Message not understood" (send p 'bar 2) ; should display "Message not understood" (send p1 'setx! 5) (send p1 'getx) ; returns 5