(import (scheme base)
        (only (csc gensym) gensym)
        (only (csc ir1)
          make-call
          make-constant
          make-define-syntax
          make-if
          make-lambda
          make-letrec
          make-lexical-ref
          make-lexical-set
          make-library-ref
          make-sequence)
        (only (csc ir2)
          ir2=?
          make-apply
          make-atom
          make-branch
          make-call-closure
          make-closure
          make-fix
          make-kargs
          make-klabel
          make-ktail
          make-primitive)
        (only (csc testing)
          assert-equal
          test)
        (csc cps))


(define (test-ref name)
  (make-lexical-ref name (gensym)))


(define (tail x)
  (make-apply (test-ref 'tail) (list x)))


(test atom-const
  (assert-equal ir2=?
    (make-apply (test-ref 'tail) (list (make-constant 5)))
    (ir1->ir2 (make-constant 5) tail)))


(test atom-lexical-ref
  (assert-equal ir2=?
    (make-apply (test-ref 'tail) (list (test-ref 'var)))
    (ir1->ir2 (test-ref 'var) tail)))


(test atom-library-ref
  (assert-equal ir2=?
    (make-primitive 'peek (list (make-library-ref 'var '(csc builtins)) (make-constant 0))
                          (list (test-ref 'generated-symbol))
      (make-apply (test-ref 'tail) (list (test-ref 'generated-symbol))))
    (ir1->ir2 (make-library-ref 'var '(csc builtins)) tail)))


(test lexical-set
  (assert-equal ir2=?
    (make-primitive 'poke (list (make-constant 5) (test-ref 'var) (make-constant 0)) '()
      (make-apply (test-ref 'tail) (list (make-constant #f))))
    (ir1->ir2 (make-lexical-set (test-ref 'var) (make-constant 5))
              tail)))


(test no-op-define-syntax
  (assert-equal ir2=?
    (make-apply (test-ref 'tail) (list (make-constant #f)))
    (ir1->ir2 (make-define-syntax 'name '(transformer))
              tail)))


(test branch
  (assert-equal ir2=?
    (make-fix
      (list
        (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)) #f
          (make-apply (test-ref 'tail) (list (test-ref 'generated-symbol)))))
      (make-branch (make-constant #t)
        (make-apply (test-ref 'generated-symbol) (list (make-constant 1)))
        (make-apply (test-ref 'generated-symbol) (list (make-constant 2)))))
    (ir1->ir2 (make-if (make-constant #t)
                (make-constant 1)
                (make-constant 2))
              tail)))


(test call-closure
  (assert-equal ir2=?
    (make-fix
      (list
        (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)) #f
          (make-apply (test-ref 'tail) (list (test-ref 'generated-symbol)))))
      (make-apply (test-ref 'f) (list (test-ref 'generated-symbol)
                                                 (make-constant 1)
                                                 (make-constant 2))))
    (ir1->ir2 (make-call (test-ref 'f) (list (make-constant 1) (make-constant 2)))
              tail)))


(test sequence
  (assert-equal ir2=?
    (make-primitive 'poke (list (make-constant 5) (test-ref 'a) (make-constant 0)) '()
      (make-primitive 'poke (list (make-constant 6) (test-ref 'b) (make-constant 0)) '()
        (make-apply (test-ref 'tail) (list (make-constant #f)))))
    (ir1->ir2 (make-sequence (make-lexical-set (test-ref 'a) (make-constant 5))
                             (make-lexical-set (test-ref 'b) (make-constant 6)))
              tail)))


(test closure
  (assert-equal ir2=?
    (make-fix
      (list
        (make-closure (test-ref 'generated-symbol)
                      (list (test-ref 'generated-symbol)
                            (test-ref 'a)
                            (test-ref 'b))
                      (test-ref 'c)
          (make-apply (test-ref 'generated-symbol) (list (make-constant 5)))))
      (make-apply (test-ref 'tail) (list (test-ref 'generated-symbol))))
    (ir1->ir2 (make-lambda
                (list (test-ref 'a) (test-ref 'b))
                (test-ref 'c)
                (make-constant 5))
              tail)))


(test letrec-in-order
  (assert-equal ir2=?
    (make-fix
      (list
        (make-closure (test-ref 'f) (list (test-ref 'generated-symbol)
                                          (test-ref 'x)) #f
          (make-apply (test-ref 'generated-symbol) (list (make-constant 5)))))
      (make-fix
        (list
          (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)) #f
            (make-apply (test-ref 'tail) (list (test-ref 'generated-symbol)))))
        (make-fix
          (list
            (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)
                                                             (test-ref 'a)) #f
              (make-fix
                (list
                  (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)) #f
                    (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
                (make-fix
                  (list
                    (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)
                                                                     (test-ref 'b)) #f
                      (make-apply (test-ref 'generated-symbol) (list (make-constant 10)))))
                  (make-apply (test-ref 'generated-symbol)
                              (list (test-ref 'generated-symbol)
                                    (make-constant 2)))))))
          (make-apply (test-ref 'generated-symbol)
                      (list (test-ref 'generated-symbol)
                            (make-constant 1))))))
    (ir1->ir2 (make-letrec
                #t
                '(a f b)
                (list (gensym) (gensym) (gensym))
                (list (make-constant 1)
                      (make-lambda (list (test-ref 'x)) #f (make-constant 5))
                      (make-constant 2))
                (make-constant 10))
              tail)))


(test set-argument
  (make-fix
    (list
      (make-closure (test-ref 'f) (list (test-ref 'generated-symbol)
                                        (test-ref 'generated-symbol)) #f
        (make-primitive 'alloc (list (make-constant 1))
                               (list (test-ref 'x))
          (make-primitive 'poke (list (test-ref 'generated-symbol)
                                      (test-ref 'x)
                                      (make-constant 0)) '()
            (make-primitive 'poke (list (make-constant 10)
                                        (test-ref 'x)
                                        (make-constant 0)) '()
              (make-apply (test-ref 'generated-symbol) (list (make-constant #f))))))))
    (make-apply (test-ref 'tail) (make-constant 5)))
  (ir1->ir2 (make-letrec
              #f
              '(f)
              (list (gensym))
              (list (make-lambda (list (test-ref 'x)) #f
                      (make-lexical-set (test-ref 'x) (make-constant 10))))
              (make-constant 5))
            tail))


(test set-function
  (make-primitive 'alloc (list (make-constant 1)) (list (test-ref 'f))
    (make-fix
      (list
        (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)) #f
          (make-apply (test-ref 'generated-symbol) (list (make-constant 10)))))
      (make-primitive 'poke (list (test-ref 'generated-symbol) (test-ref 'f) (make-constant 0)) '()
        (make-primitive 'poke (list (make-constant 5) (test-ref 'f) (make-constant 0)) '()
          (make-apply (test-ref 'tail) (make-constant #f))))))
  (ir1->ir2 (make-letrec
              #f
              '(f)
              (list (gensym))
              (list (make-lambda '() #f (make-constant 10)))
              (make-lexical-set (test-ref 'f) (make-constant 5)))
            tail))