;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*

(in-package :kenzo-test)

(in-suite :kenzo)

(test smgr-fibration
      (cat:cat-init)
      (let* ((k1 (cat:k-z-1))
             (tw (cat:smgr-fibration k1))
             (k2 (cat:sorc tw))
             (tt (cat:fibration-total tw))
             (gmsm (cat:crpr 0 (cat:gbar 4 0 '(10 11 12) 0 '(20 21)
                                         0 '(30) 0 '())
                             0 '(2 4 6 8)))
             (br (cat:brown-reduction tw))
             (tw-pr (cat:bcc br)))
        (dotimes (i 5)
          (print (cat:face tt i 4 gmsm)))
        (cat:? tw-pr 4 (cat:tnpr 4 (cat:gbar 4 0 '(1 10 100) 0 '(1000 10000)
                                             0 '(100000) 0 '())
                                 0 '()))))

#|
(test smgr-crts-contraction
      (cat:cat-init)
      (let* ((chi (cat:smgr-crts-contraction (cat:k-z-1)))
             (rdct (cat:build-rdct :f (cat:zero-mrph (cat:sorc chi)
                                                     (cat:z-chcm))
                                   :g (cat:zero-mrph (cat:z-chcm)
                                                     (cat:sorc chi))
                                   :h chi)))
        (cat:pre-check-rdct rdct)
        (setf cat:*tc* (cat:cmbn 0 1 (cat:crpr 0 cat:+null-gbar+ 0 '())))
        (setf cat:*bc* (cat:cmbn 0 1 :z-gnrt))
        (check-rdct)
        (setf cat:*tc* (cat:cmbn 1 1 (cat:crpr 1 cat:+null-gbar+ 0 '(1))))
        (check-rdct)
        (setf cat:*tc* (cat:cmbn 4 1 (cat:crpr 0 (cat:gbar 4 0 '(10 11 12)
                                                           0 '(20 21)
                                                           0 '(30) 0 '())
                                               0 '(2 4 6 8))))
        (check-rdct)
        (setf cat:*tc* (cat:cmbn 3 1 (cat:crpr 0 (cat:gbar 3 0 '(10 11)
                                                           0 '(20) 0 '())
                                               0 '(2 4 6))))
        (check-rdct)))
|#

#|
(test smgr-tnpr-contraction
      (cat:cat-init)
      (let* ((chi (cat:smgr-tnpr-contraction (cat:k-z-1)))
             (rdct (cat:build-rdct :f (cat:zero-mrph (cat:sorc chi)
                                                     (cat:z-chcm))
                                   :g (cat:zero-mrph (cat:z-chcm)
                                                     (cat:sorc chi))
                                   :h chi)))
        (cat:pre-check-rdct rdct)
        (setf cat:*tc* (cat:cmbn 0 1 (cat:tnpr 0 cat:+null-gbar+ 0 '())))
        (setf cat:*bc* (cat:cmbn 0 1 :z-gnrt))
        (check-rdct)
        (setf cat:*tc* (cat:cmbn 1 1 (cat:tnpr 0 cat:+null-gbar+ 1 '(1))))
        (check-rdct)
        (setf cat:*tc* (cat:cmbn 3 1 (cat:tnpr 0 cat:+null-gbar+
                                               3 '(1 10 100))))
        (cat:? chi cat:*tc*)
        (check-rdct)
        (setf cat:*tc* (cat:cmbn 3 1 (cat:tnpr 2 (cat:gbar 2 0 '(1) 0 '())
                                               1 '(10))))
        (cat:? chi cat:*tc*)
        (check-rdct)
        (setf cat:*tc* (cat:cmbn 3 1 (cat:tnpr 3 (cat:gbar 3 0 '(1 10)
                                                           0 '(100) 0 '())
                                               0 '())))
        (cat:? chi cat:*tc*)
        (check-rdct)
        (setf cat:*tc* (cat:cmbn 4 1 (cat:tnpr 0 cat:+null-gbar+
                                               4 '(1 10 100 1000))))
        (cat:? chi cat:*tc*)
        (check-rdct)
        (setf cat:*tc* (cat:cmbn 4 1 (cat:tnpr 2 (cat:gbar 2 0 '(1) 0 '())
                                               2 '(10 100))))
        (cat:? chi cat:*tc*)
        (check-rdct)
        (setf cat:*tc* (cat:cmbn 4 1 (cat:tnpr 3 (cat:gbar 3 0 '(1 10)
                                                           0 '(100) 0 '())
                                               1 '(1000))))
        (cat:? chi cat:*tc*)
        (check-rdct)
        (setf cat:*tc* (cat:cmbn 4 1 (cat:tnpr 4 (cat:gbar 4 0 '(1 10 100)
                                                           0 '(1000 10000)
                                                           0 '(100000)
                                                           0 '())
                                               0 '())))
        (cat:? chi cat:*tc*)
        (check-rdct)))
|#