diff options
author | Julian T <julian@jtle.dk> | 2021-09-29 11:32:48 +0200 |
---|---|---|
committer | Julian T <julian@jtle.dk> | 2021-09-29 11:32:48 +0200 |
commit | 9c140071e8160548ef64c4f911f965422578f43a (patch) | |
tree | 889183c6ec9eb2933495bd95e6d32aefc617ce0a | |
parent | d83e22dd7b58f086de9655497a9ddbf51f0a048f (diff) |
Make pp lec3 nicer again
-rw-r--r-- | sem7/pp/lec3.scm | 110 |
1 files changed, 50 insertions, 60 deletions
diff --git a/sem7/pp/lec3.scm b/sem7/pp/lec3.scm index d1aa174..42b30e1 100644 --- a/sem7/pp/lec3.scm +++ b/sem7/pp/lec3.scm @@ -16,77 +16,67 @@ [else "?"] ))) -(define (create-dispatch methods not-found) - (lambda (msg) - (cdr (or (assoc msg methods) (not-found msg))) - )) - (define (send obj msg . para) - (let ((method (obj msg))) + (let ((method (obj obj msg))) (apply method para))) (define (new-instance class . para) - (apply class (cons #f para))) + (apply class para)) ;; TODO implement str -(define (object self) - (letrec ([whoami 'object] - [dispatch - (lambda (msg) - (let ([self (or self dispatch)]) - (cond [(eq? msg 'pretty-str) (lambda () (to-string (send self 'pretty)))] - [(eq? msg 'pretty) (lambda () (list whoami))] - [(eq? msg 'type-of) (lambda () whoami)] - [(eq? msg 'class-of) (lambda () object)] - [else (errorf object "msg ~a not found" msg)]) - ))]) dispatch)) +(define (object) + (let ([whoami 'object]) + (lambda (self msg) + (cond [(eq? msg 'pretty-str) (lambda () (to-string (send self 'pretty)))] + [(eq? msg 'pretty) (lambda () (list whoami))] + [(eq? msg 'type-of) (lambda () whoami)] + [(eq? msg 'class-of) (lambda () object)] + [else (errorf object "msg ~a not found" msg)]) + ))) + +(define (point x y) + (let ([whoami 'point] + [super (object)]) + (lambda (self msg) + (cond [(eq? msg 'getx) (lambda () x)] + [(eq? msg 'gety) (lambda () y)] + [(eq? msg 'add) (lambda (other) + (new-instance (send self 'class-of) + (+ x (send other 'getx)) + (+ y (send other 'gety)) + ))] + [(eq? msg 'pretty) (lambda () (list whoami x y))] + [(eq? msg 'move) (lambda (dx dy) + (send self 'add (new-instance point dx dy)))] + [(eq? msg 'type-of) (lambda () whoami)] + [(eq? msg 'class-of) (lambda () point)] + [(eq? msg 'with-color) (lambda (color) + (new-instance color-point + (send self 'getx) + (send self 'gety) + color))] + [else (super self msg)])) + )) -(define (point self x y) - (letrec ([whoami 'point] - [dispatch - (lambda (msg) - (let* ([self (or self dispatch)] - [super (object self)]) - (cond [(eq? msg 'getx) (lambda () x)] - [(eq? msg 'gety) (lambda () y)] - [(eq? msg 'add) (lambda (other) - (new-instance (send self 'class-of) - (+ x (send other 'getx)) - (+ y (send other 'gety)) - ))] - [(eq? msg 'pretty) (lambda () (list whoami x y))] - [(eq? msg 'move) (lambda (dx dy) - (send self 'add (new-instance point dx dy)))] - [(eq? msg 'type-of) (lambda () whoami)] - [(eq? msg 'class-of) (lambda () point)] - [(eq? msg 'with-color) (lambda (color) - (new-instance color-point - (send self 'getx) - (send self 'gety) - color))] - [else (super msg)])))] - ) dispatch)) (define p1 (new-instance point 10 20)) (define p2 (new-instance point 1 1)) -(define (color-point self x y . color) - (let ((color (if (null? color) 'green (car color)))) - (letrec ([whoami 'color-point] - [dispatch - (lambda (msg) - (let* ([self (or self dispatch)] - [super (point self x y)]) - (cond [(eq? msg 'get-color) (lambda () color)] - [(eq? msg 'type-of) (lambda () whoami)] - [(eq? msg 'pretty) (lambda () - (list whoami - (send self 'getx) - (send self 'gety) - (send self 'get-color)))] - [(eq? msg 'class-of) (lambda () color-point)] - [else (super msg)])))] - ) dispatch))) +(define (color-point x y . color) + (let ([color (if (null? color) 'green (car color))] + [whoami 'color-point] + [super (point x y)]) + (lambda (self msg) + (cond [(eq? msg 'get-color) (lambda () color)] + [(eq? msg 'type-of) (lambda () whoami)] + [(eq? msg 'pretty) (lambda () + (list whoami + (send self 'getx) + (send self 'gety) + (send self 'get-color)))] + [(eq? msg 'class-of) (lambda () color-point)] + [else (super self msg)])) + )) ;;# Exercise 3.7 ;;? What is the value of the expression |