#lang racket (define (make-adder n) (lambda (x) (+ x n))) ((make-adder 10) 5) (define add10 (make-adder 10)) (add10 5) (define (vector-iter vect) (let ((cur 0) (top (vector-length vect))) (lambda () (if (= cur top) 'end (let ((value (vector-ref vect cur))) (set! cur (+ cur 1)) value))))) (define iter (vector-iter #(1 2 3 4))) (iter) (iter) (iter) (iter) (iter) (map (lambda (x) (+ x 1)) '(0 1 2 3 -1)) (foldl + 0 '(1 2 3 4 5)) (foldl cons '() '(1 2 3)) (foldr cons '() '(1 2 3)) (define (make-simple-object) (let ((var 0)) (define (init) (set! var 0) var) (define (my-add x) (set! var (+ var x)) var) (define (my-get) var) (define (my-display) (newline) (display "The value is: ") (display var) (newline)) (lambda (message . args) (apply (case message ((init) init) ((my-add) my-add) ((my-get) my-get) ((my-display) my-display) (else (error "method not defined"))) args)))) (define obj1 (make-simple-object)) (obj1 'init) (obj1 'my-add 3) (obj1 'my-display) (obj1 'my-get) (define (make-son) (let ((parent (make-simple-object)) (name "an object")) (define (init) (parent 'init)) (define (say-hello) (newline) (display "hi, my name is: ") (display name) (newline) (display "and") (parent 'my-display)) (lambda (message . args) (case message ((init) (apply init args)) ((say-hello) (apply say-hello args)) (else (apply parent (cons message args))))))) (define obj2 (make-son)) (obj2 'init) (obj2 'say-hello) (obj2 'my-add 5) (obj2 'my-display) (obj2 'say-hello) (define new-object make-hash) (define (clone object) (hash-copy object)) (define (dispatch object msg) (if (eq? object 'unknown) (error "unknown message" msg) (let ((slot (hash-ref object msg 'unknown))) (if (eq? slot 'unknown) (dispatch (hash-ref object '<> 'unknown) msg) slot)))) (define-syntax !! (syntax-rules () ((_ object msg new-val) (hash-set! object 'msg new-val)))) (define-syntax ?? (syntax-rules () ((_ object msg) (dispatch object 'msg)))) (define-syntax -> (syntax-rules () ((_ object msg arg ...) ((dispatch object 'msg) object arg ...)))) (define Pino (new-object)) (!! Pino name "Pino") (!! Pino hello (lambda (self x) (display (?? self name)) (display " hi: ") (display (?? x name)) (newline))) (define Pina (clone Pino)) (!! Pina name "Pina") (-> Pina hello Pino) (!! Pino set-name (lambda (self x) (!! self name x))) (!! Pino set-name-&-age (lambda (self n a) (!! self name n) (!! self age a))) (-> Pino hello Pina) (-> Pino set-name "Ugo") (define Pina2 (clone Pino)) (-> Pina2 set-name-&-age "Lucia" 25) (-> Pina2 hello Pino) (?? Pina2 age) (define (son-of parent) (let ((o (new-object))) (!! o <> parent) o)) (define Glenn (son-of Pino)) (!! Glenn name "Glenn") (!! Glenn age 50) (-> Glenn hello Pina) (?? Glenn age)