;;;; Mutation

(define x 1)
(set! x (cons x x))
(set! x (cons x x))
(set-cdr! (car x) x)
(set-car! (cddr x) (cadr x))
x

;;;; State

Implement a stack abstraction

;; create stack
(define (make-stack size)
  (list 'stack (make-vector size nil) 0)
(define (empty-stack? stack)
  (= (caddr stack) 0))
(define (full-stack? stack)
  (>= (caddr stack) (vector-length (cadr stack))))

;; adds x to top of stack
;; hint (vector-set! vector k obj) sets k'th element to obj
(define (push! x stack)
  <INSERT-A>)

;; removes and returns top element
(define (pop! stack)
  <INSERT-B>)

;; returns top element
(define (peek stack)
  <INSERT-C>)

;; Example Usage
(define s (make-stack))
(push 1 s)
(push 2 s)
(pop s)
;Value: 2
(pop s)
;Value: 1

;;;; OOP

Finish implementing variable object.  Should be able to set value, get
value, and undo last set.  Use the stack!

(define (make-var name)
  (let ((values (make-stack 10)))
    (lambda (message)
      (case message
	((GET) <INSERT-A>)
	((SET!) <INSERT-B>)
	((UNDO!) <INSERT-C>)
	(else (no-method))))))

;;;; State / OOP

(define make-glorp
  (let ((color 'black))
    (lambda (name)
      (let ((morphed #f))
	(lambda (msg)
	  (case msg
	    ((NAME)
	     (lambda (self) name))
	    ((COLOR)
	     (lambda (self) color))
	    ((MORPH)
	     (lambda (self newcolor)
	       (if (not morphed)
		   (begin
		     (set! color newcolor)
		     (set! morphed #t)
		     'morphed)
		   'already-morphed)))
	    (else (no-method))))))))


(define g (make-glorp "gloob"))
(define h (make-glorp "hoblat"))

What is the value of each of the following expressions, where each is
evaluated in order:

1. (ask g 'name)
2. (ask h 'name)
3. (ask g 'color)
4. (ask h 'color)
5. (ask g 'morph 'green)
6. (ask g 'color)
7. (ask h 'color)
8. (ask g 'morph 'blue)
9. (ask h 'morph 'blue)

;;;; Environment Model

Draw environment diagram after 8 but before 9.

;;;; Self Chasing

(define (make-one letter)
  (lambda (msg)
    (case msg
      ((LETTER) (lambda (self) letter))
      ((DO-IT) 
       (lambda (self)
	 (display "One Yay!")
	 (ask self 'LETTER)
	 'did-it))
      ((CHEER)
       (lambda (self)
	 (display "Gimme a ")
	 (display (ask self 'LETTER))
	 'cheered))
      (else (no-method)))))

(define (make-two letter)
  (let ((one-part (make-one 'T)))
    (lambda (msg)
      (case msg
	((LETTER) (lambda (self) letter))
	((CHEER)
	 (lambda (self)
	   (display "Going to cheer: ")
	   (delegate one-part self 'CHEER)
	   'really-cheered))
	((GO-WILD)
	 (lambda (self)
	   (display "Going wild: ")
	   (ask one-part 'CHEER)
	   'went-wild))
	(else (find-method msg one-part))))))

(define one (make-one 'A))
(define two (make-two 'B))
(ask one 'LETTER)
(ask one 'DO-IT)
(ask one 'CHEER)
(ask two 'CHEER)
(ask two 'GO-WILD)

;;; Weird Glorp Example

(define make-glorp
  (let ((color 'black))
    (lambda (name)
      (let ((morphed #f)
	    (parts (map 
		    (lambda (x)
		      (string-append name x))
		    (list "-pod" "-tete" "-flibble"))))
	(lambda (msg)
	  (case msg
	    ((NAME)
	     (lambda (self) name))
	    ((COLOR)
	     (lambda (self) color))
	    ((MORPH)
	     (lambda (self newcolor)
	       (if (not morphed)
		   (begin
		     (set! color newcolor)
		     (set! morphed #t)
		     'morphed)
		   'already-morphed)))
	    ((BUD)
	     (lambda (self)
	       (define (make-bud budname)
		 (let ((glowing #f))
		   (lambda (msg)
		     (case msg
		       ((BUDNAME)
			(lambda (self)
			  (if glowing
			      (string-append "glowing-" budname)
			      budname)))
		       ((GLOW)
			(lambda (self)
			  (set! glowing #t)
			  'glowing))
		       ((CHANGE-COLOR)
			(lambda (self newcolor)
			  (set! color newcolor)
			  'budmorphed))
		       (else (get-method msg self))))))
	       (make-bud (pick-random parts))))
	    (else (no-method))))))))

(define g1 (ask g 'bud))
(ask g1 'budname)
(ask g1 'name)
(define g2 (ask g1 'bud))
(ask g2 'budname)
(ask g1 'glow)
(ask g1 'budname)
(ask g2 'budname)
(ask g1 'change-color 'blue)
(ask g 'color)