plp/scheme/scheme3.rkt

#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 '<<parent>> '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>> parent)
    o))

(define Glenn (son-of Pino))
(!! Glenn name "Glenn")
(!! Glenn age 50)

(-> Glenn hello Pina)
(?? Glenn age)