diff --git a/step_4.rkt b/step_4.rkt index acbb2b6d91c9af2287bb03928e847b2a227492aa..ea66803ddb41f0e5f495840d2fa6f2fa0c1adec0 100644 --- a/step_4.rkt +++ b/step_4.rkt @@ -1,4 +1,22 @@ +#lang r5rs +; Authors : Nicolas Verbois - 1366 1600 +; Nicolas Rosar - 1443 1900 +; Group F + +; In this last step, we want to implement a way of executing the calls delegated to a method defined in the super class +; in the context of the child class. This will be done using what we have called a "self_ref" value inside each class. +; We have also created a new constructor procedure, that will handle the creation of any class instance, and will help +; the achieve this dynamic binding of self. + +; The purpose of the self_ref value is linked to the special method named 'set-self! that we have added to each class. +; It binds self_ref to a given instance and then recursively calls the same 'set-self! method on the superclass to bind +; its self_ref to that same instance, solving the dynamic binding issue. + +; For the object class, we don't need a recursive call to the super class in the set_self! method since it is the root +; of our inheritance hierarchy. +; Thus, in this case, we do not propagate the set_self! method and instead only dynamically bind the local self_ref value. (define (object) + ; #f is the default value before any binding (define self_ref #f) (define (set-self! ref) (set! self_ref ref)) (define (gettype) 'object) @@ -8,7 +26,8 @@ (else (display "Message not understood")))) self) -; COLOR-POINT +; For the color-point class, since it is a child class of point, we need to propagate the set-self! call to the super class. +; Thus, we have an extra line in the definition of the set_self! procedure to propagate the dynamic binding upwards. (define (color-point x y color) (define self_ref #f) (define super (point x y)) @@ -31,7 +50,7 @@ (else (super m)))) self) -;POINT +; For the point class, as it is a child class of object, we also need to propagate the set-self! call to the super class. (define (point x y) (define self_ref #f) (define (set-self! ref) @@ -61,6 +80,7 @@ (else (super m)))) self) + (define (send p m . args) (if (procedure? p) (cond @@ -73,6 +93,11 @@ ) +; The new construtctor procedure. +; It has to take as parameters one object-class, as well as a variable numbler of +; class parameters. +; It will then create the new object, and initiate the dynamic binding of self through +; a 'set-self call. (define (new object-class . class-args) (let ((temp (apply object-class class-args))) (begin @@ -82,10 +107,30 @@ ) ) -(eq? color-point point) -( define cp ( new color-point 5 6 'red ) ) -( send cp 'type ) ; c o l o r - p o i n t -( send cp 'getx ) ; 5 -( send cp 'gety ) ; 6 -( send cp 'get-color ) ; red -( send cp 'info ) ; ( c o l o r - p o i n t 5 6 red ) + + +; Sample code illustrating the execution of the step + +; We can prove that the dynamic binding indeed worked with the followig piece of code. +; Indeed, with the current implementation, if the dynamic binding were not to work, +; then the 'info message sent to the color point would return something wrong. + +; It is because the way we build the return value of the 'info message in the color-point +; class is done using informations retrieved by the parent class, and appending other informations +; to this : (append (send super 'info) ... )). + +; Without dynamic binding, the parent point class would have no clue it is called by a color-point object, +; and thus return the information of a point and not a color-point. + + +(define cp (new color-point 5 6 'red)) +(display (send cp 'type)) ; should display : color-point +(newline) +(display (send cp 'getx)) ; should display : 5 +(newline) +(display (send cp 'gety)) ; should display : 6 +(newline) +(display (send cp 'get-color)) ; should display : red +(newline) +(display (send cp 'info )) ; should display : (color-point 5 6 red) +(newline)