From d121b0d1e90c1b5b21107023093ddebd4dd1aabf Mon Sep 17 00:00:00 2001 From: duboissim Date: Tue, 23 Apr 2024 22:05:17 +0200 Subject: [PATCH] project2 --- project-2/step0.rkt | 16 +++++++++++ project-2/step1.rkt | 34 +++++++++++++++++++++++ project-2/step2.rkt | 39 ++++++++++++++++++++++++++ project-2/step3.rkt | 67 +++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 156 insertions(+) create mode 100644 project-2/step0.rkt create mode 100644 project-2/step1.rkt create mode 100644 project-2/step2.rkt create mode 100644 project-2/step3.rkt diff --git a/project-2/step0.rkt b/project-2/step0.rkt new file mode 100644 index 0000000..6287105 --- /dev/null +++ b/project-2/step0.rkt @@ -0,0 +1,16 @@ +(define (point x y) + (define (dispatch m) + (cond ((eq? m 'getx) x) + ((eq? m 'gety) y) + ((eq? m 'type) 'point) + ((eq? m 'info) (list 'point x y)) + (else (display (string-append "point as no method: " (symbol->string m) "\n"))))) + dispatch) +(define p (point 1 2)) +(p 'getx) ; 1 +(p 'gety) ; 2 +(p 'type) ; point +(p 'info) ; (point 1 2) +(p 'foo) ; display "point as no method: foo + + diff --git a/project-2/step1.rkt b/project-2/step1.rkt new file mode 100644 index 0000000..9667431 --- /dev/null +++ b/project-2/step1.rkt @@ -0,0 +1,34 @@ +(define (point x y) + (define (self m) + (cond ((eq? m 'getx) (lambda () x)) + ((eq? m 'gety) (lambda () y)) + ((eq? m 'type) (lambda () 'point)) + ((eq? m 'setx!) (lambda (nx) (set! x nx))) + ((eq? m 'sety!) (lambda (ny) (set! y ny))) + ((eq? m 'info) (lambda () (list 'point x y))) + ((eq? m 'add) (lambda (p) + (let ((px ((p 'getx))) + (py ((p 'gety)))) + (point (+ x px) (+ y py))))) + ((eq? m 'sub) (lambda (p) + (let ((px ((p 'getx))) + (py ((p 'gety)))) + (point (- x px) (- y py))))) + (else (lambda () (display (string-append "Message not understood: " (symbol->string m) "\n")))))) + self) + +(define p1 (point 1 2)) +(define p2 (point 3 4)) +((p1 'getx)) ; returns 1 +((p1 'gety)) ; returns 2 +((p2 'getx)) ; returns 3 +((p2 'gety)) ; returns 4 +(define pp ((p1 'add) p2)) ; returns a new point pp +((pp 'info)) ; returns (point 4 6) +(define pn ((p1 'sub) p2)) ; returns a new point pn +((pn 'info)) ; returns (point -2 -2) +((pp 'foo)) ; should display "Message not understood" error +((p1 'setx!) 5) +((p1 'sety!) 5) +((p1 'info)) ; returns (point 5 5) + diff --git a/project-2/step2.rkt b/project-2/step2.rkt new file mode 100644 index 0000000..5f18580 --- /dev/null +++ b/project-2/step2.rkt @@ -0,0 +1,39 @@ +(define (point x y) + (define (self m) + (cond ((eq? m 'getx) (lambda () x)) + ((eq? m 'gety) (lambda () y)) + ((eq? m 'type) (lambda () 'point)) + ((eq? m 'setx!) (lambda (nx) (set! x nx))) + ((eq? m 'sety!) (lambda (ny) (set! y ny))) + ((eq? m 'info) (lambda () (list 'point x y))) + ((eq? m 'add) (lambda (p) + (let ((px ((p 'getx))) + (py ((p 'gety)))) + (point (+ x px) (+ y py))))) + ((eq? m 'sub) (lambda (p) + (let ((px ((p 'getx))) + (py ((p 'gety)))) + (point (- x px) (- y py))))) + (else (lambda () (display (string-append "Message not understood: " (symbol->string m) "\n")))))) + self) + +(define (send 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 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 \ No newline at end of file diff --git a/project-2/step3.rkt b/project-2/step3.rkt new file mode 100644 index 0000000..afdf22c --- /dev/null +++ b/project-2/step3.rkt @@ -0,0 +1,67 @@ +(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 () (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 . args) + (display (null? args)) + (if (= (length args) 1) + ((reciever message)) + ((reciever message)(car args)) + )) + +(define (send reciever message . args) + (if (procedure? reciever) + (method-lookup reciever message args) + (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 \ No newline at end of file