(import (scheme base)
        (only (csc ir1)
          constant-expression
          constant?
          ir1=?
          lexical-ref-name
          lexical-ref?
          lexical-set-expression
          lexical-set?
          make-constant
          make-lambda-case
          make-letrec
          make-lexical-ref
          make-library-ref
          make-sequence)
        (only (csc testing)
          assert-equal
          test)
        (csc macros))


(test builtin-quote
  (assert-equal ir1=?
    (make-constant '(test 1 2 3))
    (expand '(quote (test 1 2 3)) builtins-environment)))


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


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


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


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


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


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


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


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


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


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


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


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


(test builtin-case-lambda-cases
  (assert-equal ir1=?
    (make-lambda-case '(x y z) #f #f (make-sequence (make-constant #f) (make-constant 5))
      (make-lambda-case '(a b c) 'd #f (make-sequence (make-constant #f) (make-constant 6)) '()))
    (expand
      '(case-lambda
         ((x y z) (quote 5))
         ((a b c . d) (quote 6)))
      builtins-environment)))


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