(module ABP mzscheme
  (require (lib "struct.ss")
           (lib "list.ss")
           (only (lib "1.ss" "srfi") find))
  
  ;; I'm writing this code to do the tedium of Exercise 3.3.
  ;; and to hand-check my work.
  (define-struct state
    (name s.st s.msg1 s.msg2
          r.st r.expected r.ack
          ack-chan.forget ack-chan.output
          msg-chan.forget msg-chan.output1 msg-chan.output2)
    (make-inspector))
  
  
  ;; state->string: state -> string
  ;; To make debugging easier, here's a string formatter for states.
  (define (state->string a-state)
    (define (labeled-val->string label val)
      (cond [(equal? label 's.st)
             (if (= val 0) "sending" "sent")]
            [(equal? label 'r.st)
             (if (= val 0) "receiving" "received")]
            [else (format "~a" val)]))
    (apply format "~a~n~a ~a ~a sender  (st,msg1,msg2)~n~a ~a ~a receiver (st,expected,ack)~n~a ~a   ack-chan (forget,output)~n~a ~a ~a msg-chan (forget,output1,output2)~n"
           (rest (vector->list (struct->vector a-state)))))
  
  
  ;; All known states are here.  The only states that should be in here
  ;; are those generated by intern-state.
  (define -known-states (make-hash-table 'equal))
  (define (all-known-states)
    (hash-table-map -known-states (lambda (k v) v)))
  
  ;; intern-state: state -> state
  ;; Used to make sure states are unique modulo name.
  (define intern-state
    (let ([counter 1])
      (lambda (a-state)
        ;; state-sig: state -> number
        ;; A signature of a state captures the essential information about it.
        (define (state-sig a-state)
          (format "~a"
                  (string->number
                   (apply string-append
                          (map number->string
                               (rest (rest (vector->list 
                                            (struct->vector a-state))))))
                   2)))
        
        (let ([sig (state-sig a-state)])
          (hash-table-get
           -known-states
           sig
           (lambda ()
             (hash-table-put! -known-states sig
                              (copy-struct state a-state
                                           [state-name sig]))
             (set! counter (add1 counter))
             (hash-table-get -known-states sig)))))))
  

  
  ;; unique: (listof X) (X -> Y) -> (listof X)
  ;; Gets a unique list of elements in X, using sig-f to distinguish between unique elements.
  (define (unique collection sig-f)
    (define ht (make-hash-table 'equal))
    (for-each (lambda (x) (hash-table-put! ht (sig-f x) x)) collection)
    (hash-table-map ht (lambda (k v) v)))
  
  (define (unique-states states)
    (unique states state-name))
  
  
  ;; Here are our start states.
  (define start-states
    (let ([a-start-state     ;; Here's one: we duplicate it up to get the other three.
           (intern-state
            (make-state #f
                        0 0 0
                        0 0 1
                        0 1
                        0 0 1))])
      (map intern-state
           (list (copy-struct state a-start-state
                              [state-ack-chan.forget 0]
                              [state-msg-chan.forget 0])
                 (copy-struct state a-start-state
                              [state-ack-chan.forget 0]
                              [state-msg-chan.forget 1])
                 (copy-struct state a-start-state
                              [state-ack-chan.forget 1]
                              [state-msg-chan.forget 0])
                 (copy-struct state a-start-state
                              [state-ack-chan.forget 1]
                              [state-msg-chan.forget 1])))))
  
  (define (toggle n)
    (cond [(= n 0) 1]
          [else 0]))
  
  
  (define *SENDING* 0)
  (define *SENT* 1)
  (define *RECEIVING* 0)
  (define *RECEIVED* 1)
  
  
  (define (transitions-by-sender a-state)
    (let* ([next-st (if (and (= (state-s.msg2 a-state)
                                (state-ack-chan.output a-state))
                             (= (state-s.st a-state) *SENDING*))
                        *SENT*
                        *SENDING*)]
           [next-msg2 (if (= *SENT* (state-s.st a-state))
                          (toggle (state-s.msg2 a-state))
                          (state-s.msg2 a-state))])
      (list (copy-struct state a-state
                         [state-s.st next-st]
                         ;; msg1 stays constant as 0 according to the problem.
                         [state-s.msg2 next-msg2]))))
  
  (define (transitions-by-receiver a-state)
    (let ([next-st (if (and (= (state-r.expected a-state)
                               (state-msg-chan.output2 a-state))
                            (= *RECEIVING* (state-r.st a-state)))
                       *RECEIVED*
                       *RECEIVING*)]
          [next-ack (if (= *RECEIVED* (state-r.st a-state))
                        (state-msg-chan.output2 a-state)
                        (state-r.ack a-state))]
          [next-expected (if (= *RECEIVED* (state-r.st a-state))
                             (toggle (state-r.expected a-state))
                             (state-r.expected a-state))])
      (list (copy-struct state a-state
                         [state-r.st next-st]
                         [state-r.ack next-ack]
                         [state-r.expected next-expected]))))
  
  
  (define (transitions-by-ack-chan a-state allow-forget-changes?)
    (define new-state
      (cond [(= 0 (state-ack-chan.forget a-state))
             (copy-struct state a-state
                          [state-ack-chan.output (state-r.ack a-state)])]
            [else a-state]))
    (if allow-forget-changes?
        (list (copy-struct state new-state [state-ack-chan.forget 0])
              (copy-struct state new-state [state-ack-chan.forget 1]))
        (list new-state)))
  
  
  (define (transitions-by-msg-chan a-state allow-forget-changes?)
    (let* ([should-change? (= 0 (state-msg-chan.forget a-state))]
           [next-output1
            (if should-change?
                (state-s.msg1 a-state)
                (state-msg-chan.output1 a-state))]
           [next-output2
            (if should-change?
                (state-s.msg2 a-state)
                (state-msg-chan.output2 a-state))]
           [new-state
            (copy-struct state a-state
                         [state-msg-chan.forget 0]
                         [state-msg-chan.output1 next-output1]
                         [state-msg-chan.output2 next-output2])])
      (if allow-forget-changes?
          (list new-state
                (copy-struct state new-state [state-msg-chan.forget 1]))
          (list new-state))))
  
  
  ;; transitions: state -> (listof state)
  ;; Gives us all the transition states of a-state.
  (define (transitions a-state)
    ;; We break this down into four cases, since each module is marked by PROCESS
    ;; and can run independent of the others.  So we have:
    ;; 1. BY-SENDER
    ;; 2. BY-RECEIVER
    ;; 3. BY-ACK-CHAN
    ;; 4. BY-MSG-CHAN.
     (unique-states 
      (map intern-state
           (append (transitions-by-sender a-state)
                   (transitions-by-receiver a-state)
                   (transitions-by-ack-chan a-state #t)
                   (transitions-by-msg-chan a-state #t)))))
    
  (define (find-state name)
    (find (lambda (s)
            (equal? name (state-name s)))
          (all-known-states)))
  
  (define (interactive)
    (printf "known states: ~a~n" (map state-name (all-known-states)))

    (let ([cmd (begin (printf ">>> ")
                      (flush-output (current-output-port))
                      (read-line))])
      (cond
        [(or (eof-object? cmd) (equal? cmd "quit")) 'ok]
        [else
         (let ([new-state (find-state cmd)])
           (when new-state
             (printf "~a~n" (state->string (find-state cmd)))
             (let ([out-states (transitions (find-state cmd))])
               (printf "goes out to: ")
               (for-each (lambda (s) (printf "~a " (state-name s)))
                         out-states)
               (printf "~n~n")))
           (interactive))])))
  
  
  ;; prime-up-the-transition-system: -> void
  ;; Continuously fill out the graph until there
  ;; are no more states in all-known-states.
  ;; Inefficient, but simple to code.
  (define (prime-up-the-transition-system!)
    (let loop ([n (length (all-known-states))])
      (for-each transitions (all-known-states))
      (let ([new-n (length (all-known-states))])
        (unless (= n new-n)
          (loop new-n)))))
  
  (define (print-graphviz-file)
    (define (print-state&transitions a-state)
      (let ([neighbors (transitions a-state)])
        (for-each (lambda (n) 
                    (printf "~a -> ~a~n" 
                            (state-name a-state)
                            (state-name n)))
                  neighbors)))
    (prime-up-the-transition-system!)
    
    (printf "digraph \"\" {~n")
    (printf "page=\"8.5,11\"~n")
    (printf "size=\"7, 9\"~n")
    (for-each print-state&transitions (all-known-states))
    (printf "}~n"))
  
  )