(load "reg_machine_sim.scm")
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2 9)))
(require (planet "util.ss" ("schematics" "schemeunit.plt" 2 9)))

; text UI of SchemeUnit
(require (planet "text-ui.ss" ("schematics" "schemeunit.plt" 2)))

(define test-tests (test-suite "test"
  (test-equal? "Simple" 1 1)

  (test-case
   "List has length 4 and all elements even"
   (let ((lst (list 2 6 4 8)))
     (check = (length lst) 4)
     (for-each
       (lambda (elt)
         (check-pred even? elt))
       lst)))
  
  (test-suite
    "blah"
    (test-equal? "zz" "z" "z"))
))


(define test-reg-machine (test-suite "Register machine"
  
  (test-case
    "Trivial machine"
    (let ((sm (make-machine
                '(a b c d)
                `((+ ,+) (* ,*))
                '(
                  (assign c (op *) (reg a) (reg b))
                  (assign d (op +) (reg c) (reg b))
                ))))
      (set-register-contents! sm 'a 15)
      (set-register-contents! sm 'b 21)
      (start sm)
      (check-equal? (get-register-contents sm 'c) 315)
      (check-equal? (get-register-contents sm 'd) 336)
      ))

  (test-case
    "Adding a and b with iterative incrementation"
    (let ((sm (make-machine
                '(a b)
                `((= ,=) (+ ,+) (- ,-))
                '(
                  loop
                    (test (op =) (reg a) (const 0))
                    (branch (label done))
                    (assign b (op +) (reg b) (const 1))
                    (assign a (op -) (reg a) (const 1))
                    (goto (label loop))
                  done
                ))))
      (set-register-contents! sm 'a 10)
      (set-register-contents! sm 'b 27)
      (start sm)
      (check-equal? (get-register-contents sm 'a) 0)
      (check-equal? (get-register-contents sm 'b) 37)
      ))
      
  (test-case
    "gcd"
    (let ((sm (make-machine
                '(a b t)
                (list (list 'rem remainder) (list '= =))
                '(test-b
                   (test (op =) (reg b) (const 0))
                   (branch (label gcd-done))
                   (assign t (op rem) (reg a) (reg b))
                   (assign a (reg b))
                   (assign b (reg t))
                   (goto (label test-b))
                 gcd-done))))
      (set-register-contents! sm 'a 42)
      (set-register-contents! sm 'b 77)
      (start sm)
      (check-equal? (get-register-contents sm 'a) 7)
      ))
  
  (test-case
    "recursive factorial"
    (let ((fact (make-machine
                '(n val continue)
                `((= ,=) (+ ,+) (- ,-) (* ,*))
                '(
                     (assign continue (label fact-done))     ; set up final return address
                   fact-loop
                     (test (op =) (reg n) (const 1))
                     (branch (label base-case))
                     ;; Set up for the recursive call by saving n and continue.
                     ;; Set up continue so that the computation will continue
                     ;; at after-fact when the subroutine returns.
                     (save continue)
                     (save n)
                     (assign n (op -) (reg n) (const 1))
                     (assign continue (label after-fact))
                     (goto (label fact-loop))
                   after-fact
                     (restore n)
                     (restore continue)
                     (assign val (op *) (reg n) (reg val))   ; val now contains n(n - 1)!
                     (goto (reg continue))                   ; return to caller
                   base-case
                     (assign val (const 1))                  ; base case: 1! = 1
                     (goto (reg continue))                   ; return to caller
                   fact-done
                  ))))
      (set-register-contents! fact 'n 6)
      (set-register-contents! fact 'val 0)
      (start fact)
      (check-equal? (get-register-contents fact 'val) 720)
      ))
  
  (test-case
    "recursive fibonacci"
    (let ((fib (make-machine
                '(n val continue)
                `((= ,=) (+ ,+) (- ,-) (* ,*) (< ,<))
                '(
                  (assign continue (label fib-done))
                   fib-loop
                     (test (op <) (reg n) (const 2))
                     (branch (label immediate-answer))
                     ;; set up to compute Fib(n - 1)
                     (save continue)
                     (assign continue (label afterfib-n-1))
                     (save n)                           ; save old value of n
                     (assign n (op -) (reg n) (const 1)); clobber n to n - 1
                     (goto (label fib-loop))            ; perform recursive call
                   afterfib-n-1                         ; upon return, val contains Fib(n - 1)
                     (restore n)
                     ;; set up to compute Fib(n - 2)
                     (assign n (op -) (reg n) (const 2))
                     (assign continue (label afterfib-n-2))
                     (save val)                         ; save Fib(n - 1)
                     (goto (label fib-loop))
                   afterfib-n-2                         ; upon return, val contains Fib(n - 2)
                     (assign n (reg val))               ; n now contains Fib(n - 2)
                     (restore val)                      ; val now contains Fib(n - 1)
                     (restore continue)
                     (assign val                        ;  Fib(n - 1) +  Fib(n - 2)
                             (op +) (reg val) (reg n)) 
                     (goto (reg continue))              ; return to caller, answer is in val
                   immediate-answer
                     (assign val (reg n))               ; base case:  Fib(n) = n
                     (goto (reg continue))
                   fib-done
                  ))))
      (set-register-contents! fib 'n 7)
      (start fib)
      (check-equal? (get-register-contents fib 'val) 13)
      ))
))


; (test/text-ui test-tests)
(test/text-ui test-reg-machine)