* 3.3 modeling with mutable data
chapter 2 dealt with compound data and data abstraction. but what
about now when we have the power and desire to change compound
objects?

in addition to selectors and constructors, we now need /mutators/

we might want to do such a thing as
: (set-balance! acct new-value)

  - mutable data objects :: data objs with defined mutators

pair operations are the most essential, so we will begin with pair
mutators!

** 3.3.1 mutable list structure
the primitive mutators for lists:
  - set-car!
  - set-cdr!

cons builds new lists by creating pairs; set-*! modifies existing
pairs. 

we can implement cons:
#+BEGIN_SRC scheme
  (define (my-cons x y)
    (let ((new (get-new-pair)))
      (set-car! new x)
      (set-cdr! new y)
      new))
#+END_SRC

get-new-pair is memory management in a lisp implementation.

SHARING AND IDENTITY

we now run into the issue of sharing pairs between multiple data types

#+BEGIN_SRC scheme
  (define x (list 'a 'b))
  (define z1 (cons x x))

  (define z2 (cons (list 'a 'b) (list 'a 'b)))

  (define (make-wow! x)
    (set-car! (car x) 'wow)
    x)

  (make-wow! z1)
  (make-wow! z2)
#+END_SRC

MUTATION IS JUST ASSIGNMENT

assignment is all that's needed to account for the behavior of mutable
data. as soon as we admit set!, we raise all the issues of assignment
and mutable data in general.

** 3.3.2 representing queues

  - queue :: a sequence where items are inserted at one end (the rear)
             and deleted from the other (the front)

also called a fifo buffer

thinking in data abstraction, we can define the queue like this:
  - a constructor
    - (make-queue)
      - returns empty queue
  - two selectors
    - (empty-queue? q)
      - tests if queue is empty
    - (front-queue q)
      - returns obj at front, erroring if queue is empty
  - two mutators
    - (insert-queue! q item)
      - add item to end and return modified queue
    - (delete-queue! q)
      - remove item at front and return modified queue; error if empty
        before deletion

right now, the only way to know the end a list is by cdring down it,
giving us ϴ(n). we could keep a pointer to the end to get ϴ(1).

#+BEGIN_SRC scheme
  (define (front-ptr q) (car q))
  (define (rear-ptr q) (cdr q))
  (define (set-front-ptr! q item) (set-car! q item))
  (define (set-rear-ptr! q item) (set-cdr! q  item))

  (define (empty-queue? q) (null? (front-ptr q)))
  (define (make-queue) (cons '() '()))

  (define (front-queue q)
    (if (empty-queue? q)
	(error "FRONT called with empty queue" q)
	(car (front-ptr queue))))
  (define (insert-queue! q item)
    (let ((new-pair (cons item '())))
      (cond ((empty-queue? q)
	     (set-front-ptr! q new-pair)
	     (set-rear-ptr! q new-pair)
	     queue)
	    (else
	     (set-cdr! (rear-ptr q) new-pair)
	     (set-rear-ptr! q new-pair)
	     q))))
  (define (delete-queue! q)
    (cond ((empty-queue? q)
	   (error "DELETE! called with an empty queue" q))
	  (else
	   (set-front-ptr! q (cdr (front-ptr queue)))
	   q)))
#+END_SRC

** 3.3.3 representing tables

for one dimensional tables,
#+BEGIN_SRC scheme
  (define (lookup key table)
    (let ((record (assoc key (cdr table))))
      (if record
	  (cdr record)
	  false)))
  (define (assoc key records)
    (cond ((null? records) false)
	  ((equal? key (caar records)) (car records))
	  (else (assoc key (cdr records)))))
  (define (insert! key value table)
    (let ((record (assoc key (cdr table))))
      (if record
	  (set-cdr! record value)
	  (set-cdr! table
		    (cons (cons key value) (cdr table)))))
    'ok)
  (define (make-table)
    (list '*table*))
#+END_SRC

TWO DIMENSIONAL TABLES

#+BEGIN_SRC scheme
  (define (lookup key-1 key-2 table)
    (let ((subtable (assoc key-1 (cdr table))))
      (if subtable
	  (let ((record (assoc key-2 (cdr subtable))))
	    (if record
		(cdr record)
		false))
	  false)))
  (define (insert! key-1 key-2 value table)
    (let ((subtable (assoc key-1 (cdr table))))
      (if subtable
	  (let ((record (assoc key-2 (cdr subtable))))
	    (if record
		(set-cdr! record value)
		(set-cdr! subtable
			  (cons (cons key-2 value)
				(cdr subtable)))))
	  (set-cdr! table
		    (cons (list key-1
				(cons key-2 value))
			  (cdr table)))))
    'ok)
#+END_SRC

** 3.3.4 a simulator for digital circuits
"designing complex digital systems is an important engineering
activity" "digital systems are constructed by interconnecting 
simple elements" "networks of them can have complex behavior"

  - event-driven simulation :: actions ("events") trigger further
       events that happen at a later time

we are going to make a circuit simulator:
  - wires :: they carry /digital signals/
  - digital signals :: can be 1 or 0
  - function boxes :: connect wires carrying input to output wires

  - inverter :: function box that inverts its input
  - and-gate :: function box that outputs the logical and of two
                inputs
  - or-gate ::  function box that outputs the logical or of two inputs
  - half-adder :: consists of an or-gate, two and-gates, inverter;
                  takes two inputs A, B and has two outputs S, C. S is
                  1 when only one of A and B are 1. C becomes 1 when A
                  and B are both 1.

all of these functions involve a delay. this causes challenges.

#+BEGIN_SRC scheme
  (define a (make-wire))
  (define b (make-wire))
  (define c (make-wire))
  (define d (make-wire))
  (define e (make-wire))
  (define s (make-wire))

  (define (half-adder a b s c)
    (let ((d (make-wire)) (e (make-wire)))
      (or-gate a b d)
      (and-gate a b c)
      (inverter c e)
      (and-gate d e s)
      'ok))

  (define (full-adder a b c-in sum c-out)
    (let ((s (make-wire))
	  (c1 (make-wire))
	  (c2 (make-wire)))
      (half-adder b c-in s c1)
      (half-adder a s sum c2)
      (or-gate c1 c2 c-out)
      'ok))
#+END_SRC

PRIMITIVE FUNCTION BOXES

we use the following operations on wires:
: (get-signal wire) ;; gets signal on wire
: (set-signal! wire new-value) ;; sets signal on wire
: (add-action! wire no-arg-procedure) ;; asserts the procedure
: ;; should be run when the signal on the wire changes value
: (after-delay time-delay procedure) ;; executes procedure after
: ;; given delay

#+BEGIN_SRC scheme
  (define (inverter input output)
    (define (invert-input)
      (let ((new-value (logical-not (get-signal input))))
	(after-delay inverter-delay
		     (lambda ()
		       (set-signal! output new-value)))))
    (add-action! input invert-input)
    'ok)

  (define (logical-not s)
    (cond ((= s 0) 1)
	  ((= s 1) 0)
	  (else (error "invalid signal" s))))

  (define (and-gate a1 a2 output)
    (define (and-action-procedure)
      (let ((new-value
	     (logical-and (get-signal a1) (get-signal a2))))
	(after-delay and-gate-delay
		     (lambda ()
		       (set-signal! output new-value)))))
    (add-action! a1 and-action-procedure)
    (add-action! a2 and-action-procedure)
    'ok)

  ;; i wrote this one:
  (define (logical-and a b)
    (cond ((and (= a 1) (= b 1)) 1)
	  ((or (= a 0) (= b 0)) 0)
	  (else (error "invalid signal" a b))))
#+END_SRC

REPRESENTING WIRES

#+BEGIN_SRC scheme
  (define (make-wire)
    (let ((signal-value 0) (action-procedures '()))
      (define (set-my-signal! new-value)
	(if (not (= signal-value new-value))
	    (begin (set! signal-value new-value)
		   (call-each action-procedure))
	    'done))
      (define (accept-action-procedure! proc)
	(set! action-procedures (cons proc action-procedures))
	(proc))
      (define (dispatch m)
	(cond ((eq? m 'get-signal) signal-value)
	      ((eq? m 'set-signal) set-my-signal!)
	      ((eq? m 'add-action!) accept-action-procedure!)
	      (else (error "unknown operation -- WIRE" m))))
      dispatch))

  (define (call-each procedures)
    (if (null? procedures)
	'done
	(begin
	  ((car procedures))
	  (call-each (cdr procedures)))))

  ;; syntactic sugar:
  (define (get-signal wire)
    (wire 'get-signal))
  (define (set-signal! wire new-value)
    ((wire 'set-signal!) new-value))
  (define (add-action! wire action-procedure)
    ((wire 'add-action) action-procedure))
#+END_SRC

THE AGENDA

now, all we need is after-delay

we will maintain a data structure (agenda) that contains a schedule of
things to do

: (make-agenda)
: (empty-agenda? agenda)
: (first-agenda-item agenda)
: (remove-first-agenda-item! agenda)
: (add-to-agenda! time action agenda)
: (current-time agenda)

#+BEGIN_SRC scheme
  (define (after-delay delay action)
    (add-to-agenda! (+ delay (current-time the-agenda))
		    action
		    the-agenda))
  (define (propogate)
    (if (empty-agenda? the-agenda)
	'done
	(let ((first-item (first-agenda-item the-agenda)))
	  (first-item)
	  (remove-first-agenda-item! the-agenda)
	  (propogate))))
#+END_SRC

A SAMPLE SIMULATION

#+BEGIN_SRC scheme
  (define (probe wire)
    (add-action! wire
		 (lambda ()
		   (newline)
		   (display name)
		   (display " ")
		   (display (current-time the-agenda))
		   (display " New-value = ")
		   (display (get-signal wire)))))

  (define the-agenda (make-agenda))
  (define inverter-delay 2)
  (define and-gate-delay 3)
  (define or-gate-delay 5)

  (define input-1 (make-wire))
  (define input-2 (make-wire))
  (define sum (make-wire))
  (define carry (make-wire))

  (probe 'sum sum)
  (probe 'carry carry)

  (half-adder input-1 input-2 sum carry)
  (set-signal! input-1 1)

  (propogate)

  (set-signal! input-2 1)

  (propogate)
#+END_SRC

IMPLEMENTING THE AGENDA

#+BEGIN_SRC scheme
  (define (make-time-segment time queue)
    (cons time queue))
  (define (segment-time s) (car s))
  (define (segment-queue s) (cdr s))

  ;; queue ops come from §3.3.2

  (define (make-agenda) (list 0))
  (define (current-time agenda) (car agenda))
  (define (set-current-time! agenda time)
    (set-car! agenda time))
  (define (segments agenda) (cdr agenda))
  (define (set-segments! agenda segments)
    (set-cdr! agenda segments))
  (define (first-segment agenda) (car (segments agenda)))
  (define (rest-segments agenda) (cdr (segments agenda)))
  (define (empty-agenda? agenda)
    (null? (segments agenda)))

  (define (add-to-agenda! time action agenda)
    (define (bulongs-before? segments)
      (or (null? segments)
	  (< time (segment-time (car segments)))))
    (define (make-new-time-segment time action)
      (let ((q (make-queue)))
	(insert-queue! q action)
	(make-time-segment time q)))
    (define (add-to-segments! segments)
      (if (= (segment-time (car segments)) time)
	  (insert-queue! (segment-queue (car segments))
			 action)
	  (let ((rest (cdr segments)))
	    (if (belongs-before? rest)
		(set-cdr!
		 segments
		 (cons (make-new-time-segment time action)
		       (cdr segments)))
		(add-to-segments! rest)))))
    (let ((segments (segments agenda)))
      (if (belongs-before? segments)
	  (set-segments!
	   agenda
	   (cons (make-new-time-segment time action)
		 segments))
	  (add-to-segments! segments))))

  (define (remove-first-agenda-item! agenda)
    (let ((q (segment-queue (first-segment agenda))))
      (delete-queue! q)
      (if (empty-queue? q)
	  (set-segments! agenda (rest-segments agenda)))))
  (define (first-agenda-item agenda)
    (if (empty-agenda? agenda)
	(error "agenda is empty -- FIRST-AGENDA-ITEM")
	(let ((first-seg (first-segment agenda)))
	  (set-current-time! agenda (segment-time first-seg))
	  (front-queue (segment-queue first-seg)))))
#+END_SRC

** 3.3.5 propagation of constraints
THE CONSTRAINT SYSTEM

invented by: Sussman, Stallman, Steele

#+BEGIN_SRC scheme
  (define C (make-connector))
  (define F (make-connector))
  (celsius-farenheit-converter C F)

  (define (celsius-farenheit-converter c f)
    (let ((u (make-connector))
	  (v (make-connector))
	  (w (make-connector))
	  (x (make-connector))
	  (y (make-connector)))
      (multiplier c w u)
      (multiplier v x u)
      (adder v y f)
      (constant 9 w)
      (constant 5 x)
      (constant 32 y)
      'ok))

  ;; like §3.3.4:
  (probe "Celsius temp" C)
  (probe "Farenheit temp" F)

  (set-value! C 25 'user)
  (set-value! F 212 'user) ;; error

  (forget-value! C 'user)

  (set-value! F 212 'user) ;; works
#+END_SRC

... here we gooooooooo

#+BEGIN_SRC scheme
  (define (adder a1 a2 sum)
    (define (process-new-value)
      (cond ((and (has-value? a1) (has-value? a2))
	     (set-value! sum
			 (+ (get-value a1) (get-value a2))
			 me))
	    ((and (has-value? a1) (has-value? sum))
	     (set-value! a2
			 (- (get-value sum) (get-value a1))
			 me))
	    ((and (has-value? a2) (has-value? sum))
	     (set-value! a1
			 (- (get-value sum) (get-value a2))
			 me))))
    (define (process-forget-value)
      (forget-value! sum me)
      (forget-value! a1 me)
      (forget-value! a2 me)
      (process-new-value))
    (define (me request)
      (cond ((eq? request 'I-have-a-value)
	     (process-new-value))
	    ((eq? request 'I-lost-my-value)
	     (process-forget-value))
	    (else
	     (error "unknown request -- ADDER" request))))
    (connect a1 me)
    (connect a2 me)
    (connect sum me)
    me)
  (define (inform-about-value constraint)
    (constraint 'I-have-a-value))
  (define (inform-about-no-value constraint)
    (constraint 'I-lost-my-value))

  (define (multiplier m1 m2 product)
    (define (process-new-value)
      (cond ((and (has-value? m1) (has-value? m2))
	     (set-value! product
			 (* (get-value m1) (get-value m2))
			 me))
	    ((and (has-value? m1) (has-value? product))
	     (set-value! m2
			 (/ (get-value product) (get-value m1))
			 me))
	    ((and (has-value? m2) (has-value? product))
	     (set-value! m1
			 (/ (get-value product) (get-value m2))
			 me))))
    (define (process-forget-value)
      (forget-value! product me)
      (forget-value! m1 me)
      (forget-value! m2 me)
      (process-new-value))
    (define (me request)
      (cond ((eq? request 'I-have-a-value)
	     (process-new-value))
	    ((eq? request 'I-lost-my-value)
	     (process-forget-value))
	    (else
	     (error "unknown request -- MULTIPLIER" request))))
    (connect m1 me)
    (connect m2 me)
    (connect product me)
    me)

  (define (constant value connector)
    (define (me request)
      (error "Unknown request -- CONSTANT" request))
    (connect connector me)
    (set-value! connector value me)
    me)

  (define (probe name connector)
    (define (print-probe value)
      (newline)
      (display "Probe: ")
      (display name)
      (display " = ")
      (display value))
    (define (process-new-value)
      (print-probe (get-value connector)))
    (define (process-forget-value)
      (print-probe "?"))
    (define (me request)
      (cond ((eq? request 'I-have-a-value)
	     (process-new-value))
	    ((eq? request 'I-lost-my-value)
	     (process-forget value))
	    (else
	     (error "Unknown request -- PROBE" request))))
    (connect connector me)
    me)

  (define (make-connector)
    (let ((value false) (informant false) (constraints '()))
      (define (set-my-value newval setter)
	(cond ((not (has-value? me))
	       (set! value newval)
	       (set! informant setter)
	       (for-each-except setter
				inform-about-value
				constraints))
	      ((not (= value newval))
	       (error "Contradiction" (list value newval)))
	      (else 'ignored)))
      (define (forget-my-value retractor)
	(if (eq? retractor informant)
	    (begin (set! informant false)
		   (for-each-except retractor
				    inform-about-no-value
				    constraints))
	    'ignored))
      (define (connect new-constraint)
	(if (not (memq new-constraint constraints))
	    (set! constraints
		  (cons new-constraint constraints)))
	(if (has-value? me)
	    (inform-about-value new-constraint))
	'done)
      (define (me request)
	(cond ((eq? request 'has-value?)
	       (if informant true false))
	      ((eq? request 'value) value)
	      ((eq? request 'set-value!) set-my-value)
	      ((eq? request 'forget) forget-my-value)
	      ((eq? request 'connect) connect)
	      (else (error "Unknown operation -- CONNECTOR"
			   request))))
      me))

  (define (for-each-except exception procedure list)
    (define (loop items)
      (cond ((null? items) 'done)
	    ((eq? (car items) exception) (loop (cdr items)))
	    (else (procedure (car items))
		  (loop (cdr items)))))
    (loop list))

  (define (has-value? connector)
    (connector 'has-value?))
  (define (get-value connector)
    (connector 'value))
  (define (set-value! connector new-value informant)
    ((connector 'set-value!) new-value informant))
  (define (forget-value! connector retractor)
    ((connector 'forget) retractor))
  (define (connect connector new-constraint)
    ((connector 'connect) new-constraint))
#+END_SRC
