(define default-action
  (lambda ()
    (begin
      (for-each
	(lambda (e) (printf "~a ~n" (entry-description e)))
	the-command-list)
      (printf "number - set current cell to value and move to next cell~n"))))

[define print-cell
  (lambda (addr)
    (let* (; [addr (get-pc)]
	   [val (get-mem addr)])
      (printf "[~a]: ~a ~s"
	      (format-address addr 5 #\0)
	      (format-value val 8 #\0)
	      (disassemble val))))]

(define print-regs
  (lambda ()
    (let ((reg (box 0)))
      (printf "PC:~s" (get-pc))
      (for-each (lambda (val)
		  (printf " R~s:~s" (unbox reg) val)
		  (set-box! reg (add1 (unbox reg))))
		(vector->list reg-array))
      (printf "~n"))))

(define the-command-list
  (list 
   (list 'q "q - quit" 
	 (lambda () (abort (printf "done walking - must rest.~n"))))
   (list 'r "r - reset"
	 (lambda () (when (eq? (prompt-read "reset? [yn] ") 'y) (reset!))))
   (list 'x "x - execute" 
	 (lambda ()
	   (when (eq? (prompt-read "execute? [yn] ") 'y)
	     (begin
	       (printf "executing ... ~n")
	       (run)
	       (printf "~n... done. ~n")))))
   (list 'n "n - next (step)" step)
   (list 'm "m - show memory" 
	 (lambda ()
	   (local ((define low (prompt-read "start: "))
		   (define high (prompt-read "end: ")))
	     (when (and (address? low) (address? high) (<= low high))
	       (let S ((low low))
		 (print-cell low) (newline)
		 (if (= low high) (void) (S (add1 low))))))))
   (list 's "s - show state" print-regs)
   (list 'p "p - set pc"
	 (lambda ()
	   (local ((define new-pc (prompt-read "  new pc: ")))
	     (when (address? new-pc) (set-pc! new-pc)))))
   (list '+ "+ - forward" 
	 (lambda () 
	   (local ((define new-pc (add1 (get-pc))))
	     (when (address? new-pc) (set-pc! new-pc)))))
   (list '- "- - backward" 
	 (lambda () 
	   (local ((define new-pc (sub1 (get-pc))))
	     (when (address? new-pc) (set-pc! new-pc)))))
   ))