(import (scheme base)
        (only (csc hash-map)
          map->alist)
        (only (csc ir1)
          make-call
          make-constant
          make-define-syntax
          make-if
          make-lambda
          make-lambda-case
          make-letrec
          make-lexical-ref
          make-lexical-set
          make-library-ref
          make-sequence)
        (only (csc ir2)
          ir2=?
          make-atom
          make-branch
          make-call-closure
          make-closure
          make-kargs
          make-klabel
          make-ktail
          make-lambda-args
          make-update)
        (only (csc loop)
          loop
          return)
        (only (csc sort) sort)
        (only (csc testing)
          assert-equal
          test)
        (csc cps))


(define (soup->alist s)
  (sort (lambda (x y) (< (car x) (car y))) (map->alist s)))


(define (soup=? x y)
  (and (= (length x) (length y))
       (loop for x* in x
             for y* in y
             unless (and (= (car x*) (car y*))
                         (ir2=? (cdr x*) (cdr y*)))
               return #f
             finally (return #t))))


(test atom-const
  (assert-equal soup=?
    (list
      (cons 0 (make-klabel
                (make-atom (make-constant 5) 1)))
      (cons 1 (make-ktail)))
    (soup->alist (ir1->ir2 (make-constant 5)))))


(test atom-lexical-ref
  (assert-equal soup=?
    (list
      (cons 0 (make-klabel
                (make-atom (make-lexical-ref 'var #f) 1)))
      (cons 1 (make-ktail)))
    (soup->alist (ir1->ir2 (make-lexical-ref 'var #f)))))


(test atom-library-ref
  (assert-equal soup=?
    (list
      (cons 0 (make-klabel
                (make-atom (make-library-ref 'var '(csc builtins)) 1)))
      (cons 1 (make-ktail)))
    (soup->alist (ir1->ir2 (make-library-ref 'var '(csc builtins))))))


(test lexical-set
  (assert-equal soup=?
    (list
      (cons 0 (make-klabel
                (make-atom (make-constant 5) 2)))
      (cons 1 (make-ktail))
      (cons 2 (make-kargs (list (make-lexical-ref 'generated-symbol #f))
                (make-update (make-lexical-ref 'var #f)
                             (make-lexical-ref 'generated-symbol #f) 1))))
    (soup->alist (ir1->ir2 (make-lexical-set (make-lexical-ref 'var #f) (make-constant 5))))))


(test no-op-define-syntax
  (assert-equal soup=?
    (list
      (cons 0 (make-klabel (make-atom (make-constant #f) 1)))
      (cons 1 (make-ktail)))
    (soup->alist (ir1->ir2 (make-define-syntax 'name '(transformer))))))


(test branch
  (assert-equal soup=?
    (list
      (cons 0 (make-klabel (make-atom (make-constant #t) 4)))
      (cons 1 (make-ktail))
      (cons 2 (make-klabel (make-atom (make-constant 1) 1)))
      (cons 3 (make-klabel (make-atom (make-constant 2) 1)))
      (cons 4 (make-kargs (list (make-lexical-ref 'generated-symbol #f))
                (make-branch (make-lexical-ref 'generated-symbol #f)
                  2 3))))
    (soup->alist (ir1->ir2 (make-if (make-constant #t)
                             (make-constant 1)
                             (make-constant 2))))))


(test call-closure
  (assert-equal soup=?
    (list
      (cons 0 (make-klabel (make-atom (make-lexical-ref 'f #f) 4)))
      (cons 1 (make-ktail))
      (cons 2 (make-kargs (list (make-lexical-ref 'generated-symbol #f))
                (make-call-closure (make-lexical-ref 'generated-symbol #f)
                  (list (make-lexical-ref 'generated-symbol #f)
                        (make-lexical-ref 'generated-symbol #f))
                  1)))
      (cons 3 (make-kargs (list (make-lexical-ref 'generated-symbol #f))
                (make-atom (make-constant 2) 2)))
      (cons 4 (make-kargs (list (make-lexical-ref 'generated-symbol #f))
                (make-atom (make-constant 1) 3))))
    (soup->alist (ir1->ir2 (make-call (make-lexical-ref 'f #f) (list (make-constant 1) (make-constant 2)))))))


(test sequence
  (assert-equal soup=?
    (list
      (cons 0 (make-klabel (make-atom (make-constant 1) 2)))
      (cons 1 (make-ktail))
      (cons 2 (make-klabel (make-atom (make-constant 2) 1))))
    (soup->alist (ir1->ir2 (make-sequence (make-constant 1)
                                          (make-constant 2))))))


(test closure
  (assert-equal soup=?
    (list
      (cons 0 (make-klabel
                (make-closure
                  (list (make-lambda-args 2 #t 3))
                  1)))
      (cons 1 (make-ktail))
      (cons 2 (make-ktail))
      (cons 3 (make-kargs (list (make-lexical-ref 'a #f)
                                (make-lexical-ref 'b #f)
                                (make-lexical-ref 'c #f))
                (make-atom (make-constant 5) 2))))
    (soup->alist (ir1->ir2 (make-lambda
                             (make-lambda-case
                               '(a b)
                               'c
                               '(#f #f #f)
                               (make-constant 5)
                               #f))))))


(test letrec-to-lambda
  (assert-equal soup=?
    (list
      ; God help you when it's time to debug this test.
      (cons 0 (make-klabel
                (make-closure
                  (list
                    (make-lambda-args 1 #f 7))
                  3)))
      (cons 1 (make-ktail))
      (cons 2 (make-kargs (list (make-lexical-ref 'generated-symbol #f))
                (make-call-closure
                  (make-lexical-ref 'generated-symbol #f)
                  (list (make-lexical-ref 'generated-symbol #f))
                  1)))
      (cons 3 (make-kargs (list (make-lexical-ref 'generated-symbol #f))
                (make-atom (make-constant #f) 2)))
      (cons 4 (make-ktail))
      (cons 5 (make-klabel
                (make-atom (make-constant 2) 4)))
      (cons 6 (make-kargs (list (make-lexical-ref 'generated-symbol #f))
                (make-update (make-lexical-ref 'a #f) (make-lexical-ref 'generated-symbol #f) 5)))
      (cons 7 (make-kargs (list (make-lexical-ref 'a #f))
                 (make-atom (make-constant 1) 6))))
    (soup->alist (ir1->ir2 (make-letrec
                             #t
                             '(a)
                             '(#f)
                             (list (make-constant 1))
                             (make-constant 2))))))