(module rpn mzscheme
  ;; Defines a rough-and-dirty simulation of a very simple
  ;; RPN calculator.  This is meant to be a toy.
  
  (require (lib "plt-match.ss")
           (lib "struct.ss")
           (lib "list.ss")
           (lib "etc.ss"))
  
  (provide (all-defined))
  
  ;; A calculator is a (make-calc s x l) 
  ;; where s is a (listof number), x is a number, and
  ;; l is a symbol.
  (define-struct calc (stack x-reg last-cmd) (make-inspector))
  
  ;; new-calc: -> calc
  ;; Returns a fresh calculator state.
  (define (new-calc)
    (make-calc empty 0 'Reset))
  
  ;; A command is one of the following
  ;; (list 0 1 2 3 4 5 6 7 8 9 '+ '* 'Enter 'Reset)
  
  ;; binops: (listof (cons symbol (cons (number number -> number) empty)))
  (define binops (list (list '+ +)
                       (list '* *)))
  
  ;; binop-cmd?: command -> boolean
  ;; Returns true if the command looks like a binary operator
  (define (binop-cmd? cmd)
    (and (assoc cmd binops) #t))
  
  ;; binop-cmd->binop: command -> (number number -> number)
  ;; Looks up the function associated to the cmd.
  (define (binop-cmd->binop cmd)
    (second (assoc cmd binops)))
  
  
  ;; eval-command: calc command -> calc
  ;; Evaluates the given command, and returns the new state
  ;; of the calculator.
  (define (eval-command a-calc a-cmd)
    (match (list a-calc a-cmd)
      [(list _ 'Reset)
       (new-calc)]
      [(list (struct calc (stack x-reg _)) 'Enter)
       (copy-struct calc a-calc
                    [calc-stack (cons x-reg stack)]
                    [calc-last-cmd 'Enter])]
      [(list (struct calc (stack x-reg last-cmd)) cmd)
       (=> continue-matching)
       (cond
         [(binop-cmd? cmd) (eval-binop-command a-calc cmd)]
         [(number? cmd) (eval-digit-command a-calc cmd)]
         [else (continue-matching)])]
      [else (error 'eval-command "Don't know how to evaluate ~a" a-cmd)]))
  
  
  ;; eval-binop-command: calc binop-cmd -> calc
  ;; Applies the binary operator binop-cmd on the calc a-calc.
  (define (eval-binop-command a-calc binop-cmd)
    (define (dispatch binop-cmd x y)
      ((binop-cmd->binop binop-cmd) x y))
    
    (match a-calc
      [(struct calc ((list) x-reg last-cmd))
       ;; delegate by restarting, but with a 0 on the stack.
       (eval-binop-command 
        (copy-struct calc a-calc [calc-stack (list 0)]) binop-cmd)]
      [(struct calc ((list head rest ...) x-reg last-cmd))
       (copy-struct calc a-calc 
                    [calc-stack rest]
                    [calc-x-reg (dispatch binop-cmd head x-reg)]
                    [calc-last-cmd binop-cmd])]))
  
  
  ;; eval-digit-command: calc number-between-0-and-9 -> calc
  ;; Enters a new digit into our calculator.
  (define (eval-digit-command a-calc digit)
    (match a-calc
      [(struct calc (stack x-reg last-cmd))
       (cond [(number? last-cmd)
              (copy-struct calc a-calc
                           [calc-x-reg (+ (* x-reg 10) digit)]
                           [calc-last-cmd digit])]
             [(binop-cmd? last-cmd)
              (copy-struct calc a-calc
                           [calc-stack (cons x-reg stack)]
                           [calc-x-reg digit]
                           [calc-last-cmd digit])]
             [else
              (copy-struct calc a-calc
                           [calc-x-reg digit]
                           [calc-last-cmd digit])])]))
  
  
  ;; run: (listof command) -> calc
  ;; eval-command's evey command in cmds, and returns the
  ;; last calculator state.
  (define (run cmds)
    (foldl (lambda (cmd calc) (eval-command calc cmd)) (new-calc) cmds)))