Bhasher/linfo2335-programming-paradigms
Bhasher
/
linfo2335-programming-paradigms
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

modified info for point to show y

This commit is contained in:
duboissim 2024-04-26 19:34:26 +02:00
parent 83ae721927
commit 0a286a00a6
4 changed files with 185 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

66
project-2/step3.bak Normal file
View File

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

7
project-2/step3.rkt
View File

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

118
project-2/step4.bak Normal file
View File

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

2
project-2/step4.rkt
View File

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