#lang racket (struct being ( name (age #:mutable) )) (define (being-show x) (display (being-name x)) (display " (") (display (being-age x)) (display ")")) (define (say-hello x) (if (being? x) (begin (being-show x) (display ": my regards.") (newline)) (error "not a being"))) (define andrea (being "andrea" 23)) (say-hello andrea) (set-being-age! andrea 24) (say-hello andrea) (struct may-being being ((alive? #:mutable)) ) (define (kill! x) (if (may-being? x) (set-may-being-alive?! x #f) (error "not a may-being"))) (define andrea-son (may-being "andrea-son" 23 #t)) (say-hello andrea-son) (may-being? andrea) (may-being? andrea-son) (being? andrea-son) (kill! andrea-son) (say-hello andrea-son) (define (try-to-say-hello x) (if (and (may-being? x) (not (may-being-alive? x))) (begin (display "I hear only silence") (newline)) (say-hello x))) (try-to-say-hello andrea) (try-to-say-hello andrea-son) (define (make-simple-object) (let ((my-var 0)) (define (init) (set! my-var 0) my-var) (define (my-add x) (set! my-var (+ my-var x)) my-var) (define (get-my-var) my-var) (define (my-display) (newline) (display "my Var is:") (display my-var) (newline)) (lambda (message . args) (apply (case message ((init) init) ((my-add) my-add) ((my-display) my-display) ((get-my-var) get-my-var) (else (error "Unknown method!"))) args)))) (define obj1 (make-simple-object)) (obj1 'init) (obj1 'my-add 3) (define (make-son) (let ((parent (make-simple-object)) (name "an object")) (define (init) (parent 'init)) (define (hello) "hi!") (define (my-display) (display "My name is ") (display name) (display " and") (parent 'my-display)) (lambda (message . args) (case message ((init) (apply init args)) ((my-display) (apply my-display args)) ((hello) (apply hello args)) (else (apply parent (cons message args))))))) (define obj2 (make-son)) (obj2 'init) (obj2 'my-display) (obj2 'hello) (define new-object make-hash) (define (clone object) (hash-copy object)) (define-syntax !! (syntax-rules () ((_ object msg new-val) (hash-set! object 'msg new-val)))) (define-syntax ?? (syntax-rules () ((_ object msg) (hash-ref object 'msg)))) (define-syntax -> (syntax-rules () ((_ object msg arg ...) ((hash-ref object 'msg) object arg ...)))) (define Pino (new-object)) (!! Pino name "Pino") (!! Pino hello (lambda (self x) (display (?? self name)) (display ": hi, ") (display (?? x name)) (display "!") (newline))) (!! Pino set-name (lambda (self x) (!! self name x))) (!! Pino set-name-&-age (λ (self n a) (!! self name n) (!! self age a))) (define Pina (clone Pino)) (!! Pina name "Pina") (-> Pino hello Pina) (-> Pino set-name "Ugo") (-> Pina set-name-&-age "Lucia" 25) (-> Pino hello Pina)