(define-library (csc codegen-test)
  (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))
  (begin


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


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


    (test codegen-apply
      (define p (test-var))
      (assert-equal
        '((peek (local 1) (local 0) (const 5))
          (mov (local 2) (local 1))
          (mov (local 1) (const 10))
          (jmp (local 2))
          (label 0))
        (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
        '((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))
          (label 0))
        (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
        '((mov (local 1) (label 1))
          (jmp (label 1))
          (label 1)
          (mov (local 2) (local 1))
          (jmp (local 2))
          (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
        '((mov (local 1) (const 0))
          (mov (local 2) (const 1))
          (jmp (label 1))
          (label 1)
          (mov (local 255) (local 1))
          (mov (local 1) (local 2))
          (mov (local 2) (local 255))
          (mov (local 3) (const 0))
          (jmp (label 2))
          (label 2)
          (mov (local 2) (local 1))
          (mov (local 1) (local 3))
          (jmp (label 1))
          (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
        '((peek (local 1) (local 0) (const 1))
          (jmpif (const #t) (label 1))
          (mov (local 2) (local 1))
          (mov (local 1) (const 10))
          (jmp (local 2))
          (label 1)
          (mov (local 2) (local 1))
          (mov (local 1) (const 5))
          (jmp (local 2))
          (label 0))
        (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)))))))))))