(import (scheme base)
        (only (csc gensym)
          gensym)
        (only (csc ir2)
          *globals*
          make-apply
          make-branch
          make-closure
          make-constant
          make-fix
          make-label
          make-library-ref
          make-primitive
          make-variable)
        (only (csc loop)
          loop
          return)
        (only (csc match)
          match)
        (only (csc testing)
          assert-equal
          test)
        (csc codegen))


(define (test-var)
  (make-variable (gensym)))


(define (test-label)
  (make-label (gensym)))


(test codegen-apply
  (define p (test-var))
  (assert-equal
    '((label init)
      (peek (local 1) (local 0) (const 5))
      (mov (local 2) (local 1))
      (mov (local 1) (const 10))
      (jmp (local 2)))
    (ir2->ir3
      (make-fix '()
        (make-primitive 'peek (list *globals* (make-constant 5)) (list p)
          (make-apply p (list (make-constant 10))))))))


(test codegen-call-global
  (define p (test-var))
  (assert-equal
    '((label init)
      (peek (local 1) (local 0) (global cons (csc based)))
      (mov (local 3) (local 1))
      (mov (local 1) (const 5))
      (mov (local 2) (const ()))
      (jmp (local 3)))
    (ir2->ir3
      (make-fix '()
        (make-primitive 'peek (list *globals* (make-library-ref 'cons '(csc based))) (list p)
          (make-apply p (list (make-constant 5) (make-constant '()))))))))


(test codegen-call-known
  (define f (test-label))
  (define ret (test-var))
  (assert-equal
    '((label 0)
      (mov (local 2) (local 1))
      (jmp (local 2))
      (label init)
      (mov (local 1) (label 0))
      (jmp (label 0)))
    (ir2->ir3
      (make-fix
        (list (make-closure f (list ret)
                (make-apply ret (list ret))))
        (make-apply f (list f))))))


(test codegen-permute
  (define f (test-label))
  (define g (test-label))
  (define f1 (test-var))
  (define f2 (test-var))
  (define g1 (test-var))
  (define g2 (test-var))
  (define g3 (test-var))
  (assert-equal
    '((label 0)
      (mov (local 127) (local 1))
      (mov (local 1) (local 2))
      (mov (local 2) (local 127))
      (mov (local 3) (const 0))
      (jmp (label 1))
      (label 1)
      (mov (local 2) (local 1))
      (mov (local 1) (local 3))
      (jmp (label 0))
      (label init)
      (mov (local 1) (const 0))
      (mov (local 2) (const 1))
      (jmp (label 0)))
    (ir2->ir3
      (make-fix
        (list (make-closure f (list f1 f2)
                (make-apply g (list f2 f1 (make-constant 0))))
              (make-closure g (list g1 g2 g3)
                (make-apply f (list g3 g1))))
        (make-apply f (list (make-constant 0) (make-constant 1)))))))


(test codegen-branch
  (define p (test-var))
  (assert-equal
    '((label init)
      (peek (local 1) (local 0) (const 1))
      (jmpif (const #t) (label 0))
      (mov (local 2) (local 1))
      (mov (local 1) (const 10))
      (jmp (local 2))
      (label 0)
      (mov (local 2) (local 1))
      (mov (local 1) (const 5))
      (jmp (local 2)))
    (ir2->ir3
      (make-fix '()
        (make-primitive 'peek (list *globals* (make-constant 1)) (list p)
          (make-branch (make-constant #t)
            (make-apply p (list (make-constant 5)))
            (make-apply p (list (make-constant 10)))))))))