(define-library (csc macros-test)
  (import (scheme base)
          (only (csc gensym)
            gensym
            gensym?)
          (only (csc ir1)
            %call
            %call-builtin
            %constant
            %define-syntax
            %if
            %lambda
            %letrec
            %lexical-ref
            %lexical-set
            %library-define
            %library-ref
            %sequence
            call-builtin?
            call?
            constant?
            define-syntax?
            if?
            lambda?
            letrec?
            lexical-ref-name
            lexical-ref?
            lexical-set-expression
            lexical-set?
            library-define?
            library-ref?
            make-call-builtin
            make-constant
            make-define-syntax
            make-if
            make-lambda
            make-letrec
            make-lexical-ref
            make-lexical-set
            make-library-ref
            make-sequence
            sequence?)
          (only (csc testing)
            assert-equal
            test)
          (csc macros))
  (begin


    (define transform-ir1
      (list
        (cons constant? %constant)
        (cons lexical-ref? %lexical-ref)
        (cons library-ref? %library-ref)
        (cons lexical-set? %lexical-set)
        (cons library-define? %library-define)
        (cons define-syntax? %define-syntax)
        (cons if? %if)
        (cons call? %call)
        (cons call-builtin? %call-builtin)
        (cons sequence? %sequence)
        (cons lambda? %lambda)
        (cons letrec? %letrec)
        (cons gensym? (lambda (x) 'gensym))
        (cons macro-transformer? (lambda (x) 'transformer))))


    (test builtin-quote
      (assert-equal
        (make-constant '(test 1 2 3))
        (expand-body 'main
          '((quote (test 1 2 3)))
          builtins-environment)
        transform-ir1))


    (test builtin-syntax-rules-literal
      (assert-equal
        (make-constant 1)
        (expand-body 'main
          '((let-syntax
              (foo
                (syntax-rules (a b)
                  ((foo a)
                    0)
                  ((foo b)
                    1)))
              (foo b)))
          builtins-environment)
        transform-ir1))


    (test builtin-syntax-rules-underscore
      (assert-equal
        (make-constant 0)
        (expand-body 'main
          '((let-syntax
              (foo
                (syntax-rules ()
                  ((foo _) 0)))
              (foo ignored)))
          builtins-environment)
        transform-ir1))


    (test builtin-syntax-rules-substitution
      (assert-equal
        (make-constant 5)
        (expand-body 'main
          '((let-syntax
              (foo
                (syntax-rules ()
                  ((foo x) x)))
              (foo 5)))
          builtins-environment)
        transform-ir1))


    (test builtin-syntax-rules-nil
      (assert-equal
        (make-constant 1)
        (expand-body 'main
          '((let-syntax
              (foo
                (syntax-rules ()
                  ((foo x) 0)
                  ((foo) 1)))
              (foo)))
          builtins-environment)
        transform-ir1))


    (test builtin-syntax-rules-improper-list
      (assert-equal
        (make-constant 1)
        (expand-body 'main
          '((let-syntax
              (foo
                (syntax-rules ()
                  ((foo a . b) a)))
              (foo 1 2 3)))
          builtins-environment)
        transform-ir1))


    (test builtin-syntax-rules-quoted
      (assert-equal
        (make-constant 'a)
        (expand-body 'main
          '((let-syntax
              (foo
                (syntax-rules ()
                  ((foo x) (quote x))))
              (foo a)))
          builtins-environment)
        transform-ir1))


    (test builtin-syntax-rules-constant
      (assert-equal
        (make-constant 2)
        (expand-body 'main
          '((let-syntax
              (foo
                (syntax-rules ()
                  ((foo "abc") 0)
                  ((foo "def") 1)
                  ((foo "ghi") 2)))
              (foo "ghi")))
          builtins-environment)
        transform-ir1))


    (test builtin-syntax-rules-ellipsis
      (assert-equal
        (make-constant 5)
        (expand-body 'main
          '((let-syntax
              (foo
                (syntax-rules ()
                  ((foo x ...) (x ...))))
              (foo quote 5)))
          builtins-environment)
        transform-ir1))


    (test builtin-syntax-rules-ellipsis-improper
      (assert-equal
        (make-constant 5)
        (expand-body 'main
          '((let-syntax
              (foo
                (syntax-rules ()
                  ((foo x ... . y) (x ... y))))
              (foo quote . 5)))
          builtins-environment)
        transform-ir1))


    (test builtin-syntax-rules-ellipsis-zip
      (assert-equal
        (make-constant '((1 . 3) (2 . 4)))
        (expand-body 'main
          '((let-syntax
              (zip
                (syntax-rules ()
                  ((zip (x ...) (y ...))
                    (quote ((x . y) ...)))))
              (zip (1 2) (3 4))))
          builtins-environment)
        transform-ir1))


    (test builtin-syntax-rules-ellipsis-nested
      (assert-equal
        (make-constant '(1 2 3 4 5))
        (expand-body 'main
          '((let-syntax
              (append
                (syntax-rules ()
                  ((append (x ...) ...)
                    (quote (x ... ...)))))
              (append (1 2) (3 4) () (5))))
          builtins-environment)
        transform-ir1))


    (test builtin-syntax-rules-ellipsis-custom
      (assert-equal
        (make-constant 5)
        (expand-body 'main
          '((let-syntax
              (foo
                (syntax-rules ::: ()
                  ((foo x :::) (x :::))))
              (foo quote 5)))
          builtins-environment)
        transform-ir1))


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


    (test builtin-lambda-rest
      (assert-equal
        (make-lambda (list
                       (test-ref 'a)
                       (test-ref 'b)
                       (test-ref 'c))
                     (test-ref 'd)
                     (make-sequence (make-constant #f) (make-constant 5)))
        (expand-body 'main
          '((lambda
              (a b c . d) (quote 5)))
          builtins-environment)
        transform-ir1))


    (test builtin-case-lambda-defines
      (assert-equal
        (make-lambda (list (test-ref 'x)) #f
          (make-letrec #t '(a b) (list (gensym) (gensym))
            (list (make-constant 6)
                  (test-ref 'a))
            (make-sequence (make-constant #f) (make-constant 7))))
        (expand-body 'main
          '((lambda (x)
              (builtin-define a (quote 6))
              (builtin-define b a)
              (quote 7)))
          builtins-environment)
        transform-ir1))


    (test builtin-define-syntax
      (assert-equal
        (make-sequence
          (make-define-syntax 'five 'transformer)
          (make-constant 5))
        (expand-body 'main
          '((define-syntax five
              (syntax-rules ()
                ((five _) 5)))
            (five 6))
          builtins-environment)
        transform-ir1))


    (test builtin-call-builtin
      (assert-equal
        (make-call-builtin 'bbb (list (make-constant 5)))
        (expand-body 'main
          '((call-builtin bbb 5))
          builtins-environment)
        transform-ir1))


    (test builtin-lexical-set
      (assert-equal
        (make-lambda (list (test-ref 'x)) #f
          (make-sequence
            (make-constant #f)
            (make-lexical-set (test-ref 'x) (make-constant 5))))
        (expand-body 'main
          '((lambda (x)
              (set! x 5)))
          builtins-environment)
        transform-ir1))


    (test builtin-if
      (assert-equal
        (make-if (make-constant #t) (make-constant 5) (make-constant 10))
        (expand-body 'main
          '((builtin-if #t 5 10))
          builtins-environment)
        transform-ir1))))