project2

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
+
+

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)
+

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

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