From c75796d4c7d12050cb932ec0ff4817971f0a5ff7 Mon Sep 17 00:00:00 2001
From: Gerd Heber <gheber@hdfgroup.org>
Date: Sat, 11 Jul 2015 21:13:19 -0500
Subject: [PATCH] First batch of k-pi-n tests.

---
 kenzo-test.asd        |    4 +-
 package.lisp          |   19 +
 src/k-pi-n.lisp       | 1480 ++++++++++++++++++-----------------------
 test/k-pi-n-test.lisp |  214 ++++++
 4 files changed, 893 insertions(+), 824 deletions(-)
 create mode 100644 test/k-pi-n-test.lisp

diff --git a/kenzo-test.asd b/kenzo-test.asd
index f5f8e88..c877384 100644
--- a/kenzo-test.asd
+++ b/kenzo-test.asd
@@ -25,4 +25,6 @@
 	       (:file "cartesian-products-test")
 	       (:file "cones-test")
 	       ;;(:file "cl-space-efhm-test")
-	       (:file "tensor-products-test")))
+	       (:file "tensor-products-test")
+	       (:file "k-pi-n-test")
+	       ))
diff --git a/package.lisp b/package.lisp
index 2e147ce..4e95a26 100644
--- a/package.lisp
+++ b/package.lisp
@@ -206,8 +206,26 @@
 
 	   ;; k-pi-n.lisp
 
+	   CIRCLE
+	   INTERESTING-FACES
+	   GMSM-COCYCLE
 	   K-Z
 	   K-Z-1
+	   K-Z-1-CMPR
+	   K-Z-1-FACE
+	   K-Z-1-GRIN
+	   K-Z-1-GRML
+	   K-Z2
+	   K-Z2-1
+	   KZ1-RDCT
+	   KZ1-RDCT-F-INTR
+	   KZ1-RDCT-H-INTR
+	   Z-ABSM-BAR
+	   Z-BAR-ABSM
+	   Z-FUNDAMENTAL-GMSM
+	   Z2-ABSM-BAR
+	   Z2-BAR-ABSM
+	   Z-COCYCLE-GBAR
 
 	   ;; macros.lisp
 
@@ -235,6 +253,7 @@
 	   DFFR
 	   DGNL
 	   GNRT
+	   GRIN
 	   I-SBTR
 	   MASK
 	   RBCC
diff --git a/src/k-pi-n.lisp b/src/k-pi-n.lisp
index cc4209c..bd69a85 100644
--- a/src/k-pi-n.lisp
+++ b/src/k-pi-n.lisp
@@ -7,198 +7,160 @@
 (PROVIDE "k-pi-1")
 
 (DEFUN K-Z-1-CMPR (gnrt1 gnrt2)
-   (declare (list gnrt1 gnrt2))
-   (the cmpr
-   (do ((mark1 gnrt1 (cdr mark1))
-	(mark2 gnrt2 (cdr mark2)))
-       ((endp mark1) :equal)
-       (case (f-cmpr (car mark1) (car mark2))
-	  (:equal)
-	  (:less (return-from k-z-1-cmpr :less))
-	  (:greater (return-from k-z-1-cmpr :greater))))))
+  (declare (list gnrt1 gnrt2))
+  (the cmpr
+       (do ((mark1 gnrt1 (cdr mark1))
+	    (mark2 gnrt2 (cdr mark2)))
+	   ((endp mark1) :equal)
+	 (case (f-cmpr (car mark1) (car mark2))
+	   (:equal)
+	   (:less (return-from k-z-1-cmpr :less))
+	   (:greater (return-from k-z-1-cmpr :greater))))))
 
-#|
-  (k-z-1-cmpr '(1 1 2) '(1 2 2))
-  (k-z-1-cmpr '(1 1 2) '(1 1 2))
-  (k-z-1-cmpr '(1 1 2) '(1 1 -1))
-|#
 
 (DEFUN K-Z-1-FACE (indx dmns gmsm)
-   (declare
-      (fixnum indx dmns)
-      (list gmsm))
-   (the absm
-   (cond ((zerop indx) (absm 0 (rest gmsm)))
-	 ((= indx dmns) (absm 0 (butlast gmsm)))
-	 (t
-	  (do ((rslt +empty-list+ (cons (car mark) rslt))
-	       (mark gmsm (cdr mark))
-	       (i 1 (1+ i)))
-	      ((= i indx) (let ((new-k (+ (car mark) (cadr mark))))
-			    (declare (fixnum new-k))
-			    (if (zerop new-k)
-			       (absm (2-exp (1- indx)) (nreconc rslt (cddr mark)))
-			       (absm 0 (nreconc rslt (cons new-k (cddr mark)))))))
-	     (declare
-	        (list rslt mark)
-		(fixnum i)))))))
+  (declare
+   (fixnum indx dmns)
+   (list gmsm))
+  (the absm
+       (cond ((zerop indx) (absm 0 (rest gmsm)))
+	     ((= indx dmns) (absm 0 (butlast gmsm)))
+	     (t
+	      (do ((rslt +empty-list+ (cons (car mark) rslt))
+		   (mark gmsm (cdr mark))
+		   (i 1 (1+ i)))
+		  ((= i indx) (let ((new-k (+ (car mark) (cadr mark))))
+				(declare (fixnum new-k))
+				(if (zerop new-k)
+				    (absm (2-exp (1- indx))
+					  (nreconc rslt (cddr mark)))
+				    (absm 0
+					  (nreconc rslt
+						   (cons new-k
+							 (cddr mark)))))))
+		(declare
+		 (list rslt mark)
+		 (fixnum i)))))))
 
-#|
-  (k-z-1-face 0 1 '(3))
-  (k-z-1-face 1 1 '(3))
-  (k-z-1-face 0 3 '(1 2 3))
-  (k-z-1-face 1 3 '(1 2 3))
-  (k-z-1-face 2 3 '(1 2 3))
-  (k-z-1-face 2 3 '(1 2 -2))
-  (k-z-1-face 3 3 '(1 2 3))
-|#
 
 (DEFUN Z-ABSM-BAR (absm)
   (declare (type absm absm))
   (the list
-    (with-absm (dgop bar1) absm
-      (do ((dgop dgop (ash dgop -1))
-	   (rslt +empty-list+))
-	  ((and (zerop dgop) (endp bar1)) (nreverse rslt))
-	  (declare
-	     (fixnum dgop)
-	     (list rslt))
-	  (push (if (oddp dgop)
-		    0
-		  (pop bar1))
-		rslt)))))
+       (with-absm (dgop bar1) absm
+		  (do ((dgop dgop (ash dgop -1))
+		       (rslt +empty-list+))
+		      ((and (zerop dgop) (endp bar1)) (nreverse rslt))
+		    (declare
+		     (fixnum dgop)
+		     (list rslt))
+		    (push (if (oddp dgop)
+			      0
+			      (pop bar1))
+			  rslt)))))
 
-#|
-  (z-absm-bar (absm 0 '()))
-  (z-absm-bar (absm 1 '()))
-  (z-absm-bar (absm 0 '(2)))
-  (dotimes (i 8)
-    (print (z-absm-bar (absm i '(3 6)))))
-|#
 
 (DEFUN Z-BAR-ABSM (bar)
   (declare (list bar))
   (the absm
-     (do ((rslt-dgop 0)
-	  (rslt-bar +empty-list+)
-	  (mark bar (cdr mark))
-	  (bark 1 (+ bark bark)))
-	 ((endp mark) (absm rslt-dgop (nreverse rslt-bar)))
-	(declare
-	   (fixnum rslt-dgop bark)
-	   (list rslt-bar mark))
-	(let ((k-i (car mark)))
-	  (declare (fixnum k-i))
-	  (if (zerop k-i)
-	     (incf rslt-dgop bark)
-	     (push k-i rslt-bar))))))
+       (do ((rslt-dgop 0)
+	    (rslt-bar +empty-list+)
+	    (mark bar (cdr mark))
+	    (bark 1 (+ bark bark)))
+	   ((endp mark) (absm rslt-dgop (nreverse rslt-bar)))
+	 (declare
+	  (fixnum rslt-dgop bark)
+	  (list rslt-bar mark))
+	 (let ((k-i (car mark)))
+	   (declare (fixnum k-i))
+	   (if (zerop k-i)
+	       (incf rslt-dgop bark)
+	       (push k-i rslt-bar))))))
 
-#|
-  (z-bar-absm (z-absm-bar (absm 0 '())))
-  (z-bar-absm (z-absm-bar (absm 1 '())))
-  (z-bar-absm (z-absm-bar (absm 0 '(2))))
-  (dotimes (i 8)
-    (print (z-bar-absm (z-absm-bar (absm i '(3 6))))))
-|#
 
 (DEFUN K-Z-1-GRML (dmns crpr)
-   (declare
-      (fixnum dmns)
-      (type crpr crpr))
-   (the absm
-      (with-crpr (dgop1 bar1 dgop2 bar2) crpr
-	 (do ((indx 1 (1+ indx))
-	      (dgop1 dgop1 (ash dgop1 -1))
-	      (dgop2 dgop2 (ash dgop2 -1))
-	      (bark 1 (ash bark +1))
-	      (rslt-dgop 0)
-	      (rslt-bar +empty-list+))
-	     ((> indx dmns) (absm rslt-dgop (nreverse rslt-bar)))
-	     (declare
-	        (fixnum indx dgop1 dgop2 bark rslt-dgop)
-		(list rslt-bar))
-	     (let ((item (if (evenp dgop1)
-			     (if (evenp dgop2)
-				 (+ (pop bar1) (pop bar2))
-			       (pop bar1))
-			   (if (evenp dgop2)
-			       (pop bar2)
-			     0))))
-	       (declare (fixnum item))
-	       (if (zerop item)
-		   (incf rslt-dgop bark)
-		 (push item rslt-bar)))))))
+  (declare
+   (fixnum dmns)
+   (type crpr crpr))
+  (the absm
+       (with-crpr (dgop1 bar1 dgop2 bar2) crpr
+		  (do ((indx 1 (1+ indx))
+		       (dgop1 dgop1 (ash dgop1 -1))
+		       (dgop2 dgop2 (ash dgop2 -1))
+		       (bark 1 (ash bark +1))
+		       (rslt-dgop 0)
+		       (rslt-bar +empty-list+))
+		      ((> indx dmns) (absm rslt-dgop (nreverse rslt-bar)))
+		    (declare
+		     (fixnum indx dgop1 dgop2 bark rslt-dgop)
+		     (list rslt-bar))
+		    (let ((item (if (evenp dgop1)
+				    (if (evenp dgop2)
+					(+ (pop bar1) (pop bar2))
+					(pop bar1))
+				    (if (evenp dgop2)
+					(pop bar2)
+					0))))
+		      (declare (fixnum item))
+		      (if (zerop item)
+			  (incf rslt-dgop bark)
+			  (push item rslt-bar)))))))
 
-#|
-  (k-z-1-grml 0 (crpr 0 nil 0 nil))
-  (k-z-1-grml 1 (crpr 0 '(3) 0 '(4)))
-  (k-z-1-grml 1 (crpr 0 '(3) 0 '(-3)))
-  (k-z-1-grml 1 (crpr 0 '(3) 1 '()))
-  (k-z-1-grml 1 (crpr 1 '() 0 '(3)))
-  (k-z-1-grml 1 (crpr 1 '() 1 '()))
-  (k-z-1-grml 5 (crpr 24 '(2 2 3) 20 '(-2 2 4)))
-|#
 
 (DEFUN K-Z-1-GRIN (dmns bar)
   (declare
-     (ignore dmns)
-     (list bar))
+   (ignore dmns)
+   (list bar))
   (the absm
-     (absm 0 (mapcar #'- bar))))
+       (absm 0 (mapcar #'- bar))))
 
-#|
-  (k-z-1-grin 3 '(2 3 -4))
-  (setf gmsm '(2 3 -4))
-  (k-z-1-grml 3 (crpr 0 gmsm 0 (gmsm (k-z-1-grin 3 gmsm))))
-|#
 
 #|
 (DEFUN K-Z-1-KFLL (indx dmns hat)
   (declare
-     (fixnum indx dmns)
-     (list hat))
+   (fixnum indx dmns)
+   (list hat))
   (the absm
-     (cond ((= 1 dmns)
-	    (absm 1 +empty-list+))
-	   ((zerop indx)
-	    (let ((del-1 (first hat))
-		  (del-2 (second hat)))
-	      (declare (type absm del-1 del-2))
-	      (with-absm (dgop1 bar1) del-1
-	      (with-absm (dgop2 bar2) del-2
-		 (let ((bar01 (if (oddp dgop2)
-				 0
-				 (first bar2)))
-		       (bar02 (if (oddp dgop1)
-				 0
-				 (first bar1))))
-		   (declare (fixnum bar01 bar02))
-		   (let ((bar12 (- bar02 bar01)))
-		     (declare (fixnum bar02))
-		     (if (zerop bar01)
-			(1dgnr 0 del-1)
-		        (if (zerop bar12)
-			   (1gnr 1 del-1)
-			   (let (del-01 (k-z-1-face 0 (1- dmns)
-						    del-1))
-			     (declare (type absm del-01))
-			     (with-absm (dgop01 gmsm01) del-01
-				(absm (* 4 dgop01)
-				      (cons bar01
-					    (cons bar02 gmsm01)))))))))))))
-	   ((= 1 indx)
-	    (let ((del-0 (first hat))
-		  (del-2 (second hat)))
-	      (declare (type absm del-0 del-2))
-	      (with-absm (dgop0 gmsm0) del-0
-	      (with-absm (dgop2 gmsm2) del-2
-		 (if (oddp dgop2 )))))))))
+       (cond ((= 1 dmns)
+	      (absm 1 +empty-list+))
+	     ((zerop indx)
+	      (let ((del-1 (first hat))
+		    (del-2 (second hat)))
+		(declare (type absm del-1 del-2))
+		(with-absm (dgop1 bar1) del-1
+			   (with-absm (dgop2 bar2) del-2
+				      (let ((bar01 (if (oddp dgop2)
+						       0
+						       (first bar2)))
+					    (bar02 (if (oddp dgop1)
+						       0
+						       (first bar1))))
+					(declare (fixnum bar01 bar02))
+					(let ((bar12 (- bar02 bar01)))
+					  (declare (fixnum bar02))
+					  (if (zerop bar01)
+					      (1dgnr 0 del-1)
+					      (if (zerop bar12)
+						  (1gnr 1 del-1)
+						  (let (del-01 (k-z-1-face 0 (1- dmns)
+									   del-1))
+						    (declare (type absm del-01))
+						    (with-absm (dgop01 gmsm01) del-01
+							       (absm (* 4 dgop01)
+								     (cons bar01
+									   (cons bar02 gmsm01)))))))))))))
+	     ((= 1 indx)
+	      (let ((del-0 (first hat))
+		    (del-2 (second hat)))
+		(declare (type absm del-0 del-2))
+		(with-absm (dgop0 gmsm0) del-0
+			   (with-absm (dgop2 gmsm2) del-2
+				      (if (oddp dgop2 )))))))))
 
 |#
 
 (DEFUN K-Z-1 ()
   (the ab-simplicial-group
-     (build-ab-smgr
+       (build-ab-smgr
         :cmpr #'k-z-1-cmpr
 	:basis :locally-effective
 	:bspn +empty-list+
@@ -207,94 +169,64 @@
 	:sintr-grin #'k-z-1-grin
 	:orgn '(k-z-1))))
 
-#|
-  (setf k (k-z-1))
-  (defun aleat-list (max length)
-     (let ((rslt nil)
-           (2max (+ max max)))
-        (dotimes (i length)
-           (push (let ((k (- (random 2max) max)))
-                    (if (zerop k)
-                       max
-                       k))
-              rslt))
-        rslt))
-  (? k (? k 14 (aleat-list 200 14)))
-  (setf zero? (add (idnt-mrph k) (grin k)))
-  (? zero? 14 (aleat-list 200 14))
-|#
 
 (DEFUN K-Z (n)
-   (declare (fixnum n))
-   (the ab-simplicial-group
-      (if (= n 1)
-         (k-z-1)
-         (classifying-space (k-z (1- n))))))
+  (declare (fixnum n))
+  (the ab-simplicial-group
+       (if (= n 1)
+	   (k-z-1)
+	   (classifying-space (k-z (1- n))))))
 
 (DEFUN CIRCLE-CMPR (gnrt1 gnrt2)
-   (declare (ignore gnrt1 gnrt2))
-   (the cmpr :equal))
+  (declare (ignore gnrt1 gnrt2))
+  (the cmpr :equal))
 
 (DEFUN CIRCLE-BASIS (dmns)
-   (declare (fixnum dmns))
-   (the list
-      (case dmns
+  (declare (fixnum dmns))
+  (the list
+       (case dmns
 	 (0 '(*))
 	 (1 '(s1))
 	 (otherwise +empty-list+))))
 
 (DEFUN CIRCLE ()
-   (the chain-complex
-      (build-chcm
-         :cmpr #'circle-cmpr
-	 :basis #'circle-basis
-	 :bsgn '*
-	 :intr-dffr #'zero-intr-dffr
-	 :strt :cmbn
-	 :orgn '(circle))))
+  (the chain-complex
+       (build-chcm
+	:cmpr #'circle-cmpr
+	:basis #'circle-basis
+	:bsgn '*
+	:intr-dffr #'zero-intr-dffr
+	:strt :cmbn
+	:orgn '(circle))))
 
-#|
-  (setf c (circle))
-  (cmpr c '* '*)
-  (basis c 1)
-  (? c 1 's1)
-|#
 
 (DEFUN KZ1-RDCT-F-INTR (cmbn)
   (declare (type cmbn cmbn))
   (the cmbn
-     (with-cmbn (degr list) cmbn
-	(case degr
-	   (0 (if list
-		 (term-cmbn 0 (-cffc list) '*)
-		 (zero-cmbn 0)))
-	   (1 (let ((rslt
-		     (apply #'+
-			(mapcar
-			 #'(lambda (term)
-			     (declare (type term term))
-			     (with-term (cffc gnrt) term
-					(the fixnum (* cffc
-						       (first gnrt)))))
-			 list))))
-		(if (zerop rslt)
-		    (zero-cmbn 1)
-		  (term-cmbn 1 rslt 's1))))
-	   (otherwise (zero-cmbn degr))))))
+       (with-cmbn
+	   (degr list) cmbn
+	   (case degr
+	     (0 (if list
+		    (term-cmbn 0 (-cffc list) '*)
+		    (zero-cmbn 0)))
+	     (1 (let ((rslt
+		       (apply #'+
+			      (mapcar
+			       #'(lambda (term)
+				   (declare (type term term))
+				   (with-term
+				       (cffc gnrt) term
+				       (the fixnum (* cffc (first gnrt)))))
+			       list))))
+		  (if (zerop rslt)
+		      (zero-cmbn 1)
+		      (term-cmbn 1 rslt 's1))))
+	     (otherwise (zero-cmbn degr))))))
 
-#|
-  (kz1-rdct-f-intr (cmbn 0))
-  (kz1-rdct-f-intr (cmbn 0 4 '()))
-  (kz1-rdct-f-intr (cmbn 1))
-  (kz1-rdct-f-intr (cmbn 1 4 '(3)))
-  (kz1-rdct-f-intr (cmbn 1 4 '(3) 5 '(2)))
-  (kz1-rdct-f-intr (cmbn 1 4 '(3) -3 '(4)))
-  (kz1-rdct-f-intr (cmbn -3))
-|#
 
 (DEFUN KZ1-RDCT-F ()
   (the morphism
-     (build-mrph
+       (build-mrph
         :sorc (k-z-1)
 	:trgt (circle)
 	:degr 0
@@ -305,16 +237,17 @@
 (DEFUN KZ1-RDCT-G-INTR (cmbn)
   (declare (type cmbn cmbn))
   (the cmbn
-     (with-cmbn (degr list) cmbn
-	(if list
-	    (ecase degr
-	       (0 (term-cmbn 0 (-cffc list) +empty-list+))
-	       (1 (term-cmbn 1 (-cffc list) (list 1))))
-	  (zero-cmbn degr)))))
+       (with-cmbn (degr list) cmbn
+		  (if list
+		      (ecase degr
+			(0 (term-cmbn 0 (-cffc list) +empty-list+))
+			(1 (term-cmbn 1 (-cffc list) (list 1))))
+		      (zero-cmbn degr)))))
+
 
 (DEFUN KZ1-RDCT-G ()
   (the morphism
-     (build-mrph
+       (build-mrph
         :sorc (circle)
 	:trgt (k-z-1)
 	:degr 0
@@ -322,53 +255,43 @@
 	:strt :cmbn
 	:orgn '(kz1-rdct-g))))
 
+
 (DEFUN KZ1-RDCT-H-INTR (dmns bar)
   (declare
-     (fixnum dmns)
-     (list bar))
+   (fixnum dmns)
+   (list bar))
   (the cmbn
-     (progn
-       (when (zerop dmns)
-	  (return-from kz1-rdct-h-intr (zero-cmbn +1)))
-       (let ((k1 (first bar))
-	     (tail (rest bar)))
-	 (declare
+       (progn
+	 (when (zerop dmns)
+	   (return-from kz1-rdct-h-intr (zero-cmbn +1)))
+	 (let ((k1 (first bar))
+	       (tail (rest bar)))
+	   (declare
 	    (fixnum k1)
 	    (list tail))
-	 (if (plusp k1)
-	    (do ((rslt +empty-list+
-		       (cons (term -1
-				   (cons 1 (cons i tail)))
-			     rslt))
-		 (i (1- k1) (1- i)))
-		((zerop i) (make-cmbn :degr (1+ dmns)
-				      :list rslt))
-	       (declare
+	   (if (plusp k1)
+	       (do ((rslt +empty-list+
+			  (cons (term -1
+				      (cons 1 (cons i tail)))
+				rslt))
+		    (i (1- k1) (1- i)))
+		   ((zerop i) (make-cmbn :degr (1+ dmns)
+					 :list rslt))
+		 (declare
 		  (list rslt)
 		  (fixnum i)))
-	    (do ((rslt +empty-list+
-		       (cons (term +1
-				   (cons 1 (cons i tail)))
-			     rslt))
-		 (i -1 (1- i)))
-		((< i k1) (make-cmbn :degr (1+ dmns)
-				     :list rslt))))))))
+	       (do ((rslt +empty-list+
+			  (cons (term +1
+				      (cons 1 (cons i tail)))
+				rslt))
+		    (i -1 (1- i)))
+		   ((< i k1) (make-cmbn :degr (1+ dmns)
+					:list rslt))))))))
 
-#|
-  (kz1-rdct-h-intr 0 nil)
-  (kz1-rdct-h-intr 1 '(-4))
-  (kz1-rdct-h-intr 1 '(-1))
-  (kz1-rdct-h-intr 1 '(1))
-  (kz1-rdct-h-intr 1 '(4))
-  (kz1-rdct-h-intr 3 '(-4 3 5))
-  (kz1-rdct-h-intr 3 '(-1 3 -1))
-  (kz1-rdct-h-intr 3 '(1 2 2))
-  (kz1-rdct-h-intr 3 '(4 3 5))
-|#
 
 (DEFUN KZ1-RDCT-H ()
   (the morphism
-     (build-mrph
+       (build-mrph
         :sorc (k-z-1)
 	:trgt (k-z-1)
 	:degr +1
@@ -376,32 +299,19 @@
 	:strt :gnrt
 	:orgn '(kz1-rdct-h))))
 
+
 (DEFUN KZ1-RDCT ()
   (the reduction
-     (build-rdct
+       (build-rdct
         :f (kz1-rdct-f)
 	:g (kz1-rdct-g)
 	:h (kz1-rdct-h)
 	:orgn '(kz1-rdct))))
 
-#|
-  (pre-check-rdct (kz1-rdct))
-  (setf *tc* (cmbn 0 1 '()))
-  (setf *bc* (cmbn 0 1 '*))
-  (check-rdct)
-  (setf *tc* (cmbn 1 1 '(-4) 10 '(-1) 100 '(1) 1000 '(5)))
-  (setf *bc* (cmbn 1 1 's1))
-  (check-rdct)
-  (setf *tc* (cmbn 2 1 '(-4 2) 10 '(-1 3) 100 '(1 -4) 1000 '(5 5)))
-  (check-rdct)
-  (setf *tc* (cmbn 3 1 '(-4 -4 5) 10 '(-1 2 1)
-                     100 '(1 4 2) 1000 '(5 1 -1)))
-  (check-rdct)
-|#
 
 (DEFUN KZ1-EFHM ()
   (the homotopy-equivalence
-     (build-hmeq
+       (build-hmeq
         :lrdct (trivial-rdct (k-z-1))
 	:rrdct (kz1-rdct)
 	:orgn '(kz1-efhm))))
@@ -410,41 +320,40 @@
   (declare (ignore k-z-1))
   (kz1-efhm))
 
-#|
-  (cat-init)
-  (homology (k-z-1) 1)
-|#
 
 (DEFUN K-Z2-1-GRML-INTR (dmns crpr)
   (declare
-     (fixnum dmns)
-     (type crpr crpr))
+   (fixnum dmns)
+   (type crpr crpr))
   (the absm
-     (with-crpr (dgop1 gmsm1 dgop2 gmsm2) crpr
-	(declare (ignore gmsm1 gmsm2))
-	(let ((dgop (- (mask dmns) (logxor dgop1 dgop2))))
-	  (declare (fixnum dgop))
-	  (absm dgop (- dmns (logcount dgop)))))))
+       (with-crpr (dgop1 gmsm1 dgop2 gmsm2) crpr
+		  (declare (ignore gmsm1 gmsm2))
+		  (let ((dgop (- (mask dmns) (logxor dgop1 dgop2))))
+		    (declare (fixnum dgop))
+		    (absm dgop (- dmns (logcount dgop)))))))
+
 
 (DEFUN K-Z2-1-GRML ()
   (the simplicial-mrph
-     (build-smmr
+       (build-smmr
         :sorc (crts-prdc (r-proj-space) (r-proj-space))
 	:trgt (r-proj-space)
 	:degr 0
 	:sintr #'k-z2-1-grml-intr
 	:orgn '(k-z2-1-grml))))
 
+
 (DEFUN K-Z2-1-GRIN-INTR (dmns gmsm)
   (declare
-     (ignore dmns)
-     (fixnum gmsm))
+   (ignore dmns)
+   (fixnum gmsm))
   (the absm
-     (absm 0 gmsm)))
+       (absm 0 gmsm)))
+
 
 (DEFUN K-Z2-1-GRIN ()
   (the simplicial-mrph
-     (build-smmr
+       (build-smmr
         :sorc (r-proj-space)
 	:trgt (r-proj-space)
 	:degr 0
@@ -453,69 +362,57 @@
 	:strt :cmbn
 	:orgn '(k-z2-1-grin))))
 
+
 (DEFUN K-Z2-1 ()
   (the ab-simplicial-group
-     (let ((rslt (r-proj-space)))
-       (declare (type simplicial-set rslt))
-       (change-class rslt 'ab-simplicial-group)
-       (setf (slot-value rslt 'grml)
-	     (k-z2-1-grml)
-	     (slot-value rslt 'grin)
-	     (k-z2-1-grin))
-       (pushnew rslt *smgr-list*)
-       rslt)))
+       (let ((rslt (r-proj-space)))
+	 (declare (type simplicial-set rslt))
+	 (change-class rslt 'ab-simplicial-group)
+	 (setf (slot-value rslt 'grml)
+	       (k-z2-1-grml)
+	       (slot-value rslt 'grin)
+	       (k-z2-1-grin))
+	 (pushnew rslt *smgr-list*)
+	 rslt)))
 
-#|
-  (setf k (k-z2-1))
-  (homology k 0 4)
-|#
 
 (DEFUN K-Z2 (n)
-   (declare (fixnum n))
-   (the ab-simplicial-group
-      (if (= n 1)
-         (k-z2-1)
-         (classifying-space (k-z2 (1- n))))))
+  (declare (fixnum n))
+  (the ab-simplicial-group
+       (if (= n 1)
+	   (k-z2-1)
+	   (classifying-space (k-z2 (1- n))))))
 
-#|
-  (setf k3 (k-z2 3))
-  (homology k3 7)
-|#
 
 (DEFUN Z2-ABSM-BAR (absm)
   (declare (type absm absm))
   (the list
-     (with-absm (dgop gmsm) absm
-       (do ((bmark (1- (+ (logcount dgop) gmsm)) (1- bmark))
-	    (rslt +empty-list+
-		  (cons (if (logbitp bmark dgop)
-			    0 1)
-			rslt)))
-	   ((minusp bmark) rslt)
-	  (declare
-	     (fixnum bmark)
-	     (list rslt))))))
+       (with-absm (dgop gmsm) absm
+		  (do ((bmark (1- (+ (logcount dgop) gmsm)) (1- bmark))
+		       (rslt +empty-list+
+			     (cons (if (logbitp bmark dgop)
+				       0 1)
+				   rslt)))
+		      ((minusp bmark) rslt)
+		    (declare
+		     (fixnum bmark)
+		     (list rslt))))))
+
 
 (DEFUN Z2-BAR-ABSM (bar)
   (declare (list bar))
   (the absm
-     (do ((dgop 0)
-	  (2-pwr 1 (+ 2-pwr 2-pwr))
-	  (gmsm 0)
-	  (mark bar (cdr mark)))
-	 ((endp mark) (absm dgop gmsm))
-	(declare
-	   (fixnum dgop 2-pwr gmsm)
-	   (list mark))
-	(if (zerop (car mark))
-	   (incf dgop 2-pwr)
-	   (incf gmsm)))))
-
-#|
-  (dotimes (i 8)    ;;; not really legal
-  (dotimes (j 8)
-    (print (z2-bar-absm (z2-absm-bar (absm i j))))))
-|#
+       (do ((dgop 0)
+	    (2-pwr 1 (+ 2-pwr 2-pwr))
+	    (gmsm 0)
+	    (mark bar (cdr mark)))
+	   ((endp mark) (absm dgop gmsm))
+	 (declare
+	  (fixnum dgop 2-pwr gmsm)
+	  (list mark))
+	 (if (zerop (car mark))
+	     (incf dgop 2-pwr)
+	     (incf gmsm)))))
 
 
 (DEFUN HOPF-FIBRATION-SINTR (n)
@@ -523,549 +420,486 @@
   (flet ((rslt (dmns gmsm)
 	   (declare (ignore dmns gmsm))
 	   (if (zerop n)
-	      (absm 1 +empty-list+)
-	      (absm 0 (list n)))))
-     (the sintr #'rslt)))
+	       (absm 1 +empty-list+)
+	       (absm 0 (list n)))))
+    (the sintr #'rslt)))
+
 
 (DEFUN HOPF-FIBRATION (n)
   (declare (fixnum n))
   (the simplicial-mrph
-     (build-smmr
+       (build-smmr
         :sorc (sphere 2)
 	:trgt (k-z-1)
 	:degr -1
 	:sintr (hopf-fibration-sintr n)
 	:orgn `(hopf-fibration ,n))))
 
-(DEFUN Z-FUNDAMENTAL-GMSM (dmns pi-elm)   ;;; pi-elm not equal to 0
-   (declare (fixnum dmns pi-elm))
-   (the gmsm
-      (if (= 1 dmns)
-         (list pi-elm)
-         (let ((bspn (if (= 2 dmns) +empty-list+ +null-gbar+)))
-            (declare (type gmsm bspn))
-            (make-gbar :dmns dmns
-               :list (cons (absm 0 (z-fundamental-gmsm (1- dmns) pi-elm))
-                        (mapcar
-                           #'(lambda (k)
-                                (declare (fixnum k))
-                                (absm (mask k) bspn))
-                           (nreverse (<a-b> 0 (- dmns 2))))))))))
 
-#|
-  (z-fundamental-gmsm 1 33)
-  (z-fundamental-gmsm 2 33)
-  (z-fundamental-gmsm 3 33)
-  (z-fundamental-gmsm 4 33)
-|#
+(DEFUN Z-FUNDAMENTAL-GMSM (dmns pi-elm)   ;;; pi-elm not equal to 0
+  (declare (fixnum dmns pi-elm))
+  (the gmsm
+       (if (= 1 dmns)
+	   (list pi-elm)
+	   (let ((bspn (if (= 2 dmns) +empty-list+ +null-gbar+)))
+	     (declare (type gmsm bspn))
+	     (make-gbar :dmns dmns
+			:list (cons (absm 0 (z-fundamental-gmsm (1- dmns)
+								pi-elm))
+				    (mapcar
+				     #'(lambda (k)
+					 (declare (fixnum k))
+					 (absm (mask k) bspn))
+				     (nreverse (<a-b> 0 (- dmns 2))))))))))
+
 
 (DEFUN INTERESTING-FACES (face small-dmns high-dmns gmsm)
   (declare
-    (type face face)
-    (fixnum small-dmns high-dmns)
-    (type gmsm gmsm))
+   (type face face)
+   (fixnum small-dmns high-dmns)
+   (type gmsm gmsm))
   (the list
-    (let ((max (mask high-dmns)))
-      (declare (fixnum max))
-      (if (= small-dmns high-dmns)
-	 (list (cons max (absm 0 gmsm)))
-	 (do ((prev-list (interesting-faces face (1+ small-dmns) high-dmns gmsm))
-	      (k (1- max) (1- k))
-	      (rslt +empty-list+)
-	      (count (binomial-n-p high-dmns small-dmns)))
-	     ((zerop count) rslt)
-	     (declare
-	       (list prev-list rslt)
-	       (fixnum k count))
-	    (when (= small-dmns (logcount k))
-	      (decf count)
-	      (do ((i 0 (1+ i)))
-	          ((not (logbitp i k))
-		   (push (cons k
-			       (a-face4 face
-					(- small-dmns -1
-					   (if (= i (integer-length k)) (1+ i) i))
-					(1+ small-dmns)
-					(cdr (assoc (+ k (2-exp i)) prev-list))))
-			 rslt)))))))))
+       (let ((max (mask high-dmns)))
+	 (declare (fixnum max))
+	 (if (= small-dmns high-dmns)
+	     (list (cons max (absm 0 gmsm)))
+	     (do ((prev-list (interesting-faces face (1+ small-dmns) high-dmns
+						gmsm))
+		  (k (1- max) (1- k))
+		  (rslt +empty-list+)
+		  (count (binomial-n-p high-dmns small-dmns)))
+		 ((zerop count) rslt)
+	       (declare
+		(list prev-list rslt)
+		(fixnum k count))
+	       (when (= small-dmns (logcount k))
+		 (decf count)
+		 (do ((i 0 (1+ i)))
+		     ((not (logbitp i k))
+		      (push (cons k
+				  (a-face4 face
+					   (- small-dmns -1
+					      (if (= i (integer-length k))
+						  (1+ i)
+						  i))
+					   (1+ small-dmns)
+					   (cdr (assoc (+ k (2-exp i))
+						       prev-list))))
+			    rslt)))))))))
 
-#|
-  (setf d (delta 14))
-  (setf f (face d))
-  (do ((i 5 (1- i)))
-      ((minusp i))
-    (print (interesting-faces f i 5 (mask 6))))
-|#     
 
 (DEFUN GMSM-COCYCLE (face small-dmns high-dmns gmsm chml-clss)
   (declare
-    (type face face)
-    (fixnum small-dmns high-dmns)
-    (type gmsm gmsm)
-    (type morphism chml-clss))
+   (type face face)
+   (fixnum small-dmns high-dmns)
+   (type gmsm gmsm)
+   (type morphism chml-clss))
   (the list
-    (let ((int-faces (interesting-faces face small-dmns high-dmns gmsm)))
-      (declare (list int-faces))
-      (mapc
-        #'(lambda (cons)
-	    (declare (cons cons))
-	    (setf (cdr cons)
-		  (let ((absm (cdr cons)))
-		    (declare (type absm absm))
-		    (with-absm (dgop gmsm2) absm
-		      (if (plusp dgop)
-			 0
-			(let ((cmbn-list (cmbn-list (gnrt-? chml-clss
-						 small-dmns gmsm2))))
-			  (declare (list cmbn-list))
-			  (if cmbn-list
-			      (-cffc cmbn-list)
-			    0)))))))
-        int-faces)
-      int-faces)))
+       (let ((int-faces (interesting-faces face small-dmns high-dmns gmsm)))
+	 (declare (list int-faces))
+	 (mapc
+	  #'(lambda (cons)
+	      (declare (cons cons))
+	      (setf (cdr cons)
+		    (let ((absm (cdr cons)))
+		      (declare (type absm absm))
+		      (with-absm (dgop gmsm2) absm
+				 (if (plusp dgop)
+				     0
+				     (let ((cmbn-list
+					    (cmbn-list (gnrt-? chml-clss
+							       small-dmns
+							       gmsm2))))
+				       (declare (list cmbn-list))
+				       (if cmbn-list
+					   (-cffc cmbn-list)
+					   0)))))))
+	  int-faces)
+	 int-faces)))
 
-#|
-  (cat-init)
-  (setf d (delta 10))
-  (setf chml-clss
-    (build-mrph :sorc d :trgt (z-chcm) :degr -2
-                :intr #'(lambda (dmns gmsm)
-                          (term-cmbn 0 gmsm :gnrt-z))
-                :strt :gnrt
-                :orgn '(essai-1)))
-  (gmsm-cocycle (face d) 2 4 31 chml-clss)
-  (setf chml-clss
-    (build-mrph :sorc d :trgt (z-chcm) :degr -1
-                :intr #'(lambda (dmns gmsm)
-                          (term-cmbn 0 gmsm :gnrt-z))
-                :strt :gnrt
-                :orgn '(essai-2)))
-  (gmsm-cocycle (face d) 1 4 31 chml-clss)
-|#
 
 (DEFUN Z-COCYCLE-GBAR (n dmns cocycle)
   ;; cocycle \in Z^n(\Delta^{dmns}, \pi) with \pi = Z
   (declare
-    (fixnum n dmns)
-    (list cocycle))
+   (fixnum n dmns)
+   (list cocycle))
   (the absm
-    (cond ((= n 1)
-	   (z-bar-absm (nreverse (mapcar #'cdr cocycle))))
-	  ((= n dmns)
-	   (let ((value (cdr (first cocycle))))
-	     (declare (fixnum value))
-	     (if (zerop value)
-		(absm (mask dmns) +null-gbar+)
-	        (absm 0 (z-fundamental-gmsm dmns value)))))
-	  (t
-	   (let ((cocycle1 +empty-list+)
-		 (cocycle2 +empty-list+))
-	     (declare (list cocycle1 cocycle2))
-	     (dolist (cons cocycle)
-	       (declare (cons cons))
-	       (if (evenp (car cons))
-		  (push (cons (ash (car cons) -1) (cdr cons))
-			cocycle1)
-		  (push (cons (ash (car cons) -1) (cdr cons))
-			cocycle2)))
-	     (setf cocycle1 (nreverse cocycle1)
-		   cocycle2 (nreverse cocycle2))
-	     (mapc
-	       #'(lambda (cons)
-		   (declare (cons cons))
-		   (when (evenp (car cons))
-		     (decf (cdr cons)
-			   (cdr (assoc (1+ (car cons)) cocycle1)))))
-	       cocycle2)
-	     (let ((head-absm (z-cocycle-gbar (1- n) (1- dmns) cocycle2))
-		   (tail-absm (z-cocycle-gbar n (1- dmns) cocycle1)))
-	       (declare (type absm head-absm tail-absm))
-	       (normalize-gbar
-		 (cons dmns
-		       (cons head-absm
-			     (rest (unnormalize-gbar tail-absm
-				     (if (= n 2) () +null-gbar+))))))))))))
+       (cond ((= n 1)
+	      (z-bar-absm (nreverse (mapcar #'cdr cocycle))))
+	     ((= n dmns)
+	      (let ((value (cdr (first cocycle))))
+		(declare (fixnum value))
+		(if (zerop value)
+		    (absm (mask dmns) +null-gbar+)
+		    (absm 0 (z-fundamental-gmsm dmns value)))))
+	     (t
+	      (let ((cocycle1 +empty-list+)
+		    (cocycle2 +empty-list+))
+		(declare (list cocycle1 cocycle2))
+		(dolist (cons cocycle)
+		  (declare (cons cons))
+		  (if (evenp (car cons))
+		      (push (cons (ash (car cons) -1) (cdr cons))
+			    cocycle1)
+		      (push (cons (ash (car cons) -1) (cdr cons))
+			    cocycle2)))
+		(setf cocycle1 (nreverse cocycle1)
+		      cocycle2 (nreverse cocycle2))
+		(mapc
+		 #'(lambda (cons)
+		     (declare (cons cons))
+		     (when (evenp (car cons))
+		       (decf (cdr cons)
+			     (cdr (assoc (1+ (car cons)) cocycle1)))))
+		 cocycle2)
+		(let ((head-absm (z-cocycle-gbar (1- n) (1- dmns) cocycle2))
+		      (tail-absm (z-cocycle-gbar n (1- dmns) cocycle1)))
+		  (declare (type absm head-absm tail-absm))
+		  (normalize-gbar
+		   (cons dmns
+			 (cons head-absm
+			       (rest (unnormalize-gbar
+				      tail-absm
+				      (if (= n 2) () +null-gbar+))))))))))))
 
-#|
-  (cat-init)
-  (setf d (delta 10))
-  (setf chml-clss
-    (build-mrph :sorc d :trgt (z-chcm) :degr -1
-                :intr #'(lambda (dmns gmsm)
-                          (term-cmbn 0 gmsm :gnrt-z))
-                :strt :gnrt
-                :orgn '(essai-1)))
-  (gmsm-cocycle (face d) 1 4 31 chml-clss)
-  (z-cocycle-gbar 1 4 *)
-  (setf chml-clss
-    (build-mrph :sorc d :trgt (z-chcm) :degr -2
-                :intr #'(lambda (dmns gmsm)
-                          (term-cmbn 0 gmsm :gnrt-z))
-                :strt :gnrt
-                :orgn '(essai-2)))
-  (gmsm-cocycle (face d) 2 2 7 chml-clss)
-  (z-cocycle-gbar 2 2 *)
-  (gmsm-cocycle (face d) 2 2 0 chml-clss) ;; normally illegal
-  (z-cocycle-gbar 2 2 *)
-  (gmsm-cocycle (face d) 2 3 15 chml-clss)
-  (z-cocycle-gbar 2 3 *)
-  (gmsm-cocycle (face d) 2 4 31 chml-clss)
-  (z-cocycle-gbar 2 4 *)
-  (setf chml-clss
-    (build-mrph :sorc d :trgt (z-chcm) :degr -3
-                :intr #'(lambda (dmns gmsm)
-                          (term-cmbn 0 gmsm :gnrt-z))
-                :strt :gnrt
-                :orgn '(essai-3)))
-  (gmsm-cocycle (face d) 3 4 31 chml-clss)
-  (z-cocycle-gbar 3 4 *)
-  (setf chml-clss
-    (build-mrph :sorc d :trgt (z-chcm) :degr -3
-                :intr #'(lambda (dmns gmsm)
-                          (zero-cmbn 0))
-                :strt :gnrt
-                :orgn '(essai-33)))
-  (gmsm-cocycle (face d) 3 4 31 chml-clss)
-  (z-cocycle-gbar 3 4 *)
-|#
 
 (DEFUN Z-COCYCLE-GBAR-HEAD (n dmns cocycle)
   ;; cocycle \in Z^n(\Delta^{dmns}, \pi) with \pi = Z
   (declare
-    (fixnum n dmns)
-    (list cocycle))
+   (fixnum n dmns)
+   (list cocycle))
   (the absm
-    (cond ((= n 1)
-	   (error "In Z-COCYCLE-GBAR-HEAD, this point should not have been reached."))
-	   ; (z-bar-absm (nreverse (mapcar #'cdr cocycle))))
-	  ((= n dmns)
-	   (let ((value (cdr (first cocycle))))
-	     (declare (fixnum value))
-	     (if (zerop value)
-		(if (= n 2)
-		   (absm 1 +empty-list+)
-		   (absm (mask (1- dmns)) +null-gbar+))
-	       (absm 0 (z-fundamental-gmsm (1- dmns) value)))))
-	  (t
-	   (let ((cocycle1 +empty-list+)
-		 (cocycle2 +empty-list+))
-	     (declare (list cocycle1 cocycle2))
-	     (dolist (cons cocycle)
-	       (declare (cons cons))
-	       (if (evenp (car cons))
-		  (push (cons (ash (car cons) -1) (cdr cons))
-			cocycle1)
-		  (push (cons (ash (car cons) -1) (cdr cons))
-			cocycle2)))
-	     (setf cocycle1 (nreverse cocycle1)
-		   cocycle2 (nreverse cocycle2))
-	     (mapc
-	       #'(lambda (cons)
-		   (declare (cons cons))
-		   (when (evenp (car cons))
-		     (decf (cdr cons)
-			   (cdr (assoc (1+ (car cons)) cocycle1)))))
-	       cocycle2)
-	     (z-cocycle-gbar (1- n) (1- dmns) cocycle2))))))
+       (cond ((= n 1)
+	      (error "In Z-COCYCLE-GBAR-HEAD, this point should not have been reached."))
+	     ;; (z-bar-absm (nreverse (mapcar #'cdr cocycle))))
+	     ((= n dmns)
+	      (let ((value (cdr (first cocycle))))
+		(declare (fixnum value))
+		(if (zerop value)
+		    (if (= n 2)
+			(absm 1 +empty-list+)
+			(absm (mask (1- dmns)) +null-gbar+))
+		    (absm 0 (z-fundamental-gmsm (1- dmns) value)))))
+	     (t
+	      (let ((cocycle1 +empty-list+)
+		    (cocycle2 +empty-list+))
+		(declare (list cocycle1 cocycle2))
+		(dolist (cons cocycle)
+		  (declare (cons cons))
+		  (if (evenp (car cons))
+		      (push (cons (ash (car cons) -1) (cdr cons))
+			    cocycle1)
+		      (push (cons (ash (car cons) -1) (cdr cons))
+			    cocycle2)))
+		(setf cocycle1 (nreverse cocycle1)
+		      cocycle2 (nreverse cocycle2))
+		(mapc
+		 #'(lambda (cons)
+		     (declare (cons cons))
+		     (when (evenp (car cons))
+		       (decf (cdr cons)
+			     (cdr (assoc (1+ (car cons)) cocycle1)))))
+		 cocycle2)
+		(z-cocycle-gbar (1- n) (1- dmns) cocycle2))))))
 
 #|
-  (cat-init)
-  (setf d (delta 10))
-  (setf chml-clss
-    (build-mrph :sorc d :trgt (z-chcm) :degr -1
-                :intr #'(lambda (dmns gmsm)
-                          (term-cmbn 0 gmsm :gnrt-z))
-                :strt :gnrt
-                :orgn '(essai-1)))
-  (gmsm-cocycle (face d) 1 4 31 chml-clss)
-  (z-cocycle-gbar 1 4 *)
-  (z-cocycle-gbar-head 1 4 **)
-  (setf chml-clss
-    (build-mrph :sorc d :trgt (z-chcm) :degr -2
-                :intr #'(lambda (dmns gmsm)
-                          (term-cmbn 0 gmsm :gnrt-z))
-                :strt :gnrt
-                :orgn '(essai-2)))
-  (gmsm-cocycle (face d) 2 2 7 chml-clss)
-  (z-cocycle-gbar 2 2 *)
-  (z-cocycle-gbar-head 2 2 **)
-  (gmsm-cocycle (face d) 2 2 0 chml-clss) ;; normally illegal
-  (z-cocycle-gbar 2 2 *)
-  (z-cocycle-gbar-head 2 2 **)
-  (gmsm-cocycle (face d) 2 3 15 chml-clss)
-  (z-cocycle-gbar 2 3 *)
-  (z-cocycle-gbar-head 2 3 **)
-  (gmsm-cocycle (face d) 2 4 31 chml-clss)
-  (z-cocycle-gbar 2 4 *)
-  (z-cocycle-gbar-head 2 4 **)
-  (setf chml-clss
-    (build-mrph :sorc d :trgt (z-chcm) :degr -3
-                :intr #'(lambda (dmns gmsm)
-                          (term-cmbn 0 gmsm :gnrt-z))
-                :strt :gnrt
-                :orgn '(essai-3)))
-  (gmsm-cocycle (face d) 3 4 31 chml-clss)
-  (z-cocycle-gbar 3 4 *)
-  (z-cocycle-gbar-head 3 4 **)
-  (setf chml-clss
-    (build-mrph :sorc d :trgt (z-chcm) :degr -3
-                :intr #'(lambda (dmns gmsm)
-                          (zero-cmbn 0))
-                :strt :gnrt
-                :orgn '(essai-33)))
-  (gmsm-cocycle (face d) 3 4 31 chml-clss)
-  (z-cocycle-gbar 3 4 *)
-  (z-cocycle-gbar-head 3 4 **)
+(cat-init)
+(setf d (delta 10))
+(setf chml-clss
+      (build-mrph :sorc d :trgt (z-chcm) :degr -1
+		  :intr #'(lambda (dmns gmsm)
+			    (term-cmbn 0 gmsm :gnrt-z))
+		  :strt :gnrt
+		  :orgn '(essai-1)))
+(gmsm-cocycle (face d) 1 4 31 chml-clss)
+(z-cocycle-gbar 1 4 *)
+(z-cocycle-gbar-head 1 4 **)
+(setf chml-clss
+      (build-mrph :sorc d :trgt (z-chcm) :degr -2
+		  :intr #'(lambda (dmns gmsm)
+			    (term-cmbn 0 gmsm :gnrt-z))
+		  :strt :gnrt
+		  :orgn '(essai-2)))
+(gmsm-cocycle (face d) 2 2 7 chml-clss)
+(z-cocycle-gbar 2 2 *)
+(z-cocycle-gbar-head 2 2 **)
+(gmsm-cocycle (face d) 2 2 0 chml-clss) ;; normally illegal
+(z-cocycle-gbar 2 2 *)
+(z-cocycle-gbar-head 2 2 **)
+(gmsm-cocycle (face d) 2 3 15 chml-clss)
+(z-cocycle-gbar 2 3 *)
+(z-cocycle-gbar-head 2 3 **)
+(gmsm-cocycle (face d) 2 4 31 chml-clss)
+(z-cocycle-gbar 2 4 *)
+(z-cocycle-gbar-head 2 4 **)
+(setf chml-clss
+      (build-mrph :sorc d :trgt (z-chcm) :degr -3
+		  :intr #'(lambda (dmns gmsm)
+			    (term-cmbn 0 gmsm :gnrt-z))
+		  :strt :gnrt
+		  :orgn '(essai-3)))
+(gmsm-cocycle (face d) 3 4 31 chml-clss)
+(z-cocycle-gbar 3 4 *)
+(z-cocycle-gbar-head 3 4 **)
+(setf chml-clss
+      (build-mrph :sorc d :trgt (z-chcm) :degr -3
+		  :intr #'(lambda (dmns gmsm)
+			    (zero-cmbn 0))
+		  :strt :gnrt
+		  :orgn '(essai-33)))
+(gmsm-cocycle (face d) 3 4 31 chml-clss)
+(z-cocycle-gbar 3 4 *)
+(z-cocycle-gbar-head 3 4 **)
 |#
 
 (DEFUN Z2-FUNDAMENTAL-GMSM (dmns pi-elm)  ;; pi-elm not "equal" to 0, therefore 1.
-   (declare (fixnum dmns pi-elm))
-   (the gmsm
-      (if (= 1 dmns)
-         1
-         (let ((bspn (if (= 2 dmns) 0 +null-gbar+)))
-            (declare (type gmsm bspn))
-            (make-gbar :dmns dmns
-               :list (cons (absm 0 (Z2-fundamental-gmsm (1- dmns) pi-elm))
-                        (mapcar
-                           #'(lambda (k)
-                                (declare (fixnum k))
-                                (absm (mask k) bspn))
-                           (nreverse (<a-b> 0 (- dmns 2))))))))))
+  (declare (fixnum dmns pi-elm))
+  (the gmsm
+       (if (= 1 dmns)
+	   1
+	   (let ((bspn (if (= 2 dmns) 0 +null-gbar+)))
+	     (declare (type gmsm bspn))
+	     (make-gbar :dmns dmns
+			:list (cons (absm 0 (Z2-fundamental-gmsm (1- dmns) pi-elm))
+				    (mapcar
+				     #'(lambda (k)
+					 (declare (fixnum k))
+					 (absm (mask k) bspn))
+				     (nreverse (<a-b> 0 (- dmns 2))))))))))
 
 #|
-  (Z2-fundamental-gmsm 1 1)
-  (Z2-fundamental-gmsm 2 1)
-  (Z2-fundamental-gmsm 3 1)
-  (Z2-fundamental-gmsm 4 1)
+(Z2-fundamental-gmsm 1 1)
+(Z2-fundamental-gmsm 2 1)
+(Z2-fundamental-gmsm 3 1)
+(Z2-fundamental-gmsm 4 1)
 |#    
 
 (DEFUN Z2-COCYCLE-GBAR (n dmns cocycle)
   ;; cocycle \in Z^n(\Delta^{dmns}, \pi) with \pi = Z/2Z
   (declare
-    (fixnum n dmns)
-    (list cocycle))
+   (fixnum n dmns)
+   (list cocycle))
   (the absm
-    (progn
-      (mapc
-        #'(lambda (cons)
-	    (declare (cons cons))
-	    (setf (cdr cons)
-		  (if (evenp (cdr cons)) 0 1)))
-        cocycle)
-      (cond ((= n 1)
-	     (z2-bar-absm (nreverse (mapcar #'cdr cocycle))))
-	    ((= n dmns)
-	     (let ((value (cdr (first cocycle))))
-	       (declare (fixnum value))
-	       (if (zerop value)
-		   (absm (mask dmns) +null-gbar+)
-		 (absm 0 (z2-fundamental-gmsm dmns value)))))
-	    (t
-	     (let ((cocycle1 +empty-list+)
-		   (cocycle2 +empty-list+))
-	       (declare (list cocycle1 cocycle2))
-	       (dolist (cons cocycle)
-		 (declare (cons cons))
-		 (if (evenp (car cons))
-		     (push (cons (ash (car cons) -1) (cdr cons))
-			   cocycle1)
-		   (push (cons (ash (car cons) -1) (cdr cons))
-			 cocycle2)))
-	       (setf cocycle1 (nreverse cocycle1)
-		     cocycle2 (nreverse cocycle2))
-	       (mapc
-		#'(lambda (cons)
+       (progn
+	 (mapc
+	  #'(lambda (cons)
+	      (declare (cons cons))
+	      (setf (cdr cons)
+		    (if (evenp (cdr cons)) 0 1)))
+	  cocycle)
+	 (cond ((= n 1)
+		(z2-bar-absm (nreverse (mapcar #'cdr cocycle))))
+	       ((= n dmns)
+		(let ((value (cdr (first cocycle))))
+		  (declare (fixnum value))
+		  (if (zerop value)
+		      (absm (mask dmns) +null-gbar+)
+		      (absm 0 (z2-fundamental-gmsm dmns value)))))
+	       (t
+		(let ((cocycle1 +empty-list+)
+		      (cocycle2 +empty-list+))
+		  (declare (list cocycle1 cocycle2))
+		  (dolist (cons cocycle)
 		    (declare (cons cons))
-		    (when (evenp (car cons))
-			  (setf (cdr cons)
-				(mod (- (cdr cons)
-					(cdr (assoc (1+ (car cons)) cocycle1)))
-				     2))))
-		cocycle2)
-	       (let ((head-absm (z2-cocycle-gbar (1- n) (1- dmns) cocycle2))
-		     (tail-absm (z2-cocycle-gbar n (1- dmns) cocycle1)))
-		 (declare (type absm head-absm tail-absm))
-		 (normalize-gbar
-		  (cons dmns
-			(cons head-absm
-			      (rest (unnormalize-gbar tail-absm
-						      (if (= n 2) 0 +null-gbar+)))))))))))))
+		    (if (evenp (car cons))
+			(push (cons (ash (car cons) -1) (cdr cons))
+			      cocycle1)
+			(push (cons (ash (car cons) -1) (cdr cons))
+			      cocycle2)))
+		  (setf cocycle1 (nreverse cocycle1)
+			cocycle2 (nreverse cocycle2))
+		  (mapc
+		   #'(lambda (cons)
+		       (declare (cons cons))
+		       (when (evenp (car cons))
+			 (setf (cdr cons)
+			       (mod (- (cdr cons)
+				       (cdr (assoc (1+ (car cons)) cocycle1)))
+				    2))))
+		   cocycle2)
+		  (let ((head-absm (z2-cocycle-gbar (1- n) (1- dmns) cocycle2))
+			(tail-absm (z2-cocycle-gbar n (1- dmns) cocycle1)))
+		    (declare (type absm head-absm tail-absm))
+		    (normalize-gbar
+		     (cons dmns
+			   (cons head-absm
+				 (rest (unnormalize-gbar tail-absm
+							 (if (= n 2) 0 +null-gbar+)))))))))))))
 
 #|
-  (cat-init)
-  (setf d (delta 10))
-  (setf chml-clss
-    (build-mrph :sorc d :trgt (z-chcm) :degr -1
-                :intr #'(lambda (dmns gmsm)
-                          (term-cmbn 0 (mod gmsm 2) :gnrt-z))
-                :strt :gnrt
-                :orgn '(essai-1)))
-  (gmsm-cocycle (face d) 1 4 31 chml-clss)
-  (z2-cocycle-gbar 1 4 *)
-  (setf chml-clss
-    (build-mrph :sorc d :trgt (z-chcm) :degr -2
-                :intr #'(lambda (dmns gmsm)
-                          (term-cmbn 0 (mod gmsm 2) :gnrt-z))
-                :strt :gnrt
-                :orgn '(essai-2)))
-  (gmsm-cocycle (face d) 2 2 7 chml-clss)
-  (z2-cocycle-gbar 2 2 *)
-  (gmsm-cocycle (face d) 2 2 0 chml-clss) ;; normally illegal
-  (z2-cocycle-gbar 2 2 *)
-  (gmsm-cocycle (face d) 2 3 15 chml-clss)
-  (z2-cocycle-gbar 2 3 *)
-  (gmsm-cocycle (face d) 2 4 31 chml-clss)
-  (z2-cocycle-gbar 2 4 *)
-  (setf chml-clss
-    (build-mrph :sorc d :trgt (z-chcm) :degr -3
-                :intr #'(lambda (dmns gmsm)
-                          (term-cmbn 0 (mod gmsm 2) :gnrt-z))
-                :strt :gnrt
-                :orgn '(essai-3)))
-  (gmsm-cocycle (face d) 3 4 31 chml-clss)
-  (z2-cocycle-gbar 3 4 *)
+(cat-init)
+(setf d (delta 10))
+(setf chml-clss
+      (build-mrph :sorc d :trgt (z-chcm) :degr -1
+		  :intr #'(lambda (dmns gmsm)
+			    (term-cmbn 0 (mod gmsm 2) :gnrt-z))
+		  :strt :gnrt
+		  :orgn '(essai-1)))
+(gmsm-cocycle (face d) 1 4 31 chml-clss)
+(z2-cocycle-gbar 1 4 *)
+(setf chml-clss
+      (build-mrph :sorc d :trgt (z-chcm) :degr -2
+		  :intr #'(lambda (dmns gmsm)
+			    (term-cmbn 0 (mod gmsm 2) :gnrt-z))
+		  :strt :gnrt
+		  :orgn '(essai-2)))
+(gmsm-cocycle (face d) 2 2 7 chml-clss)
+(z2-cocycle-gbar 2 2 *)
+(gmsm-cocycle (face d) 2 2 0 chml-clss) ;; normally illegal
+(z2-cocycle-gbar 2 2 *)
+(gmsm-cocycle (face d) 2 3 15 chml-clss)
+(z2-cocycle-gbar 2 3 *)
+(gmsm-cocycle (face d) 2 4 31 chml-clss)
+(z2-cocycle-gbar 2 4 *)
+(setf chml-clss
+      (build-mrph :sorc d :trgt (z-chcm) :degr -3
+		  :intr #'(lambda (dmns gmsm)
+			    (term-cmbn 0 (mod gmsm 2) :gnrt-z))
+		  :strt :gnrt
+		  :orgn '(essai-3)))
+(gmsm-cocycle (face d) 3 4 31 chml-clss)
+(z2-cocycle-gbar 3 4 *)
 |#
 
 (DEFUN Z2-COCYCLE-GBAR-HEAD (n dmns cocycle)
   ;; cocycle \in Z^n(\Delta^{dmns}, \pi) with \pi = Z/2Z
   (declare
-    (fixnum n dmns)
-    (list cocycle))
+   (fixnum n dmns)
+   (list cocycle))
   (the absm
-    (progn
-      (mapc
-        #'(lambda (cons)
-	    (setf (cdr cons)
-		  (if (evenp (cdr cons)) 0 1)))
-        cocycle)
-      (cond ((= n 1)
-	     (error "In Z2-COCYCLE-GBAR-HEAD, this point should not have been reached."))
-		 ; (z2-bar-absm (nreverse (mapcar #'cdr cocycle))))
-	    ((= n dmns)
-	     (let ((value (cdr (first cocycle))))
-	       (declare (fixnum value))
-	       (if (zerop value)
-		   (if (= n 2)
-		       (absm 1 0)
-		     (absm (mask (1- dmns)) +null-gbar+))
-		 (absm 0 (z2-fundamental-gmsm (1- dmns) value)))))
-	    (t
-	     (let ((cocycle1 +empty-list+)
-		   (cocycle2 +empty-list+))
-	       (declare (list cocycle1 cocycle2))
-	       (dolist (cons cocycle)
-		 (declare (cons cons))
-		 (if (evenp (car cons))
-		     (push (cons (ash (car cons) -1) (cdr cons))
-			   cocycle1)
-		   (push (cons (ash (car cons) -1) (cdr cons))
-			 cocycle2)))
-	       (setf cocycle1 (nreverse cocycle1)
-		     cocycle2 (nreverse cocycle2))
-	       (mapc
-		#'(lambda (cons)
+       (progn
+	 (mapc
+	  #'(lambda (cons)
+	      (setf (cdr cons)
+		    (if (evenp (cdr cons)) 0 1)))
+	  cocycle)
+	 (cond ((= n 1)
+		(error "In Z2-COCYCLE-GBAR-HEAD, this point should not have been reached."))
+					; (z2-bar-absm (nreverse (mapcar #'cdr cocycle))))
+	       ((= n dmns)
+		(let ((value (cdr (first cocycle))))
+		  (declare (fixnum value))
+		  (if (zerop value)
+		      (if (= n 2)
+			  (absm 1 0)
+			  (absm (mask (1- dmns)) +null-gbar+))
+		      (absm 0 (z2-fundamental-gmsm (1- dmns) value)))))
+	       (t
+		(let ((cocycle1 +empty-list+)
+		      (cocycle2 +empty-list+))
+		  (declare (list cocycle1 cocycle2))
+		  (dolist (cons cocycle)
 		    (declare (cons cons))
-		    (when (evenp (car cons))
-			  (setf (cdr cons)
-				(mod (- (cdr cons)
-					(cdr (assoc (1+ (car cons)) cocycle1)))
-				     2))))
-		cocycle2)
-	       (z2-cocycle-gbar (1- n) (1- dmns) cocycle2)))))))
+		    (if (evenp (car cons))
+			(push (cons (ash (car cons) -1) (cdr cons))
+			      cocycle1)
+			(push (cons (ash (car cons) -1) (cdr cons))
+			      cocycle2)))
+		  (setf cocycle1 (nreverse cocycle1)
+			cocycle2 (nreverse cocycle2))
+		  (mapc
+		   #'(lambda (cons)
+		       (declare (cons cons))
+		       (when (evenp (car cons))
+			 (setf (cdr cons)
+			       (mod (- (cdr cons)
+				       (cdr (assoc (1+ (car cons)) cocycle1)))
+				    2))))
+		   cocycle2)
+		  (z2-cocycle-gbar (1- n) (1- dmns) cocycle2)))))))
 
 #|
-  (cat-init)
-  (setf d (delta 10))
-  (setf chml-clss
-    (build-mrph :sorc d :trgt (z-chcm) :degr -1
-                :intr #'(lambda (dmns gmsm)
-                          (term-cmbn 0 (mod gmsm 2) :gnrt-z))
-                :strt :gnrt
-                :orgn '(essai-1)))
-  (gmsm-cocycle (face d) 1 4 31 chml-clss)
-  (z2-cocycle-gbar 1 4 *)
-  (z2-cocycle-gbar-head 1 4 **)
-  (setf chml-clss
-    (build-mrph :sorc d :trgt (z-chcm) :degr -2
-                :intr #'(lambda (dmns gmsm)
-                          (term-cmbn 0 (mod gmsm 2) :gnrt-z))
-                :strt :gnrt
-                :orgn '(essai-2)))
-  (gmsm-cocycle (face d) 2 2 7 chml-clss)
-  (z2-cocycle-gbar 2 2 *)
-  (z2-cocycle-gbar-head 2 2 **)
-  (gmsm-cocycle (face d) 2 2 0 chml-clss) ;; normally illegal
-  (z2-cocycle-gbar 2 2 *)
-  (z2-cocycle-gbar-head 2 2 **)
-  (gmsm-cocycle (face d) 2 3 15 chml-clss)
-  (z2-cocycle-gbar 2 3 *)
-  (z2-cocycle-gbar-head 2 3 **)
-  (gmsm-cocycle (face d) 2 4 31 chml-clss)
-  (z2-cocycle-gbar 2 4 *)
-  (z2-cocycle-gbar-head 2 4 **)
-  (setf chml-clss
-    (build-mrph :sorc d :trgt (z-chcm) :degr -3
-                :intr #'(lambda (dmns gmsm)
-                          (term-cmbn 0 (mod gmsm 2) :gnrt-z))
-                :strt :gnrt
-                :orgn '(essai-3)))
-  (gmsm-cocycle (face d) 3 4 31 chml-clss)
-  (z2-cocycle-gbar 3 4 *)
-  (z2-cocycle-gbar-head 3 4 **)
+(cat-init)
+(setf d (delta 10))
+(setf chml-clss
+      (build-mrph :sorc d :trgt (z-chcm) :degr -1
+		  :intr #'(lambda (dmns gmsm)
+			    (term-cmbn 0 (mod gmsm 2) :gnrt-z))
+		  :strt :gnrt
+		  :orgn '(essai-1)))
+(gmsm-cocycle (face d) 1 4 31 chml-clss)
+(z2-cocycle-gbar 1 4 *)
+(z2-cocycle-gbar-head 1 4 **)
+(setf chml-clss
+      (build-mrph :sorc d :trgt (z-chcm) :degr -2
+		  :intr #'(lambda (dmns gmsm)
+			    (term-cmbn 0 (mod gmsm 2) :gnrt-z))
+		  :strt :gnrt
+		  :orgn '(essai-2)))
+(gmsm-cocycle (face d) 2 2 7 chml-clss)
+(z2-cocycle-gbar 2 2 *)
+(z2-cocycle-gbar-head 2 2 **)
+(gmsm-cocycle (face d) 2 2 0 chml-clss) ;; normally illegal
+(z2-cocycle-gbar 2 2 *)
+(z2-cocycle-gbar-head 2 2 **)
+(gmsm-cocycle (face d) 2 3 15 chml-clss)
+(z2-cocycle-gbar 2 3 *)
+(z2-cocycle-gbar-head 2 3 **)
+(gmsm-cocycle (face d) 2 4 31 chml-clss)
+(z2-cocycle-gbar 2 4 *)
+(z2-cocycle-gbar-head 2 4 **)
+(setf chml-clss
+      (build-mrph :sorc d :trgt (z-chcm) :degr -3
+		  :intr #'(lambda (dmns gmsm)
+			    (term-cmbn 0 (mod gmsm 2) :gnrt-z))
+		  :strt :gnrt
+		  :orgn '(essai-3)))
+(gmsm-cocycle (face d) 3 4 31 chml-clss)
+(z2-cocycle-gbar 3 4 *)
+(z2-cocycle-gbar-head 3 4 **)
 |#
 
 (DEFUN K-Z-FUNDAMENTAL-CLASS (n)
   (declare (fixnum n))
   (the morphism
-    (build-mrph
-      :sorc (k-z n) :trgt (z-chcm) :degr (- n)
-      :intr #'(lambda (dmns gmsm)
-		(declare
-		  (fixnum dmns)
-		  (type gmsm gmsm))
-		(if (= dmns n)
-		   (do ((gmsm gmsm (gmsm (first (gbar-list gmsm))))
-			(dmns dmns (1- dmns)))
-		       ((= 1 dmns)
-			(term-cmbn 0 (first gmsm) :z-gnrt))
-		       (declare
+       (build-mrph
+	:sorc (k-z n) :trgt (z-chcm) :degr (- n)
+	:intr #'(lambda (dmns gmsm)
+		  (declare
+		   (fixnum dmns)
+		   (type gmsm gmsm))
+		  (if (= dmns n)
+		      (do ((gmsm gmsm (gmsm (first (gbar-list gmsm))))
+			   (dmns dmns (1- dmns)))
+			  ((= 1 dmns)
+			   (term-cmbn 0 (first gmsm) :z-gnrt))
+			(declare
 			 (type gmsm gmsm)
 			 (fixnum dmns)))
-		  (zero-cmbn (- dmns n))))
-      :strt :gnrt
-      :orgn `(k-z-fundamental-class ,n))))
+		      (zero-cmbn (- dmns n))))
+	:strt :gnrt
+	:orgn `(k-z-fundamental-class ,n))))
 
 #|
-  (cat-init)
-  (setf c1 (k-z-fundamental-class 1))
-  (? c1 1 '(34))
-  (? c1 2 '(34 45))
-  (setf c3 (k-z-fundamental-class 3))
-  (? c3 3 (z-fundamental-gmsm 3 45))
+(cat-init)
+(setf c1 (k-z-fundamental-class 1))
+(? c1 1 '(34))
+(? c1 2 '(34 45))
+(setf c3 (k-z-fundamental-class 3))
+(? c3 3 (z-fundamental-gmsm 3 45))
 |#
 
 (DEFUN K-Z2-FUNDAMENTAL-CLASS (n)
   (declare (fixnum n))
   (the morphism
-    (build-mrph
-      :sorc (k-z2 n) :trgt (z-chcm) :degr (- n)
-      :intr #'(lambda (dmns gmsm)
-		(declare
-		  (fixnum dmns)
-		  (ignore gmsm))
-		(if (= dmns n)
-		   (term-cmbn 0 1 :z-gnrt)
-		  (zero-cmbn (- dmns n))))
-      :strt :gnrt
-      :orgn `(k-z2-fundamental-class ,n))))
+       (build-mrph
+	:sorc (k-z2 n) :trgt (z-chcm) :degr (- n)
+	:intr #'(lambda (dmns gmsm)
+		  (declare
+		   (fixnum dmns)
+		   (ignore gmsm))
+		  (if (= dmns n)
+		      (term-cmbn 0 1 :z-gnrt)
+		      (zero-cmbn (- dmns n))))
+	:strt :gnrt
+	:orgn `(k-z2-fundamental-class ,n))))
 
 #|
-  (cat-init)
-  (setf c1 (k-z2-fundamental-class 1))
-  (? c1 1 1)
-  (? c1 2 2)
-  (setf c3 (k-z2-fundamental-class 3))
-  (? c3 3 (z2-fundamental-gmsm 3 1))
+(cat-init)
+(setf c1 (k-z2-fundamental-class 1))
+(? c1 1 1)
+(? c1 2 2)
+(setf c3 (k-z2-fundamental-class 3))
+(? c3 3 (z2-fundamental-gmsm 3 1))
 |#
 
diff --git a/test/k-pi-n-test.lisp b/test/k-pi-n-test.lisp
new file mode 100644
index 0000000..e5af7ce
--- /dev/null
+++ b/test/k-pi-n-test.lisp
@@ -0,0 +1,214 @@
+
+(in-package :kenzo-test)
+
+(in-suite :kenzo)
+
+(test k-z-1-cmpr
+      (is (equal :less (cat:k-z-1-cmpr '(1 1 2) '(1 2 2))))
+      (is (equal :equal (cat:k-z-1-cmpr '(1 1 2) '(1 1 2))))
+      (is (equal :greater (cat:k-z-1-cmpr '(1 1 2) '(1 1 -1)))))
+
+(test k-z-1-face
+      (cat:k-z-1-face 0 1 '(3))
+      (cat:k-z-1-face 1 1 '(3))
+      (cat:k-z-1-face 0 3 '(1 2 3))
+      (cat:k-z-1-face 1 3 '(1 2 3))
+      (cat:k-z-1-face 2 3 '(1 2 3))
+      (cat:k-z-1-face 2 3 '(1 2 -2))
+      (cat:k-z-1-face 3 3 '(1 2 3)))
+
+(test z-absm-bar
+      (cat:z-absm-bar (cat:absm 0 '()))
+      (cat:z-absm-bar (cat:absm 1 '()))
+      (cat:z-absm-bar (cat:absm 0 '(2)))
+      (dotimes (i 8)
+	(print (cat:z-absm-bar (cat:absm i '(3 6))))))
+
+
+(test z-bar-absm
+      (cat:z-bar-absm (cat:z-absm-bar (cat:absm 0 '())))
+      (cat:z-bar-absm (cat:z-absm-bar (cat:absm 1 '())))
+      (cat:z-bar-absm (cat:z-absm-bar (cat:absm 0 '(2))))
+      (dotimes (i 8)
+	(print (cat:z-bar-absm (cat:z-absm-bar (cat:absm i '(3 6)))))))
+
+
+(test k-z-1-grml
+      (cat:k-z-1-grml 0 (cat:crpr 0 nil 0 nil))
+      (cat:k-z-1-grml 1 (cat:crpr 0 '(3) 0 '(4)))
+      (cat:k-z-1-grml 1 (cat:crpr 0 '(3) 0 '(-3)))
+      (cat:k-z-1-grml 1 (cat:crpr 0 '(3) 1 '()))
+      (cat:k-z-1-grml 1 (cat:crpr 1 '() 0 '(3)))
+      (cat:k-z-1-grml 1 (cat:crpr 1 '() 1 '()))
+      (cat:k-z-1-grml 5 (cat:crpr 24 '(2 2 3) 20 '(-2 2 4))))
+
+
+(test k-z-1-grin
+      (cat:k-z-1-grin 3 '(2 3 -4))
+      (let ((gmsm '(2 3 -4)))
+	(cat:k-z-1-grml 3 (cat:crpr 0 gmsm 0
+				    (cat:gmsm (cat:k-z-1-grin 3 gmsm))))))
+
+
+(defun aleat-list (max length)
+  (let ((rslt nil)
+	(2max (+ max max)))
+    (dotimes (i length)
+      (push (let ((k (- (random 2max) max)))
+	      (if (zerop k)
+		  max
+		  k))
+	    rslt))
+    rslt))
+
+
+(test k-z-1
+      (let ((k (cat:k-z-1))
+	    zero?)
+	(cat:? k (cat:? k 14 (aleat-list 200 14)))
+	(setf zero? (cat:add (cat:idnt-mrph k) (cat:grin k)))
+	(cat:? zero? 14 (aleat-list 200 14))))
+
+
+(test circle
+      (let ((c (cat:circle)))
+	(cat:cmpr c '* '*)
+	(cat:basis c 1)
+	(cat:? c 1 's1)))
+
+
+(test kz1-rdct-f-intr
+      (cat:kz1-rdct-f-intr (cat:cmbn 0))
+      (cat:kz1-rdct-f-intr (cat:cmbn 0 4 '()))
+      (cat:kz1-rdct-f-intr (cat:cmbn 1))
+      (cat:kz1-rdct-f-intr (cat:cmbn 1 4 '(3)))
+      (cat:kz1-rdct-f-intr (cat:cmbn 1 4 '(3) 5 '(2)))
+      (cat:kz1-rdct-f-intr (cat:cmbn 1 4 '(3) -3 '(4)))
+      (cat:kz1-rdct-f-intr (cat:cmbn -3)))
+
+
+(test kz1-rdct-h-intr
+      (cat:kz1-rdct-h-intr 0 nil)
+      (cat:kz1-rdct-h-intr 1 '(-4))
+      (cat:kz1-rdct-h-intr 1 '(-1))
+      (cat:kz1-rdct-h-intr 1 '(1))
+      (cat:kz1-rdct-h-intr 1 '(4))
+      (cat:kz1-rdct-h-intr 3 '(-4 3 5))
+      (cat:kz1-rdct-h-intr 3 '(-1 3 -1))
+      (cat:kz1-rdct-h-intr 3 '(1 2 2))
+      (cat:kz1-rdct-h-intr 3 '(4 3 5)))
+
+
+(test kz1-rdct
+      (cat:cat-init)
+      (cat:pre-check-rdct (cat:kz1-rdct))
+      (setf cat:*tc* (cat:cmbn 0 1 '()))
+      (setf cat:*bc* (cat:cmbn 0 1 '*))
+      (check-rdct)
+      (setf cat:*tc* (cat:cmbn 1 1 '(-4) 10 '(-1) 100 '(1) 1000 '(5)))
+      (setf cat:*bc* (cat:cmbn 1 1 's1))
+      (check-rdct)
+      (setf cat:*tc* (cat:cmbn 2 1 '(-4 2) 10 '(-1 3) 100 '(1 -4) 1000 '(5 5)))
+      (check-rdct)
+      (setf cat:*tc* (cat:cmbn 3 1 '(-4 -4 5) 10 '(-1 2 1)
+			       100 '(1 4 2) 1000 '(5 1 -1)))
+      (check-rdct))
+
+
+(test k-z-1-homology
+      (cat:cat-init)
+      (cat:homology (cat:k-z-1) 1))
+
+
+(test k-z2-1-homology
+      (let ((k (cat:k-z2-1)))
+	(cat:homology k 0 4)))
+
+#|
+(test k-z2-homology
+      (let ((k3 (cat:k-z2 3)))
+	(cat:homology k3 7)))
+|#
+
+(test z2-bar-absm
+      (dotimes (i 8)    ;;; not really legal
+	(dotimes (j 8)
+	  (print (cat:z2-bar-absm (cat:z2-absm-bar (cat:absm i j)))))))
+
+
+(test z-fundamental-gmsm
+      (cat:z-fundamental-gmsm 1 33)
+      (cat:z-fundamental-gmsm 2 33)
+      (cat:z-fundamental-gmsm 3 33)
+      (cat:z-fundamental-gmsm 4 33))
+
+
+(test interesting-faces
+      (let* ((d (cat:delta 14))
+	     (f (cat:face d)))
+	(do ((i 5 (1- i)))
+	    ((minusp i))
+	  (print (cat:interesting-faces f i 5 (cat:mask 6))))))
+
+
+(test gmsm-cocycle
+      (cat:cat-init)
+      (let* ((d (cat:delta 10))
+	     (chml-clss (cat:build-mrph :sorc d :trgt (cat:z-chcm) :degr -2
+					:intr #'(lambda (dmns gmsm)
+						  (cat:term-cmbn 0 gmsm
+								 :gnrt-z))
+					:strt :gnrt
+					:orgn '(essai-1))))
+	(cat:gmsm-cocycle (cat:face d) 2 4 31 chml-clss)
+	(setf chml-clss (cat:build-mrph :sorc d :trgt (cat:z-chcm) :degr -1
+					:intr #'(lambda (dmns gmsm)
+						  (cat:term-cmbn 0 gmsm
+								 :gnrt-z))
+					:strt :gnrt
+					:orgn '(essai-2)))
+	(cat:gmsm-cocycle (cat:face d) 1 4 31 chml-clss)))
+
+#|
+(test z-cocycle-gbar
+      (cat:cat-init)
+      (let* ((d (cat:delta 10))
+	     (chml-clss (cat:build-mrph :sorc d :trgt (cat:z-chcm) :degr -1
+					:intr #'(lambda (dmns gmsm)
+						  (cat:term-cmbn 0 gmsm
+								 :gnrt-z))
+					:strt :gnrt
+					:orgn '(essai-1))))
+	(cat:gmsm-cocycle (cat:face d) 1 4 31 chml-clss)
+	(cat:z-cocycle-gbar 1 4 *)
+	(setf chml-clss
+	      (cat:build-mrph :sorc d :trgt (cat:z-chcm) :degr -2
+			      :intr #'(lambda (dmns gmsm)
+					(cat:term-cmbn 0 gmsm :gnrt-z))
+			      :strt :gnrt
+			      :orgn '(essai-2)))
+	(cat:gmsm-cocycle (cat:face d) 2 2 7 chml-clss)
+	(cat:z-cocycle-gbar 2 2 *)
+	(cat:gmsm-cocycle (cat:face d) 2 2 0 chml-clss) ;; normally illegal
+	(cat:z-cocycle-gbar 2 2 *)
+	(cat:gmsm-cocycle (cat:face d) 2 3 15 chml-clss)
+	(cat:z-cocycle-gbar 2 3 *)
+	(cat:gmsm-cocycle (cat:face d) 2 4 31 chml-clss)
+	(cat:z-cocycle-gbar 2 4 *)
+	(setf chml-clss
+	      (cat:build-mrph :sorc d :trgt (cat:z-chcm) :degr -3
+			      :intr #'(lambda (dmns gmsm)
+					(cat:term-cmbn 0 gmsm :gnrt-z))
+			      :strt :gnrt
+			      :orgn '(essai-3)))
+	(cat:gmsm-cocycle (cat:face d) 3 4 31 chml-clss)
+	(cat:z-cocycle-gbar 3 4 *)
+	(setf chml-clss
+	      (cat:build-mrph :sorc d :trgt (cat:z-chcm) :degr -3
+			      :intr #'(lambda (dmns gmsm)
+					(cat:zero-cmbn 0))
+			      :strt :gnrt
+			      :orgn '(essai-33)))
+	(cat:gmsm-cocycle (cat:face d) 3 4 31 chml-clss)
+	(cat:z-cocycle-gbar 3 4 *)))
+|#