(load #P"../src/unified-matcher")
(load #P"../src/utils")
(load #P"../src/parser")
(load #P"../src/graph-generator")
(use-package :utils)
(use-package :ggen)

; tests for 'new-id'
(assert (eq (ggen::new-id) 'id-0))
(assert (eq (ggen::new-id "NOT1") 'not1-1))

; tests for 'add-node-conn'
(ggen::add-node-conn '(in-1 a) nil '(e-0))
(let ((val (ggen::graph-body ggen::*graph*))
      (exp '((nil (in-1 ggen::in a) (e-0)))))
  (assert (equal val exp)
          nil
          "add-node-conn test exp: ~A, val: ~A" exp val))

(ggen::add-node-conn '(not1-3) '(e-0) '(e-2))
(let ((val (ggen::graph-body ggen::*graph*))
      (exp '(((e-0) (not1-3 not1)       (e-2))
             (nil   (in-1   ggen::in a) (e-0)))))
  (assert (equal val exp)
          nil
          "add-node-conn test exp: ~A, val: ~A" exp val))


; tests for 'input' and 'not1'
(ggen::reset-graph)
(let* ((input (input 'a))
       (gated (not1 input)))
  (assert (eq input 'e-0))
  (assert (eq gated 'e-2)))
(let ((val (ggen::graph-body ggen::*graph*))
      (exp '(((e-0) (not1-3 ggen::not1) (e-2))
             (nil   (in-1 ggen::in a)   (e-0)))))
  (assert (equal val exp)
          nil
          "add-node-conn test exp: ~A, val: ~A" exp val))

; tests for 'andn'
(ggen::reset-graph)
(let* ((a (input 'a))
       (b (input 'b))
       (gated (andn a b)))
  (assert (eq a 'e-0))
  (assert (eq b 'e-2))
  (assert (eq gated 'e-4)))
(let ((val (ggen::graph-body ggen::*graph*))
      (exp '(((e-0 e-2) (andn-5 ggen::andn) (e-4))
             (nil       (in-3 ggen::in b)   (e-2))
             (nil       (in-1 ggen::in a)   (e-0)))))
  (assert (equal val exp)
          nil
          "andn test exp: ~A, val: ~A" exp val))

;; tests for 'dep-nid', 'dep-node'
;(assert (eql (ggen::dep-nid ggen::*graph* 'e-4)
;             'andn-5))
;(assert (equal (ggen::dep-node ggen::*graph* 'e-2)
;               '(in-3 b)))
;; tests for 'arv-nids', 'arv-nodes'
;(assert (equal (ggen::arv-nids ggen::*graph* 'e-2)
;               '(andn-5)))
;(assert (equal (ggen::arv-nodes ggen::*graph* 'e-2)
;               '((andn-5))))
;; tests for 'dep-edges', 'dep-eids'
;(assert (equal (ggen::dep-edges ggen::*graph* 'andn-5)
;               '((e-4 andn-5))))
;(assert (equal (ggen::dep-eids ggen::*graph* 'andn-5)
;               '(e-4)))
;; tests for 'arv-edges', 'arv-eids'
;(assert (equal (ggen::arv-edges ggen::*graph* 'andn-5)
;               '((e-2 in-3 andn-5)
;                 (e-0 in-1 andn-5))))
;(assert (equal (ggen::arv-eids ggen::*graph* 'andn-5)
;               '(e-2 e-0)))


; tests for 'orn' and 'output'
(ggen::reset-graph)
(let* ((a (input 'a))
       (b (input 'b))
       (gated (orn a b)))
  (output gated 'z)
  (assert (eq a 'e-0))
  (assert (eq b 'e-2))
  (assert (eq gated 'e-4)))
(let ((val (ggen::graph-body ggen::*graph*))
      (exp '(((e-4)     (out-6 ggen::out z) nil)
             ((e-0 e-2) (orn-5 ggen::orn)   (e-4))
             (nil       (in-3 ggen::in b)   (e-2))
             (nil       (in-1 ggen::in a)   (e-0)))))
  (assert (equal val exp)
          nil
          "orn, output test exp: ~A, val: ~A" exp val))

; tests for 'match1'
(mvbind (bind conns)
        (ggen::match1
          ggen::*graph*
          '(((?i0 ?i1) (?nid orn) (?m2))
            ((?m2)     ?node      ?os)))
  (let ((val (mapcar (curry #'um:subst-bind bind)
                     '(?i0 ?i1 ?nid ?m2 ?node ?os)))
        (exp '(e-0 e-2 orn-5 e-4 (out-6 ggen::out z) nil)))
    (assert (equal val exp)
            nil
            "match1 test exp: ~A, val: ~A" exp val))
  (let ((val conns)
        (exp '(((e-0 e-2) (orn-5 ggen::orn)   (e-4))
                ((e-4)     (out-6 ggen::out z) nil))))
    (assert (equal val exp)
            nil
            "match1 test exp: ~A, val: ~A" exp val)))

; some tests for node-type
(let ((nodes '((andn-9) (not1-7) (not1-5) (in-3 b) (in-1 a))))
  (assert (eq (ggen::node-type (nth 0 nodes))
              'andn))
  (assert (eq (ggen::node-type (nth 1 nodes))
              'not1))
  (assert (eq (ggen::node-type (nth 2 nodes))
              'not1))
  (assert (eq (ggen::node-type (nth 3 nodes))
              'in))
  (assert (eq (ggen::node-type (nth 4 nodes))
              'in)))

; test for nid-type
(let ((nid 'and2-12))
  (assert (eql (ggen:nid-type nid :ggen)
               'ggen::and2))
  (assert (not (eql (ggen:nid-type nid :ggen)
                    'and2))))

;;(ggen::reset-graph)
;;(let* ((ins (mapcar #'ggen:input '(i0 i1)))
;;       (o (apply #'ggen:andn ins))
;;       (graph ggen:*graph*))
;;  (assert (equal (ggen:calc graph
;;                           (list o)
;;                           `((i0 . 0) (i1 . 0)))
;;                 '(0)))
;;  (assert (equal (ggen:calc graph
;;                            (list o)
;;                            `((i0 . 1) (i1 . 0)))
;;                 '(0)))
;;  (assert (equal (ggen:calc graph
;;                            (list o)
;;                            `((i0 . 0) (i1 . 1)))
;;                 '(0)))
;;  (assert (equal (ggen:calc graph
;;                            (list o)
;;                            `((i0 . 1) (i1 . 1)))
;;                 '(1))))

(ggen::reset-graph)
(let* ((truth-table '(((0 0 0) (0 0))
                      ((1 0 0) (1 0))
                      ((0 1 0) (1 0))
                      ((1 1 0) (0 1))
                      ((0 0 1) (1 0))
                      ((1 0 1) (0 1))
                      ((0 1 1) (0 1))
                      ((1 1 1) (1 1))))
       (ins (mapcar #'ggen:input '(a b cin)))
       (oes (ggen:truth-table truth-table ins))
       (os (mapcar #'ggen:output oes '(s cout)))
       (graph ggen:*graph*))
  (dolist (row truth-table)
    (let ((ans (ggen:calc graph
                          (mapcar #'cons '(a b cin) (car row)))))
      (assert
        (and (eql (cdr (assoc 's ans))
                  (car (cadr row)))
             (eql (cdr (assoc 'cout ans))
                  (cadr (cadr row))))
         nil
         "An error occured on ~A in truth-table-test" row))))

; tests for 'elim1-orn-1in'
(ggen::reset-graph)
(let ((a (input 'a)))
  (output (orn a) 'z))
(let ((graph (ggen::elim1-orn-1in ggen::*graph*)))
  (let ((val (ggen::graph-body (ggen::elim1-orn-1in *graph*)))
        (exp '(((e-0) (out-4 ggen::out z) nil)
               (nil   (in-1 ggen::in a)   (e-0)))
              ))
    (assert (equal val exp)
            nil
            "elim1-orn-1in test exp: ~A, val: ~A" exp val)))

; tests for 'elim1-orn-2in'
(let ((val (ggen::graph-body
             (ggen::elim1-orn-2in
               (ggen::with-graph (ggen::make-graph)
                 (let* ((a (ggen:input 'a))
                        (b (ggen:input 'b))
                        (z (ggen:orn a b)))
                   (output z 'z)
                   ggen:*graph*)))))
      (exp '(((e-0 e-2) (or2-7 ggen::or2)   (e-4))
             ((e-4)     (out-6 ggen::out z) nil)
             (nil       (in-3 ggen::in b)   (e-2))
             (nil       (in-1 ggen::in a)   (e-0)))))
  (assert (equal exp val)
          nil
          "elim1-orn-2in test exp: ~A, val: ~A" exp val))

; tests for 'elim1-orn-many-in'
(let ((val (ggen::graph-body
             (ggen::elim1-orn-many-in
               (ggen::with-graph (ggen::make-graph)
                 (let* ((a (ggen:input 'a))
                        (b (ggen:input 'b))
                        (c (ggen:input 'c))
                        (z (ggen:orn a b c)))
                   (output z 'z)
                   ggen:*graph*)))))
      (exp '(((e-11 e-4)    (orn-10 ggen::orn)  (e-6))
             ((e-0 e-2)     (or2-9 ggen::or2)   (e-11))
             ((e-6)         (out-8 ggen::out z) nil)
             (nil           (in-5 ggen::in c)   (e-4))
             (nil           (in-3 ggen::in b)   (e-2))
             (nil           (in-1 ggen::in a)   (e-0)))))
  (assert (equal exp val)
          nil
          "elim1-orn-many-in test exp: ~A, val: ~A" exp val))


(in-package ggen)

; tests for with-graph
(let ((val (macroexpand-1
            '(with-graph gr ex1 ex2)))
      (exp '(let ((?g *graph*))
              (setq *graph* gr)
              (prog1
                (progn ex1 ex2)
                (setq *graph* ?g)))))
  (assert (not (eql um:fail
                    (um:unify val exp)))
          nil
          "exp: ~A, val: ~A" exp val))

; tests for 'or2'
(let ((val (with-graph (make-graph)
             (let* ((a (input 'a))
                    (b (input 'b))
                    (z (or2 a b)))
               (output z 'z)
               (graph-body *graph*))))
      (exp '(((e-4)     (out-6 out z)   nil)
             ((e-0 e-2) (or2-5 or2) (e-4))
             (nil       (in-3 in b) (e-2))
             (nil       (in-1 in a) (e-0)))))
  (assert (equal exp val)
          nil
          "or2-test exp: ~A, val: ~A" exp val))

(mapc (lambda (lst)
        (assert
          (eql (apply (get 'and2 'calc) (subseq lst 0 2))
               (nth 2 lst))
          nil
          "An error occured on ~A in and2 calc test" lst))
      '(( 0  0   0)
        ( 0  1   0)
        ( 1  0   0)
        ( 1  1   1)
        ( 0 :x   0)
        (:x  0   0)
        ( 1 :x  :x)
        (:x  1  :x)))

(mapc (lambda (lst)
        (assert
          (eql (apply (get 'or2 'calc) (subseq lst 0 2))
               (nth 2 lst))
          nil
          "An error occured on ~A in or2 calc test" lst))
      '(( 0  0   0)
        ( 0  1   1)
        ( 1  0   1)
        ( 1  1   1)
        ( 0 :x  :x)
        (:x  0  :x)
        ( 1 :x   1)
        (:x  1   1)))

(mapc (lambda (lst)
        (assert
          (eql (funcall (get 'not1 'calc) (car lst))
               (cadr lst))
          nil
          "An error occured on ~A in not1 calc test" lst))
      '(( 0  1)
        ( 1  0)
        (:x :x)))

(mapc (lambda (lst)
        (assert
          (eql (apply (get 'andn 'calc) (car lst))
               (cadr lst))
          nil
          "An error occured on ~A in andn calc test" lst))
      '((      nil  1)
        (      (0)  0)
        (      (1)  1)
        (    (0 1)  0)
        (    (1 1)  1)
        ((1 1 1 1)  1)
        ((1 0 1 1)  0)))

(mapc (lambda (lst)
        (assert
          (eql (apply (get 'orn 'calc) (car lst))
               (cadr lst))
          nil
          "An error occured on ~A in orn calc test" lst))
      '((      nil  0)
        (      (0)  0)
        (      (1)  1)
        (    (0 0)  0)
        (    (1 0)  1)
        ((0 0 0 0)  0)
        ((0 0 1 0)  1)))


