(import (scheme base)
        (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-fix
          make-atom
          make-branch
          make-call-closure
          make-closure
          make-kargs
          make-klabel
          make-ktail
          make-update)
        (only (csc testing)
          assert-equal
          test)
        (csc cps))


(define (tail x)
  (make-apply (make-lexical-ref 'tail #f) (list x)))


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


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


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


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


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


(test branch
  (assert-equal ir2=?
    (make-fix
      (list
        (make-closure (make-lexical-ref 'generated-symbol #f) (list (make-lexical-ref 'generated-symbol #f)) #f
          (make-apply (make-lexical-ref 'tail #f) (list (make-lexical-ref 'generated-symbol #f)))))
      (make-branch (make-constant #t)
        (make-apply (make-lexical-ref 'generated-symbol #f) (list (make-constant 1)))
        (make-apply (make-lexical-ref 'generated-symbol #f) (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 (make-lexical-ref 'generated-symbol #f) (list (make-lexical-ref 'generated-symbol #f)) #f
          (make-apply (make-lexical-ref 'tail #f) (list (make-lexical-ref 'generated-symbol #f)))))
      (make-apply (make-lexical-ref 'f #f) (list (make-lexical-ref 'generated-symbol #f)
                                                 (make-constant 1)
                                                 (make-constant 2))))
    (ir1->ir2 (make-call (make-lexical-ref 'f #f) (list (make-constant 1) (make-constant 2)))
              tail)))


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


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


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