diff --git a/project-2/step3b.rkt b/project-2/step3b.rkt new file mode 100644 index 0000000..a53a115 --- /dev/null +++ b/project-2/step3b.rkt @@ -0,0 +1,82 @@ +(define (object) + (define super 'nil) + (define (self m) + (cond + ((eq? m 'type) (lambda () 'object)) + (else (lambda () (display (string-append "Message not understood: " (symbol->string m) "\n")))) + ) + ) + self +) + +(define (point x y) + (define super (object)) + (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 () (method-lookup super (list m)))) + ) + ) + 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 'test); +(send p 'info) ; (point 4 6) +(send 'not-a-point 'info) ; should display "Inappropriate receiver object" +(send p 'foo) ; should display "Message not understood" +; Same issue than step3 +;(send p 'bar 2) ; should display "Message not understood" +(send p1 'setx! 5) +(send p1 'getx) ; returns 5