From 0a286a00a66cfca8cbc0d3d1c3c3b4dd27ef4497 Mon Sep 17 00:00:00 2001 From: duboissim Date: Fri, 26 Apr 2024 19:34:26 +0200 Subject: [PATCH] modified info for point to show y --- project-2/step3.bak | 66 +++++++++++++++++++++++++ project-2/step3.rkt | 7 --- project-2/step4.bak | 118 ++++++++++++++++++++++++++++++++++++++++++++ project-2/step4.rkt | 2 +- 4 files changed, 185 insertions(+), 8 deletions(-) create mode 100644 project-2/step3.bak create mode 100644 project-2/step4.bak diff --git a/project-2/step3.bak b/project-2/step3.bak new file mode 100644 index 0000000..5492832 --- /dev/null +++ b/project-2/step3.bak @@ -0,0 +1,66 @@ +(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 diff --git a/project-2/step3.rkt b/project-2/step3.rkt index 5492832..bb863c7 100644 --- a/project-2/step3.rkt +++ b/project-2/step3.rkt @@ -30,13 +30,6 @@ 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))) diff --git a/project-2/step4.bak b/project-2/step4.bak new file mode 100644 index 0000000..eabc9b5 --- /dev/null +++ b/project-2/step4.bak @@ -0,0 +1,118 @@ +(define (object) + (define super 'nil) + (define self 'nil) + (define (set-self!) (lambda (s) (set! self s))) + (define (internal m) + (cond + ((eq? m 'type) (lambda () 'object)) + ((eq? m 'info) (lambda () (list (send self 'type)))) + ((eq? m 'set-self!) (set-self!)) + (else (lambda args (display (string-append "Message not understood: " (symbol->string m) "\n")))) + ) + ) + internal +) + +(define (point x y) + (define super (object)) + (define self 'nil) + (define (set-self!) (lambda (s) + (set! self s) + (method-lookup super (list 'set-self! s)) + )) + (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 () (append ((super 'info)) (list x)))) + (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 (internal m) + (cond ((eq? m 'set-self!) (set-self!)) + ((eq? m 'type) (type)) + ((eq? m 'getx) (getx)) + ((eq? m 'gety) (gety)) + ((eq? m 'setx!) (setx!)) + ((eq? m 'sety!) (sety!)) + ((eq? m 'info) (info)) + ((eq? m 'add) (add)) + ((eq? m 'sub) (sub)) + (else (lambda args (method-lookup super (list m args)))) + ) + ) + internal + ) + +(define (color-point x y color) + (define super (point x y)) + (define self 'nil) + (define (set-self!) (lambda (s) + (set! self s) + (method-lookup super (list 'set-self! s)) + )) + (define (type) (lambda () 'color-point)) + (define (get-color) (lambda () color)) + (define (info) (lambda () (append ((super 'info)) (list color)))) + (define (add) (lambda (p) + (let ((px ((p 'getx))) + (py ((p 'gety)))) + (color-point (+ x px) (+ y py) color) + ) + )) + (define (sub) (lambda (p) + (let ((px ((p 'getx))) + (py ((p 'gety)))) + (color-point (- x px) (- y py) color) + ) + )) + + (define (internal m) + (cond ((eq? m 'set-self!) (set-self!)) + ((eq? m 'type) (type)) + ((eq? m 'get-color) (get-color)) + ((eq? m 'info) (info)) + ((eq? m 'add) (add)) + (else (lambda args (method-lookup super (cons m args)))) + ) + ) + internal +) + +(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 (new cls . args) + (let ((object (apply cls args))) + (send object 'set-self! object) + object + ) +) + +(define cp (new color-point 5 6 'red)) +(send cp 'type) ; color−point +(send cp 'getx) ; 5 +(send cp 'gety) ; 6 +(send cp 'get-color) ; red +(send cp 'info) ; (color−point 5 6 red diff --git a/project-2/step4.rkt b/project-2/step4.rkt index eabc9b5..038e50a 100644 --- a/project-2/step4.rkt +++ b/project-2/step4.rkt @@ -25,7 +25,7 @@ (define (type) (lambda () 'point)) (define (setx!) (lambda (nx) (set! x nx))) (define (sety!) (lambda (ny) (set! y ny))) - (define (info) (lambda () (append ((super 'info)) (list x)))) + (define (info) (lambda () (append ((super 'info)) (list x y)))) (define (add) (lambda (p) (let ((px ((p 'getx))) (py ((p 'gety))))