(load #P"../src/unified-matcher.lisp")
(load #P"../src/utils.lisp")
(use-package :utils)

; tests for 'append1'
(assert
  (equal (append1 '(a b c) 'd)
         '(a b c d)))
(assert
  (equal (append1 '(1 2 3) 4 5)
         '(1 2 3 4 5)))

; tests for 'conc1f'
(setf *conc1f-test* '(1 2 3))
(assert (equal (conc1f *conc1f-test* 4)
               '(1 2 3 4)))
(assert (equal *conc1f-test*
               '(1 2 3 4)))

; tests for 'group'
(assert (equal (group 2 '(a b c d e f))
               '((a b) (c d) (e f))))
(assert (equal (group 3 '(1 2 3 4 5 6 7))
               '((1 2 3) (4 5 6) (7))))
(assert (null (group 0 '(a b c d))))

; a test for 'mvbind'
(assert (equal '(a b)
               (mvbind (x y) (values 'a 'b)
                 (list x y))))

; a test for 'dbind'
(assert (equal '(a b)
               (dbind (x y) (list 'a 'b)
                 (list x y))))

; a test for 'curry'
(assert (eql 3
             (funcall (curry #'- 2) -1)))

; a test for 'rcurry'
(assert (eql 3
             (funcall (rcurry #'- 2) 5)))

; tests for 'with-gensyms'
(let ((exp '(let ((a (gensym))
                  (b (gensym)))
              c))
      (val (macroexpand-1
             '(with-gensyms (a b) c))))
  (assert (equal val exp)
          nil
          "with-gensyms test  exp: ~A, val: ~A" exp val))

; tests for 'aif'
(let ((exp '(let ((it pred))
              (if it true false)))
      (val (macroexpand-1 '(aif pred true false))))
  (assert (not (eql (um:unify val exp)
                    um:fail))
          nil
          "aif test  exp: ~A, val: ~A" exp val))

; tests for 'aif2'
(assert
  (um:if-match '(mvbind (it ?win) pred
                  (if (or it ?win) true false))
               (macroexpand-1 '(aif2 pred true false))
    t nil))

(let ((h (make-hash-table)))
  (setf (gethash 'hoge h) 1)
  (assert
    (aif2 (gethash 'hoge h)
      (eql it '1)
      nil))
  (assert
    (aif2 (gethash 'fuga h)
      nil t)))

; tests for 'acond2'
(assert
  (um:if-match '(mvbind (?val ?win) test1
                  (if (or ?val ?win)
                    (let ((it ?val)) do1 do2)
                    (acond2 (t do3 do4))))
               (macroexpand-1 '(acond2 (test1 do1 do2)
                                       (t do3 do4)))
    (not (eql ?val ?win))))


; tests for 'compose'
(assert (eql (funcall (compose) 'a)
             'a))
(assert (eql (funcall (compose #'car #'cdr) '(1 2))
             2))
(assert (eql (funcall (compose #'1+ #'*) 2 3)
             7))

; tests for 'transpose'
(assert (equal (transpose '((a b c) (d e f)))
               '((a d) (b e) (c f))))

; tests for 'pop1'
(let ((exp nil)
      (val (pop1 nil)))
  (assert (equal exp val)
          nil
          "pop1 test  exp: ~A, val: ~A" exp val))

(let ((exp '((a)))
      (val (pop1 '(a))))
  (assert (equal exp val)
          nil
          "pop1 test  exp: ~A, val: ~A" exp val))

(let ((exp '((a b c d)
             (b a c d)
             (c a b d)
             (d a b c)))
      (val (pop1 '(a b c d))))
  (assert (equal exp val)
          nil
          "pop1 test  exp: ~A, val: ~A" exp val))

(let ((exp '((a a b c d)
             (b a b c d)
             (c a b c d)
             (d a b c d)))
      (val (pop1 '(a b c d) :keep t)))
  (assert (equal exp val)
          nil
          "pop1 test  exp: ~A, val: ~A" exp val))

; tests for 'perm'
(let ((exp '(nil))
      (val (perm nil 1)))
  (assert (equal exp val)
          nil
          "perm test  exp: ~A, val: ~A" exp val))

(let ((exp '((0)))
      (val (perm '(0) 1)))
  (assert (equal exp val)
          nil
          "perm test  exp: ~A, val: ~A" exp val))

(let ((exp '((a b) (a c)
             (b a) (b c)
             (c a) (c b)))
      (val (perm '(a b c) 2)))
  (assert (equal exp val)
          nil
          "perm test  exp: ~A, val: ~A" exp val))

(let ((exp '((a a) (a b) (a c)
             (b a) (b b) (b c)
             (c a) (c b) (c c)))
      (val (perm '(a b c) 2 :repeat t)))
  (assert (equal exp val)
          nil
          "perm test  exp: ~A, val: ~A" exp val))

; tests for 'c-prod'
(let ((exp '(nil))
      (val (c-prod)))
  (assert (equal exp val)
          nil
          "c-prod test  exp: ~A, val: ~A" exp val))

;(let ((exp '((a) (b) (c)))
;      (val (c-prod '(a b c))))
;  (assert (equal exp val)
;          nil
;          "c-prod test  exp: ~A, val: ~A" exp val))

(let ((exp '((a 1 x) (a 1 y) (a 1 z)
             (a 2 x) (a 2 y) (a 2 z)
             (a 3 x) (a 3 y) (a 3 z)
             (b 1 x) (b 1 y) (b 1 z)
             (b 2 x) (b 2 y) (b 2 z)
             (b 3 x) (b 3 y) (b 3 z)))
      (val (c-prod '(a b) '(1 2 3) '(x y z))))
  (assert (equal exp val)
          nil
          "c-prod test  exp: ~A, val: ~A" exp val))

; tests for 'mkstr'
(let ((val (mkstr))
      (exp ""))
  (assert (string= val exp)
          nil
          "mkstr test  exp: ~A, val: ~A" exp val))

(let ((val (mkstr 'abc))
      (exp "ABC"))
  (assert (string= val exp)
          nil
          "mkstr test  exp: ~A, val: ~A" exp val))

(let ((val (mkstr 'a 'bc))
      (exp "ABC"))
  (assert (string= val exp)
          nil
          "mkstr test  exp: ~A, val: ~A" exp val))

; tests for 'symb'
(let ((val (symb 'ar "Madi" #\L #\L 0))
      (exp '|ARMadiLL0|))
  (assert (eql val exp)
          nil
          "mkstr test  exp: ~A, val: ~A" exp val))

; tests for 'chain-call'
(assert (equal (macroexpand-1 '(chain-call o
                                 (fn1 arg1)))
               '(fn1 o arg1)))
(assert (equal (macroexpand-1 '(chain-call o
                                 (fn1 arg1)
                                 (fn2 arg2)))
               '(fn2 (fn1 o arg1)
                     arg2)))
(assert (eql (chain-call '(1 2 3)
               (cdr) (car))
             2))

; tests for 'bits-to-int'
(assert (eql 0 (bits-to-int nil)))
(assert (eql 0 (bits-to-int '(0 0 0))))
(assert (eql 1 (bits-to-int '(1))))
(assert (eql 1 (bits-to-int '(1 0 0))))
(assert (eql 2 (bits-to-int '(0 1))))
(assert (eql 2 (bits-to-int '(0 1 0))))
(assert (eql 3 (bits-to-int '(1 1))))
(assert (eql 3 (bits-to-int '(1 1 0 0))))
(assert (eql 14 (bits-to-int '(0 1 1 1))))
(assert (eql 15 (bits-to-int '(1 1 1 1))))
(assert (eql 16 (bits-to-int '(0 0 0 0 1))))

; tests for 'int-to-bits'
(assert (eql nil
             (int-to-bits -1)))
(assert (eql nil
             (int-to-bits 0)))
(assert (equal '(1)
               (int-to-bits 1)))
(assert (equal '(0 1)
                (int-to-bits 2)))
(assert (equal '(1 1)
                (int-to-bits 3)))
(assert (equal '(0 1 1 1)
               (int-to-bits 14)))
(assert (equal '(1 1 1 1)
               (int-to-bits 15)))
(assert (equal '(0 0 0 0 1)
               (int-to-bits 16)))
