CS 227 lecture -*- Outline -*-

* boxes, counters, accumulators, and gauges (12.2)

	first want to look at several types of objects that are box-like
		these can all be changed,
		like variables,
		but with more functionality

** boxes

*** spec
------------------
  BASIC OPERATIONS ON BOXES

VALUE: a (box T) value has 2 parts:
 - contents (of type T)
 - init-value (of type T)
------------------
	this is the abstract model,
		tells what a box value looks like
		and gives vocabulary
		
------------------
box-maker: (-> (T) (box T))
  ; ENSURES: result has 1st arg as its
  ; contents and init-value 
------------------
	the ENSURES comment should really say that result is a *new* box...
	this is the constructor
		conventionally these will be called -maker
	since don't have names for the arguments, use 1st arg by convention

------------------
type: (-> ((box T)) string)
  ; ENSURES: result is "box"
show:  (-> ((box T)) T)
  ; ENSURES: result is contents
reset!: (-> ((box T)) void)
  ; MODIFIES: 1st arg
  ; EFFECT: make contents be init-value
update!: (-> ((box T) T) void)
  ; MODIFIES: 1st arg
  ; EFFECT: makes contents be the 2nd arg
swap!: (-> ((box T) T) T)
  ; MODIFIES: 1st arg
  ; EFFECT: makes contents be the 2nd arg
  ; and returns the old value of contents
------------------
	Note that the descriptions are abbreviated.
		for example, show should say that result is 1st arg's contents
		but this is so common...
	"show" is not a good name: value would be better (it doesn't print)

	play with these

	note that swap! returns the old value
		reset returns it to the original value

*** impl
--------------------
; - Program 12.2, pg. 388 -
(define box-maker
  ; TYPE: (-> (T) (box T))
  (lambda (init-value)
    (let ((contents init-value))
      (lambda msg
        (case (1st msg)
          ((type) "box")
          ((show) contents)
          ((update!)
	   (for-effect-only
	     (set! contents (2nd msg))))
          ((swap!)
	   (let ((ans contents)) 
	     (set! contents (2nd msg)) 
	     ans))
          ((reset!)
	   (for-effect-only
	     (set! contents init-value)))
          (else
	    (delegate base-object msg)))))
    ))
--------------------

** primitives
--------------------
   HELPING PROCEDURES

(define 1st car)
(define 2nd cadr)
(define 3rd caddr)
(define 4th cadddr)

; - Program 12.1, pg. 386 -
(define for-effect-only
  ; TYPE: (-> (datum) void)
  (lambda (item-ignored)
    "unspecified value"))

; - Program 12.3, pg. 388 -
(define delegate
  ; TYPE: (-> (T message) S)
  (lambda (obj msg)
    (apply obj msg)))
--------------------
	for-effect-only is to make void procedures
		don't want to unintentionally give back some value
		in chez-scheme, could use (void) instead of "unspecified value"
		but that's not portable.
	delegation is "passing the buck"

--------------------
   THE BASE OBJECT

;VALUE: none
-------------------
	it also has no constructors, there is only one of it,
		okay, since its state cannot change (immutable)
-------------------
; type: (-> (T) string)
  ; ENSURES: result is type of 1st arg

; - Program 12.4, pg. 389 -
(define base-object
  (lambda msg
    (case (1st msg)
      ((type) "base-object")
      (else invalid-method-name-indicator)
	)))

(define invalid-method-name-indicator
  "unknown")
--------------------
	Note that the base object is an object, not an object-maker (class)
		it has no interesting methods
		just something to handle errors of unknown methods.

	Because of the way objects are implemented,
		could write (obj 'msg arg1 arg2)
		instead of (send obj 'msg arg1 arg2)
	but want to hide this detail as well as have more descriptive syntax
		and error handling automation
--------------------
   SEND

; - Program 12.5, pg. 389 -
(define send
  ; TYPE: (-> (S datum ...) T)
  (lambda args
    (let ((object (car args))
	  (message (cdr args)))
      ; REQUIRES: object is an object;
      ; that is, object is a procedure
      ; that can be called with messages
      (let ((try (apply object message)))
        (if (eq?
	     invalid-method-name-indicator
	     try)
            (error 
              (string-append
		(symbol->string
		  (car message))
		": Bad method name sent "
		"to object of " 
		(object 'type)
		" type."))
            try)))))
--------------------
	Note that send isn't used to find out the object's type.

** pictures
	draw or show pictures of what instance of box looks like
--------------------
  WHAT A BOX OBJECT LOOKS LIKE

Env0:
 box-maker ~~>
  [proc|(init-value)|(let ...)|Env0]

 (define box-a (box-maker 7))

Env1 (parent Env0):
 init-value ~~> [7]

 (let ((contents init-value))
   (lambda msg
     ...))

Env2 (parent Env1):
 contents ~~> [7]
 
 (lambda msg
   (case ...))

  [proc|msg|(case ...)|Env2]

Env0:
 box-maker ~~>
  [proc|(init-value)|(let ...)|Env0]
 box-a ~~>
--------------------
	Draw arrow from box-a to its object at the end
	Draw an arrow from box-a's Env2 to Env2

------------------
  THE BOX IN ACTION

 Env1 (parent Env0):
  init-value ~~> [7]

 Env2 (parent Env1):
  contents ~~> [7]
 
Env0:
 1st ~~> [system procedure car]
 send ~~> [proc|args|(let ...)|Env0]
 base-object ~~> [proc|msg|(case...)|Env0]
 box-maker ~~>
  [proc|(init-value)|(let ...)|Env0]
 box-a ~~> [proc|msg|(case ...)|Env2]

(send box-a 'update! 3)

Env6 (parent Env2):
 msg ~~> (update! 3)

(case (1st msg)
 ...
 ((update!) (for-effect-only
	      (set! contents (2nd msg))))
 ...)
------------------
	Draw an arrow from box-a's Env2 to Env2
	This omits the details of send (which create envs 3-5)

** counters

	Now will start to build other types of objects that are like boxes
	
	Since they are like boxes, we don't want to write the same code again
		so whenever have something a box could do, use a box for it
			and pass the buck (delegate) when possible

	Remark: delegation is somewhat like inheritance...

*** spec
------------------
  BASIC OPERATIONS ON COUNTERS

VALUE: a counter of T value has 3 parts:
 - unary-proc (of type (-> (T) T))
 - contents (of type T)
 - init-value (of type T)

counter-maker: (-> (T (-> (T) T))
                   (counter T))
  ; ENSURES: result has 2nd arg as its
  ; unary-proc, and 1st arg as its
  ; contents and init-value

type: (-> ((counter T)) string)
  ; ENSURES: result is "counter"
show: (-> ((counter T)) T)
  ; ENSURES: result is contents
reset!: (-> ((counter T)) void)
  ; MODIFIES: 1st arg
  ; EFFECT: make contents be init-value
update!: (-> ((counter T)) void)
  ; MODIFIES: 1st arg
  ; EFFECT: makes contents be the result
  ; of applying unary-proc to old contents
------------------
	Note that, vs. box, this has no swap! and update! is different
	play with these

*** impl
------------------
	COUNTER-MAKER
    SWAP! METHOD DISABLED

; - Program 12.7, pg. 391 -
(define counter-maker
  ; TYPE: (-> (T (-> (T) T)) (counter T))
  (lambda (init-value unary-proc)
    (let ((total (box-maker init-value)))
      (lambda msg
        (case (1st msg)
          ((type) "counter")
          ((update!)
	   (let ((result
		   (unary-proc
		     (send total 'show))))
	     (send total 'update! result))
	   )
          ((swap!)
	   (delegate base-object msg))
          (else
	    (delegate total msg)))))))
------------------
	Note how it
		makes a box (total) to keep the contents and init-value
		disables the swap! method, so it is not delegated to total
		note redefinition of update!, since changed spec

	motto: don't edit, customize and delegate

--------------------
	  COUNTER-MAKER
  SHOW and RESET METHODS DISABLED

; - Program 12.8, pg. 392 -
(define counter-maker
  ; TYPE: (-> (T (-> (T) T)) (counter T))
  (lambda (init-value unary-proc)
    (let ((total (box-maker init-value)))
      (lambda msg
        (case (1st msg)
          ((type) "counter")
          ((update!)
	   (send total 'update! 
	     (unary-proc
	       (send total 'show))))
          ((show reset!)
	   (delegate total msg))
          (else
	    (delegate base-object msg)))))
    ))
--------------------
	compare this with the previous version
		this doesn't use a let in update! (for no particular reason)
		this delegates specific messages (show and reset!)

** accumulators

*** spec
------------------
  BASIC OPERATIONS ON ACCUMULATORS

VALUE: an accum of T value has 3 parts:
 - binary-proc (of type (-> (T) T))
 - contents (of type T)
 - init-value (of type T)

accumulator-maker: (-> (T (-> (T T) T))
                       (accum T))
  ; ENSURES: result has 2nd arg as its
  ; unary-proc, and 1st arg as its
  ; contents and init-value

type: (-> ((accum T)) string)
  ; ENSURES: result is "accumulator"
show: (-> ((accum T)) T)
  ; ENSURES: result is contents
reset!: (-> ((accum T)) void)
  ; MODIFIES: 1st arg
  ; EFFECT: make contents be init-value
update!: (-> ((accum T) T) void)
  ; MODIFIES: 1st arg
  ; EFFECT: makes contents be the result
  ; of applying binary-proc to
  ; old contents and the 2nd arg
------------------
	play with the update message

*** impl
-------------------
  FILL IN THE IMPLEMENTATION

(define accumulator-maker
  (lambda (init-value binary-proc)
    (let ((total _______________________))
      (lambda ____________
        (case ____________
          ((type) _____________)
          ((update!) 
           _____________________________
           ______________________________)
          ((swap!) ______________________)
          (else ____________________))))))
---------------------
	see program 12.9

	How would this be done to enable legal names and disable others?

** gauges

*** spec
	a gauge moves up or down
------------------
  BASIC OPERATIONS ON GAUGES

VALUE: a gauge of T value has 4 parts:
 - unary-up (of type (-> (T) T))
 - unary-down (of type (-> (T) T))
 - contents (of type T)
 - init-value (of type T)

gauge-maker: (-> (T (-> (T) T) (-> (T) T))
                 (gauge  T))
  ; ENSURES: result has 2nd arg as its
  ; unary-up, 3rd arg as unary-down
  ; and 1st arg as contents and init-value

type: (-> ((gauge T)) string)
  ; ENSURES: result is "gauge"
show: (-> ((gauge T)) T)
  ; ENSURES: result is contents
reset!: (-> ((gauge T)) void)
  ; MODIFIES: 1st arg
  ; EFFECT: make contents be init-value
up!: (-> ((gauge T)) void)
  ; MODIFIES: 1st arg
  ; EFFECT: makes contents be the result
  ; of applying unary-up to old contents
down!: (-> ((gauge T)) void)
  ; MODIFIES: 1st arg
  ; EFFECT: makes contents be the result
  ; of applying unary-down to old contents
--------------------

	play with this and up!, down!
		(define g (gauge-maker 0 add1 sub1))
		(send g up!)
***
-------------------
  FILL IN THE IMPLEMENTATION

(define gauge-maker
  (lambda (init-value unary-up unary-down)
    (let ((total ______________________))
      (lambda ____________
        (case ____________
          ((type) "gauge")
          ((up!)
           _____________________________
           ______________________________)
          ((down!)
           _____________________________
           ______________________________)
          ((swap! update!)
           _________________________)
          (else ____________________))))))
---------------------
	see program 12.10