diff --git a/kenzo-test.asd b/kenzo-test.asd
index 9afd79a..e70e2de 100644
--- a/kenzo-test.asd
+++ b/kenzo-test.asd
@@ -8,6 +8,7 @@
   :depends-on (:kenzo :fiveam)
   :pathname #P"test/"
   :components ((:file "package")
+	       (:file "common")
 	       (:file "combinations-test")
 	       (:file "various-test")
 	       (:file "chain-complexes-test")
@@ -15,4 +16,5 @@
 	       (:file "diabolo")
 	       (:file "circle")
                (:file "ccn")
-	       (:file "effective-homology-test")))
+	       (:file "effective-homology-test")
+	       (:file "bicones-test")))
diff --git a/package.lisp b/package.lisp
index cf73fec..b08cd9b 100644
--- a/package.lisp
+++ b/package.lisp
@@ -20,6 +20,17 @@
 	   *TC*
 	   *TDD*
 
+	   ;; bicones.lisp
+
+	   BICN-CMBN-CMBNB
+	   BICN-CMBN-CMBNC
+	   BICN-CMBN-CMBND
+	   BICONE
+	   BICONE-BASIS
+	   BICONE-CMPR
+	   DISPATCH-BICN-CMBN
+	   MAKE-BICN-CMBN
+
 	   ;; chain-complexes.lisp
 
 	   ?2
@@ -70,6 +81,7 @@
 	   MORPHISM
 	   ORGN
 	   REDUCTION
+	   RRDCT
 	   TCC
 
 	   ;; combinations.lisp
@@ -92,6 +104,10 @@
 	   ZERO-CMBN
 	   ZERO-INTR-DFFR
 
+	   ;; delta.lisp
+
+	   DELTA-N-BASIS
+
 	   ;; effective-homology.lisp
 
 	   BUILD-RDCT
@@ -115,6 +131,9 @@
 	   ?
 	   BASIS
 	   BCC
+	   BCNB
+	   BCNC
+	   BCND
 	   BINOMIAL-P-Q
 	   CFFC
 	   CMBN-NON-ZERO-P
@@ -132,6 +151,10 @@
 
 	   HOMOLOGY
 
+	   ;; simplicial-sets.lisp
+
+	   DLOP-INT-EXT
+
 	   ;; smith.lisp
 
 	   CHML-CLSS
diff --git a/src/bicones.lisp b/src/bicones.lisp
index 187525b..c8609e9 100644
--- a/src/bicones.lisp
+++ b/src/bicones.lisp
@@ -7,438 +7,374 @@
 (PROVIDE "bicones")
 
 (DEFUN DISPATCH-BICN-CMBN (cmbn)
-   (declare (type cmbn cmbn))
-   (the (values cmbn cmbn cmbn)
-      (with-cmbn (degr list) cmbn
-         (let ((listb +empty-list+)
-               (listc +empty-list+)
-               (listd +empty-list+))
-            (declare (list listb listc listd))
-            (dolist (term list)
-               (declare (type term term))
-               (with-term (cffc bicn) term
-                  (with-bicn (bcnx ibicn) bicn
-                     (ecase bcnx
-                        (:bcnb (push (term cffc ibicn) listb))
-                        (:bcnc (push (term cffc ibicn) listc))
-                        (:bcnd (push (term cffc ibicn) listd))))))
-            (values
-               (make-cmbn :degr degr :list (nreverse listb))
-               (make-cmbn :degr (1+ degr) :list (nreverse listc))
-               (make-cmbn :degr degr :list (nreverse listd)))))))
-
-#|
-()
-(dispatch-bicn-cmbn (cmbn 3 3 (bcnb 'b1) 4 (bcnb 'b2) 33 (bcnc 'c) 333 (bcnd 'd)))
-|#
+  "(DISPATCH-BICN-CMBN CMBN) splits the bicone combination CMBN into three
+combinations and returns 3 values."
+  (declare (type cmbn cmbn))
+  (the (values cmbn cmbn cmbn)
+       (with-cmbn (degr list) cmbn
+		  (let ((listb +empty-list+)
+			(listc +empty-list+)
+			(listd +empty-list+))
+		    (declare (list listb listc listd))
+		    (dolist (term list)
+		      (declare (type term term))
+		      (with-term (cffc bicn) term
+				 (with-bicn (bcnx ibicn) bicn
+					    (ecase bcnx
+					      (:bcnb (push (term cffc ibicn)
+							   listb))
+					      (:bcnc (push (term cffc ibicn)
+							   listc))
+					      (:bcnd (push (term cffc ibicn)
+							   listd))))))
+		    (values
+		     (make-cmbn :degr degr :list (nreverse listb))
+		     (make-cmbn :degr (1+ degr) :list (nreverse listc))
+		     (make-cmbn :degr degr :list (nreverse listd)))))))
 
 
 (DEFUN BICN-CMBN-CMBNB (cmbn)
   (declare (type cmbn cmbn))
+  "(BICN-CMBN-CMBNB CMBN) extracts from the bicone combination CMBN of degree
+n the B-component as a legal combination of degree n in B. If the B-component
+is empty, the null combination of degree n in B is returned."
   (the cmbn
-    (with-cmbn (degr list) cmbn
-      (make-cmbn :degr degr
-                 :list (do ((rslt +empty-list+)
-                            (mark list (cdr mark)))
-                           ((endp mark) (nreverse rslt))
-                         (declare (list rslt mark))
-                         (with--term (cffc bicn) mark
-                         (with-bicn (bcnx gnrtB) bicn
-                                    (if (eq bcnx :bcnB)
-                                        (push (term cffc gnrtB) rslt)
-                                      (return (nreverse rslt))))))))))
+       (with-cmbn (degr list) cmbn
+		  (make-cmbn
+		   :degr degr
+		   :list (do ((rslt +empty-list+)
+			      (mark list (cdr mark)))
+			     ((endp mark) (nreverse rslt))
+			   (declare (list rslt mark))
+			   (with--term (cffc bicn) mark
+				       (with-bicn (bcnx gnrtB) bicn
+						  (if (eq bcnx :bcnB)
+						      (push (term cffc gnrtB)
+							    rslt)
+						      (return
+							(nreverse rslt))))))))))
 
 (DEFUN BICN-CMBN-CMBNC (cmbn)
-   (declare (type cmbn cmbn))
-   (the cmbn
-      (with-cmbn (degr list) cmbn
-         (make-cmbn :degr (1+ degr)
-            :list (do ((rslt +empty-list+)
-                       (mark (member :bcnc list
-                                     ;; Correction 1-1-2
-                                     :key #'(lambda (term)
-                                              (declare (type term term))
-                                              (bcnx (gnrt term))))
-                             (cdr mark)))
-                      ((endp mark) (nreverse rslt))
-                     (declare (list rslt mark))
-                     (with--term (cffc bicn) mark
-                     (with-bicn (bcnx gnrtC) bicn
-                        (if (eq bcnx :bcnC)
-                           (push (term cffc gnrtC) rslt)
-                           (return (nreverse rslt))))))))))
+  (declare (type cmbn cmbn))
+  "(BICN-CMBN-CMBNC CMBN) extracts from the bicone combination CMBN of degree
+n the C-component as a legal combination of degree n+1 in C. If the C-component
+is empty, the null combination of degree n+1 in C is returned."
+  (the cmbn
+       (with-cmbn (degr list) cmbn
+		  (make-cmbn
+		   :degr (1+ degr)
+		   :list (do ((rslt +empty-list+)
+			      (mark (member :bcnc list
+					    ;; Correction 1-1-2
+					    :key #'(lambda (term)
+						     (declare (type term term))
+						     (bcnx (gnrt term))))
+				    (cdr mark)))
+			     ((endp mark) (nreverse rslt))
+			   (declare (list rslt mark))
+			   (with--term (cffc bicn) mark
+				       (with-bicn (bcnx gnrtC) bicn
+						  (if (eq bcnx :bcnC)
+						      (push (term cffc gnrtC)
+							    rslt)
+						      (return
+							(nreverse rslt))))))))))
 
 
 (DEFUN BICN-CMBN-CMBND (cmbn)
   (declare (type cmbn cmbn))
+  "(BICN-CMBN-CMBND CMBN) extracts from the bicone combination CMBN of degree
+n the D-component as a legal combination of degree n in D. If the D-component
+is empty, the null combination of degree n in D is returned."
   (the cmbn
-    (with-cmbn (degr list) cmbn
-      (make-cmbn :degr degr
-                 :list (mapcar
-                           #'(lambda (term)
-                               (declare (type term term))
-                               (with-term (cffc bicn) term
-                                          (term cffc (ibicn bicn))))
-                         (member :bcnd list
-                                 :key #'(lambda (term)
-                                          (declare (type term term))
-                                          (the keyword (bcnx (gnrt term))))))))))
+       (with-cmbn (degr list) cmbn
+		  (make-cmbn
+		   :degr degr
+		   :list (mapcar
+			  #'(lambda (term)
+			      (declare (type term term))
+			      (with-term (cffc bicn) term
+					 (term cffc (ibicn bicn))))
+			  (member
+			   :bcnd list
+			   :key #'(lambda (term)
+				    (declare (type term term))
+				    (the keyword (bcnx (gnrt term))))))))))
 
-#|
-()
-(bicn-cmbn-cmbnb (cmbn 3 1 (bcnb 'a) 2 (bcnc 'b)))
-(bicn-cmbn-cmbnb (cmbn 3 2 (bcnc 'b)))
-(bicn-cmbn-cmbnc (cmbn 3 1 (bcnb 'a) 2 (bcnc 'b) 3 (bcnd 'c)))
-(bicn-cmbn-cmbnc (cmbn 3 1 (bcnb 'a) 3 (bcnd 'c)))
-(bicn-cmbn-cmbnd (cmbn 3 1 (bcnb 'a) 2 (bcnc 'b) 3 (bcnd 'c)))
-(bicn-cmbn-cmbnd (cmbn 3 2 (bcnb 'b)))
-|#
 
 (DEFUN MAKE-BICN-CMBN (cmbnb cmbnc cmbnd)
-   (declare (type cmbn cmbnb cmbnc cmbnd))
-   (the cmbn
-      (with-cmbn (degrb listb) cmbnb
-      (with-cmbn (degrc listc) cmbnc
-      (with-cmbn (degrd listd) cmbnd
-         (unless (= degrb (1- degrc) degrd)
-            (error "In MAKE-BICN-CMBN, the degrees are not coherent."))
-         (make-cmbn :degr degrb
-            :list (nconc
-                     (mapcar #'(lambda (termb)
-                                  (declare (type term termb))
-                                  (with-term (cffc gnrtb) termb
-                                     (term cffc (bcnb gnrtb))))
-                        listb)
-                     (mapcar #'(lambda (termc)
-                                  (declare (type term termc))
-                                  (with-term (cffc gnrtc) termc
-                                     (term cffc (bcnc gnrtc))))
-                        listc)
-                     (mapcar #'(lambda (termd)
-                                  (declare (type term termd))
-                                  (with-term (cffc gnrtd) termd
-                                     (term cffc (bcnd gnrtd))))
-                        listd))))))))
+  (declare (type cmbn cmbnb cmbnc cmbnd))
+  "(MAKE-BICN-CMBN CMBNB CMBNC CMBND) constructs a bicone combination from
+CMBNB, CMBNC and CMBND, which belong to chain complexes B, C, D, respectively.
+Combinations CMBNB and CMBND must be of the same degree n and combination
+CMBNC must be of degree n+1, yiedling a bicone combination of degree n."
+  (the cmbn
+       (with-cmbn
+	   (degrb listb) cmbnb
+	   (with-cmbn
+	       (degrc listc) cmbnc
+	       (with-cmbn
+		   (degrd listd) cmbnd
+		   (unless (= degrb (1- degrc) degrd)
+		     (error "In MAKE-BICN-CMBN, the degrees are not coherent."))
+		   (make-cmbn
+		    :degr degrb
+		    :list (nconc
+			   (mapcar #'(lambda (termb)
+				       (declare (type term termb))
+				       (with-term (cffc gnrtb) termb
+						  (term cffc (bcnb gnrtb))))
+				   listb)
+			   (mapcar #'(lambda (termc)
+				       (declare (type term termc))
+				       (with-term (cffc gnrtc) termc
+						  (term cffc (bcnc gnrtc))))
+				   listc)
+			   (mapcar #'(lambda (termd)
+				       (declare (type term termd))
+				       (with-term (cffc gnrtd) termd
+						  (term cffc (bcnd gnrtd))))
+				   listd))))))))
 
-#|
-()
-(multiple-value-call #'make-bicn-cmbn 
-  (dispatch-bicn-cmbn (cmbn 3 3 (bcnb 'b1) 4 (bcnb 'b2) 33 (bcnc 'c) 333 (bcnd 'd))))
-|#
 
 (DEFUN BICN-PRINT (bicn stream depth)
   (declare
    (type bicn bicn) (stream stream)
    (ignore depth))
   (the bicn
-    (with-bicn (bcnx ibicn) bicn
-               ;; Correction 1-1-2
-               (format stream "<Bcn~A ~A>"
-                 ;; Correction 1-1-3
-                 (ecase bcnx (:bcnb #\B) (:bcnc #\C) (:bcnd #\D))
-                 ibicn)
-               bicn)))
+       (with-bicn (bcnx ibicn) bicn
+		  ;; Correction 1-1-2
+		  (format stream "<Bcn~A ~A>"
+			  ;; Correction 1-1-3
+			  (ecase bcnx (:bcnb #\B) (:bcnc #\C) (:bcnd #\D))
+			  ibicn)
+		  bicn)))
 
-#|
-()
-(bcnb 'a)
-(bcnc 'b)
-(bcnd 'c)
-|#
 
 (DEFUN BICONE-CMPR (cmprb cmprc cmprd)
-   (declare (type cmprf cmprb cmprc cmprd))
-   (flet ((rslt (bicn1 bicn2)
-             (declare (type bicn bicn1 bicn2))
-             (let ((bcnx1 (bcnx bicn1)))
-                (declare (type (member :bcnb :bcnc :bcnd) bcnx1))
-                (lexico
-                   (s-cmpr bcnx1 (bcnx bicn2))
-                   (case bcnx1
-                      (:bcnb (funcall cmprb (ibicn bicn1) (ibicn bicn2)))
-                      (:bcnc (funcall cmprc (ibicn bicn1) (ibicn bicn2)))
-                      (:bcnd (funcall cmprd (ibicn bicn1) (ibicn bicn2))))))))
-      (the cmprf #'rslt)))
+  (declare (type cmprf cmprb cmprc cmprd))
+  "(BICONE-CMPR CMPRB CMPRC CMPRD) returns a comparison function for bicone
+generators, which is contructed from the comparison functions CMPRB, CMPRC
+and CMPRD."
+  (flet ((rslt (bicn1 bicn2)
+	   (declare (type bicn bicn1 bicn2))
+	   (let ((bcnx1 (bcnx bicn1)))
+	     (declare (type (member :bcnb :bcnc :bcnd) bcnx1))
+	     (lexico
+	      (s-cmpr bcnx1 (bcnx bicn2))
+	      (case bcnx1
+		(:bcnb (funcall cmprb (ibicn bicn1) (ibicn bicn2)))
+		(:bcnc (funcall cmprc (ibicn bicn1) (ibicn bicn2)))
+		(:bcnd (funcall cmprd (ibicn bicn1) (ibicn bicn2))))))))
+    (the cmprf #'rslt)))
 
-#|
-()
-(setf r (bicone-cmpr #'f-cmpr #'f-cmpr #'f-cmpr))
-(funcall r (bcnb 1) (bcnc 0))
-(funcall r (bcnb 1) (bcnb 2))
-|#
 
 (DEFUN BICONE-BASIS (basisb basisc basisd)
-   (declare (type basis basisb basisc basisd))
-   (the basis
-      (if (or (eq :locally-effective basisb)
-              (eq :locally-effective basisc)
-              (eq :locally-effective basisd))
-         :locally-effective
-         (flet ((rslt (degr)
-                   (declare (fixnum degr))
-                   (append
-                      (mapcar #'(lambda (item)
-                                   (declare (type gnrt item))
-                                   (bcnb item))
-                         (funcall basisb degr))
-                      (mapcar #'(lambda (item)
-                                   (declare (type gnrt item))
-                                   (bcnc item))
-                         (funcall basisc (1+ degr)))
-                      (mapcar #'(lambda (item)
-                                   (declare (type gnrt item))
-                                   (bcnd item))
-                         (funcall basisd degr)))))
-            (the basis #'rslt)))))
+  (declare (type basis basisb basisc basisd))
+  "(BICONE-BASIS BASISB BASISC BASISD) returns a bicone basis function built
+from the basis functions BASISB, BASISC and BASISD. If at least one is
+locally effective, the function returns the symbol :locally-effective."
+  (the basis
+       (if (or (eq :locally-effective basisb)
+	       (eq :locally-effective basisc)
+	       (eq :locally-effective basisd))
+	   :locally-effective
+	   (flet ((rslt (degr)
+		    (declare (fixnum degr))
+		    (append
+		     (mapcar #'(lambda (item)
+				 (declare (type gnrt item))
+				 (bcnb item))
+			     (funcall basisb degr))
+		     (mapcar #'(lambda (item)
+				 (declare (type gnrt item))
+				 (bcnc item))
+			     (funcall basisc (1+ degr)))
+		     (mapcar #'(lambda (item)
+				 (declare (type gnrt item))
+				 (bcnd item))
+			     (funcall basisd degr)))))
+	     (the basis #'rslt)))))
 
-#|
-()
-(bicone-basis :locally-effective :locally-effective :locally-effective)
-(setf b #'(lambda (degr) (mapcar #'(lambda (item) (cons degr item)) (<a-b> 0 degr))))
-(setf r (bicone-basis b b b))
-(funcall r 3)
-|#
 
 (DEFUN BICONE-INTR-DFFR (cmprc dffrb dffrc dffrd f1 f2)
-   (declare
-      (type cmprf cmprc)
-      (type morphism dffrb dffrc dffrd f1 f2))
-   (flet ((rslt (cmbn)
-             (declare (type cmbn cmbn))
-             (the cmbn
-                (multiple-value-bind (cmbnb cmbnc cmbnd) (dispatch-bicn-cmbn cmbn)
-                   (declare (type cmbn cmbnb cmbnc cmbnd))
-                   (let ((dffrb (cmbn-? dffrb cmbnb))
-                         (dffrc (cmbn-? dffrc cmbnc))
-                         (dffrd (cmbn-? dffrd cmbnd))
-                         (f1 (cmbn-? f1 cmbnb))
-                         (f2 (cmbn-? f2 cmbnd)))
-                      (declare (type cmbn dffrb dffrc dffrd f1 f2))
-                      (let ((cmbnc (2cmbn-sbtr cmprc (2cmbn-add cmprc f1 f2) dffrc)))
-                         (declare (type cmbn cmbnc))
-                         (make-bicn-cmbn dffrb cmbnc dffrd)))))))
-      (the intr-mrph #'rslt)))
-                      
+  (declare
+   (type cmprf cmprc)
+   (type morphism dffrb dffrc dffrd f1 f2))
+  "(BICONE-INTR-DFFR CMPRC DFFRB DFFRC DFFRD F1 F2) "
+  (flet ((rslt (cmbn)
+	   (declare (type cmbn cmbn))
+	   (the cmbn
+                (multiple-value-bind (cmbnb cmbnc cmbnd)
+		    (dispatch-bicn-cmbn cmbn)
+		  (declare (type cmbn cmbnb cmbnc cmbnd))
+		  (let ((dffrb (cmbn-? dffrb cmbnb))
+			(dffrc (cmbn-? dffrc cmbnc))
+			(dffrd (cmbn-? dffrd cmbnd))
+			(f1 (cmbn-? f1 cmbnb))
+			(f2 (cmbn-? f2 cmbnd)))
+		    (declare (type cmbn dffrb dffrc dffrd f1 f2))
+		    (let ((cmbnc (2cmbn-sbtr cmprc
+					     (2cmbn-add cmprc f1 f2)
+					     dffrc)))
+		      (declare (type cmbn cmbnc))
+		      (make-bicn-cmbn dffrb cmbnc dffrd)))))))
+    (the intr-mrph #'rslt)))
+
+
+
 (DEFUN BICONE (rdct1 rdct2)
-   (declare (type reduction rdct1 rdct2))
-   (the chain-complex
-      (with-slots ((tcc1 tcc) (bcc1 bcc) (f1 f)) rdct1
-         (declare
-            (type chain-complex tcc1 bcc1)
-            (type morphism f1))
-      (with-slots ((tcc2 tcc) (bcc2 bcc) (f2 f)) rdct2
+  (declare (type reduction rdct1 rdct2))
+  "(BICONE RDCT1 RDCT2) returns the bicone chain complex from the reductions
+RDCT1 and RDCT2. B is the top chain complex of RDCT1 and D is the top chain
+complex of RDCT2. The bottom chain complexes of RDCT1 and RDCT2 must be the
+same, and C is that chain complex."
+  (the chain-complex
+       (with-slots ((tcc1 tcc) (bcc1 bcc) (f1 f)) rdct1
          (declare
+	  (type chain-complex tcc1 bcc1)
+	  (type morphism f1))
+	 (with-slots ((tcc2 tcc) (bcc2 bcc) (f2 f)) rdct2
+	   (declare
             (type chain-complex tcc2 bcc2)
             (type morphism f2))
-         (unless (eq bcc1 bcc2)
-            (error "In BICONE, both reductions have different BCC's."))
-         (let ((rslt (build-chcm
+	   (unless (eq bcc1 bcc2)
+	     (error "In BICONE, both reductions have different BCC's."))
+	   (let ((rslt (build-chcm
                         :cmpr (bicone-cmpr (cmpr tcc1) (cmpr bcc1) (cmpr tcc2))
-                        :basis (bicone-basis (basis tcc1) (basis bcc1) (basis tcc2))
+                        :basis (bicone-basis (basis tcc1) (basis bcc1)
+					     (basis tcc2))
                         :bsgn :undefined
                         :intr-dffr (bicone-intr-dffr (cmpr bcc1)
-                                      (dffr tcc1) (dffr bcc1) (dffr tcc2)
-                                      f1 f2)
+						     (dffr tcc1) (dffr bcc1)
+						     (dffr tcc2)
+						     f1 f2)
                         :strt :cmbn
                         :orgn `(bicone ,rdct1 ,rdct2))))
-            (declare (type chain-complex rslt))
-            ; (slot-makunbound rslt 'bsgn)
-            rslt)))))
+	     (declare (type chain-complex rslt))
+					; (slot-makunbound rslt 'bsgn)
+	     rslt)))))
 
-#|
-()
-(cat-init)
-(progn
-  (defun cdelta (dmns)
-    (build-chcm
-     :cmpr #'l-cmpr
-     :basis #'(lambda (n)
-                (mapcar #'dlop-int-ext (funcall (delta-n-basis dmns) n)))
-     :bsgn '(0)
-     :intr-dffr #'(lambda (degr gmsm)
-                    (make-cmbn
-                     :degr (1- degr)
-                     :list (do ((rslt +empty-list+
-                                      (cons (cons sign (append
-                                                        (subseq gmsm 0 nark)
-                                                        (subseq gmsm (1+ nark))))
-                                            rslt))
-                                (sign 1 (- sign))
-                                (nark 0 (1+ nark)))
-                               ((> nark degr) rslt))))                                           
-     :strt :gnrt
-     :orgn `(locally effective version of C_* delta ,dmns)))
-  (defun make-f (tdmns bdmns)
-    (build-mrph
-     :sorc (cdelta tdmns) :trgt (cdelta bdmns) :degr 0
-     :intr #'(lambda (degr gmsm)
-               (let ((pos (position-if #'(lambda (vertex) (>= vertex bdmns)) gmsm)))
-                 (if pos
-                     (if (< pos degr)
-                         (zero-cmbn degr)
-                       (cmbn degr 1 (nconc (butlast gmsm) (list bdmns))))
-                   (cmbn degr 1 gmsm))))
-     :strt :gnrt
-     :orgn `(projection delta ,tdmns => delta ,bdmns)))
-  (defun make-g (tdmns bdmns)
-    (build-mrph
-     :sorc (cdelta bdmns) :trgt (cdelta tdmns) :degr 0
-     :intr #'identity
-     :strt :cmbn
-     :orgn `(injection delta ,bdmns => delta ,tdmns)))
-  (defun make-h (tdmns bdmns)
-    (build-mrph
-     :sorc (cdelta tdmns) :trgt (cdelta tdmns) :degr +1
-     :intr #'(lambda (degr gmsm)
-               (let ((pos (position-if #'(lambda (vertex) (>= vertex bdmns)) gmsm)))
-                 (if pos
-                     (if (member bdmns gmsm)
-                         (zero-cmbn (1+ degr))
-                       (cmbn (1+ degr) (-1-expt-n pos)
-                             (append (subseq gmsm 0 pos) (list bdmns) (subseq gmsm pos))))
-                   (zero-cmbn (1+ degr)))))
-     :strt :gnrt
-     :orgn `(homotopy for delta ,tdmns => ,bdmns)))
-  (defun make-rdct (tdmns bdmns)
-    (setf rdct (build-rdct
-                :f (make-f tdmns bdmns)
-                :g (make-g tdmns bdmns)
-                :h (make-h tdmns bdmns)
-                :orgn `(reduction delta ,tdmns ,bdmns)))))
-(setf b (bicone (make-rdct 3 2) (make-rdct 4 2)))
-(basis b 1)
-(? b (cmbn 1 3 (bcnb '(0 3)) 4 (bcnc '(0 1 2)) 5 (bcnd '(0 4))))
-|#
 
-(DEFMETHOD CMPS ((hmeq1 homotopy-equivalence) (hmeq2 homotopy-equivalence) &optional dummy)
-   (declare (ignore dummy))
-   (the homotopy-equivalence
-      (progn
+(DEFMETHOD CMPS ((hmeq1 homotopy-equivalence) (hmeq2 homotopy-equivalence)
+		 &optional dummy)
+  (declare (ignore dummy))
+  "(CMPS HMEQ1 HMEQ2 &OPTIONAL DUMMY) constructs a homotopy equivalence
+by composition of the homotopy equivalences HMEQ1 and HMEQ2."
+  (the homotopy-equivalence
+       (progn
          (when (eq 'trivial-hmeq (orgn hmeq2))
-            (return-from cmps hmeq1))
+	   (return-from cmps hmeq1))
          (with-slots ((cc-A lbcc) (cc-B tcc) (cc-C rbcc)
                       (f1 lf) (g1 lg) (h1 lh) (f2 rf) (g2 rg) (h2 rh)) hmeq1
-            (declare
-               (type chain-complex cc-A cc-B cc-C)
-               (type morphism f1 g1 h1 f2 g2 h2))
-         (with-slots ((cc-C2 lbcc) (cc-D tcc) (cc-E rbcc)
-                      (f3 lf) (g3 lg) (h3 lh) (f4 rf) (g4 rg) (h4 rh)) hmeq2
-            (declare
-               (type chain-complex cc-C2 cc-D cc-E)
-               (type morphism f3 g3 h3 f4 g4 h4))
-            (unless (eq (grmd cc-C) (grmd cc-C2))
+	   (declare
+	    (type chain-complex cc-A cc-B cc-C)
+	    (type morphism f1 g1 h1 f2 g2 h2))
+	   (with-slots ((cc-C2 lbcc) (cc-D tcc) (cc-E rbcc)
+			(f3 lf) (g3 lg) (h3 lh) (f4 rf) (g4 rg) (h4 rh)) hmeq2
+	     (declare
+	      (type chain-complex cc-C2 cc-D cc-E)
+	      (type morphism f3 g3 h3 f4 g4 h4))
+	     (unless (eq (grmd cc-C) (grmd cc-C2))
                (error "In (CMPS HMEQ HMEQ), both hmeq's may not be composed."))
-            (let ((bicone (bicone (rrdct hmeq1) (lrdct hmeq2)))
-                  (cmpr-B (cmpr cc-B))
-                  (cmpr-D (cmpr cc-D)))
+	     (let ((bicone (bicone (rrdct hmeq1) (lrdct hmeq2)))
+		   (cmpr-B (cmpr cc-B))
+		   (cmpr-D (cmpr cc-D)))
                (declare (type chain-complex bicone))
                (let ((lf (build-mrph
-                            :sorc bicone :trgt cc-A :degr 0
-                            :intr #'(lambda (cmbn)
-                                       (declare (type cmbn cmbn))
-                                       (cmbn-? f1 (bicn-cmbn-cmbnB cmbn)))
-                            :strt :cmbn
-                            :orgn `(cmps ,hmeq1 ,hmeq2 lf)))
+			  :sorc bicone :trgt cc-A :degr 0
+			  :intr #'(lambda (cmbn)
+				    (declare (type cmbn cmbn))
+				    (cmbn-? f1 (bicn-cmbn-cmbnB cmbn)))
+			  :strt :cmbn
+			  :orgn `(cmps ,hmeq1 ,hmeq2 lf)))
                      (lg (build-mrph
-                            :sorc cc-A :trgt bicone :degr 0
-                            :intr #'(lambda (cmbn)
-                                       (declare (type cmbn cmbn))
-                                       (let* ((cmbnB (cmbn-? g1 cmbn))
-                                              (cmbnC (zero-cmbn (1+ (cmbn-degr cmbn))))
-                                              (cmbnD (cmbn-? g3 (cmbn-? f2 (cmbn-opps cmbnB)))))
-                                          (declare (type cmbn cmbnB cmbnC cmbnD))
-                                          (make-bicn-cmbn cmbnB cmbnC cmbnD)))
-                            :strt :cmbn
-                            :orgn `(cmps ,hmeq1 ,hmeq2 lg)))
+			  :sorc cc-A :trgt bicone :degr 0
+			  :intr #'(lambda (cmbn)
+				    (declare (type cmbn cmbn))
+				    (let* ((cmbnB (cmbn-? g1 cmbn))
+					   (cmbnC (zero-cmbn
+						   (1+ (cmbn-degr cmbn))))
+					   (cmbnD (cmbn-? g3
+							  (cmbn-? f2
+								  (cmbn-opps
+								   cmbnB)))))
+				      (declare (type cmbn cmbnB cmbnC cmbnD))
+				      (make-bicn-cmbn cmbnB cmbnC cmbnD)))
+			  :strt :cmbn
+			  :orgn `(cmps ,hmeq1 ,hmeq2 lg)))
                      (lh (build-mrph
-                            :sorc bicone :trgt bicone :degr +1
-                            :intr #'(lambda (cmbn)
-                                       (declare (type cmbn cmbn))
-                                       (multiple-value-bind (cmbnB cmbnC cmbnD) 
-                                           (dispatch-bicn-cmbn cmbn)
-                                          (declare (type cmbn cmbnB cmbnC cmbnD))
-                                          (setf cmbnB (cmbn-? h1 cmbnB))
-                                          (let ((cmbnC (zero-cmbn (1+ (cmbn-degr cmbnC))))
-                                                (cmbnD1 (cmbn-? g3 (cmbn-? f2 cmbnB)))
-                                                (cmbnD2 (cmbn-? g3 cmbnC))  ;; let, not let*
-                                                (cmbnD3 (cmbn-? h3 cmbnD)))
-                                             (declare (type cmbn cmbnC cmbnD1 cmbnD2 cmbnD3))
-                                             (make-bicn-cmbn
-                                                cmbnB
-                                                cmbnC
-                                                (2cmbn-sbtr cmpr-D
-                                                   (2cmbn-add cmpr-D cmbnD2 cmbnD3)
-                                                   cmbnD1)))))
-                            :strt :cmbn
-                            :orgn `(cmps ,hmeq1 ,hmeq2 lh)))
+			  :sorc bicone :trgt bicone :degr +1
+			  :intr #'(lambda (cmbn)
+				    (declare (type cmbn cmbn))
+				    (multiple-value-bind (cmbnB cmbnC cmbnD)
+					(dispatch-bicn-cmbn cmbn)
+				      (declare (type cmbn cmbnB cmbnC cmbnD))
+				      (setf cmbnB (cmbn-? h1 cmbnB))
+				      (let ((cmbnC (zero-cmbn
+						    (1+ (cmbn-degr cmbnC))))
+					    (cmbnD1 (cmbn-? g3
+							    (cmbn-? f2 cmbnB)))
+					    (cmbnD2 (cmbn-? g3 cmbnC))  ;; let, not let*
+					    (cmbnD3 (cmbn-? h3 cmbnD)))
+					(declare (type cmbn cmbnC cmbnD1 cmbnD2
+						       cmbnD3))
+					(make-bicn-cmbn
+					 cmbnB
+					 cmbnC
+					 (2cmbn-sbtr cmpr-D
+						     (2cmbn-add cmpr-D cmbnD2
+								cmbnD3)
+						     cmbnD1)))))
+			  :strt :cmbn
+			  :orgn `(cmps ,hmeq1 ,hmeq2 lh)))
                      (rf (build-mrph
-                            :sorc bicone :trgt cc-E :degr 0
-                            :intr #'(lambda (cmbn)
-                                       (declare (type cmbn cmbn))
-                                       (cmbn-? f4 (bicn-cmbn-cmbnD cmbn)))
-                            :strt :cmbn
-                            :orgn `(cmps ,hmeq1 ,hmeq2 rf)))
+			  :sorc bicone :trgt cc-E :degr 0
+			  :intr #'(lambda (cmbn)
+				    (declare (type cmbn cmbn))
+				    (cmbn-? f4 (bicn-cmbn-cmbnD cmbn)))
+			  :strt :cmbn
+			  :orgn `(cmps ,hmeq1 ,hmeq2 rf)))
                      (rg (build-mrph
-                            :sorc cc-E :trgt bicone :degr 0
-                            :intr #'(lambda (cmbn)
-                                       (declare (type cmbn cmbn))
-                                       (let* ((cmbnD (cmbn-? g4 cmbn))
-                                              (cmbnC (zero-cmbn (1+ (cmbn-degr cmbn))))
-                                              (cmbnB (cmbn-? g2 (cmbn-? f3 (cmbn-opps cmbnD)))))
-                                          (declare (type cmbn cmbnD cmbnC cmbnB))
-                                          (make-bicn-cmbn cmbnB cmbnC cmbnD)))
-                            :strt :cmbn
-                            :orgn `(cmps ,hmeq1 ,hmeq2 rg)))
+			  :sorc cc-E :trgt bicone :degr 0
+			  :intr #'(lambda (cmbn)
+				    (declare (type cmbn cmbn))
+				    (let* ((cmbnD (cmbn-? g4 cmbn))
+					   (cmbnC (zero-cmbn
+						   (1+ (cmbn-degr cmbn))))
+					   (cmbnB
+					    (cmbn-?
+					     g2 (cmbn-? f3 (cmbn-opps cmbnD)))))
+				      (declare (type cmbn cmbnD cmbnC cmbnB))
+				      (make-bicn-cmbn cmbnB cmbnC cmbnD)))
+			  :strt :cmbn
+			  :orgn `(cmps ,hmeq1 ,hmeq2 rg)))
                      (rh (build-mrph
-                            :sorc bicone :trgt bicone :degr +1
-                            :intr #'(lambda (cmbn)
-                                       (declare (type cmbn cmbn))
-                                       (multiple-value-bind (cmbnB cmbnC cmbnD) 
-                                           (dispatch-bicn-cmbn cmbn)
-                                          (declare (type cmbn cmbnB cmbnC cmbnD))
-                                          (setf cmbnD (cmbn-? h4 cmbnD))
-                                          (let ((cmbnC (zero-cmbn (1+ (cmbn-degr cmbnC))))
-                                                (cmbnB1 (cmbn-? g2 (cmbn-? f3 cmbnD)))
-                                                (cmbnB2 (cmbn-? g2 cmbnC))  ;; let, not let*
-                                                (cmbnB3 (cmbn-? h2 cmbnB)))
-                                             (declare (type cmbn cmbnC cmbnB1 cmbnB2 cmbnB3))
-                                             (make-bicn-cmbn
-                                                (2cmbn-sbtr cmpr-B
-                                                   (2cmbn-add cmpr-B cmbnB2 cmbnB3)
-                                                   cmbnB1)
-                                                cmbnC
-                                                cmbnD))))
-                            :strt :cmbn
-                            :orgn `(cmps ,hmeq1 ,hmeq2 rh))))
-                  (declare
-                     (type morphism lf lg lh rf rg rh))
-                  (build-hmeq :lf lf :lg lg :lh lh :rf rf :rg rg :rh rh
-                     :orgn `(cmps ,hmeq1 ,hmeq2)))))))))
-   
-#|
-()
-(cat-init)
-(setf c (build-chcm
-         :cmpr #'s-cmpr
-         :basis #'(lambda (dmns) '(a))
-         :bsgn 'a
-         :intr-dffr #'zero-intr-dffr
-         :strt :cmbn
-         :orgn '(c)))
-(setf h1 (trivial-hmeq c))
-(setf h2 (cmps h1 h1))
-(pre-check-rdct (lrdct h2))
-(setf *tc* (cmbn 3 1 (bcnB 'a) 10 (bcnC 'a) 100 (bcnD 'a)))
-(setf *bc* (cmbn 3 1 'a))
-(check-rdct)
-(pre-check-rdct (rrdct h2))
-(check-rdct)
-(setf h3 (cmps h2 h2))
-(setf *tc* (cmbn 3 1 (bcnB (bcnB 'a)) 10 (bcnB (bcnC 'a)) 100 (bcnB (bcnD 'a))
-                 1000 (bcnC 'a)
-                 10000 (bcnD (bcnB 'a)) 5234 (bcnD (bcnC 'a)) 223 (bcnD (bcnD 'a))))
-(pre-check-rdct (lrdct h3))
-(check-rdct)
-(pre-check-rdct (rrdct h3))
-(check-rdct)
-|#
+			  :sorc bicone :trgt bicone :degr +1
+			  :intr #'(lambda (cmbn)
+				    (declare (type cmbn cmbn))
+				    (multiple-value-bind (cmbnB cmbnC cmbnD)
+					(dispatch-bicn-cmbn cmbn)
+				      (declare (type cmbn cmbnB cmbnC cmbnD))
+				      (setf cmbnD (cmbn-? h4 cmbnD))
+				      (let ((cmbnC (zero-cmbn
+						    (1+ (cmbn-degr cmbnC))))
+					    (cmbnB1 (cmbn-? g2
+							    (cmbn-? f3 cmbnD)))
+					    (cmbnB2 (cmbn-? g2 cmbnC))  ;; let, not let*
+					    (cmbnB3 (cmbn-? h2 cmbnB)))
+					(declare (type cmbn cmbnC cmbnB1 cmbnB2
+						       cmbnB3))
+					(make-bicn-cmbn
+					 (2cmbn-sbtr cmpr-B
+						     (2cmbn-add cmpr-B cmbnB2
+								cmbnB3)
+						     cmbnB1)
+					 cmbnC
+					 cmbnD))))
+			  :strt :cmbn
+			  :orgn `(cmps ,hmeq1 ,hmeq2 rh))))
+		 (declare
+		  (type morphism lf lg lh rf rg rh))
+		 (build-hmeq :lf lf :lg lg :lh lh :rf rf :rg rg :rh rh
+			     :orgn `(cmps ,hmeq1 ,hmeq2)))))))))
diff --git a/src/cones.lisp b/src/cones.lisp
index 6a62af0..b80ad58 100644
--- a/src/cones.lisp
+++ b/src/cones.lisp
@@ -12,16 +12,16 @@
    (stream stream)
    (ignore depth))
   (the cone
-    (with-cone (conx icon) cone
-      (format stream "<CONE ~D" conx)
-      (do ((mark icon))
-          ((not (typep mark 'cone))
-           (format stream " ~A>" mark))
-        (declare (type gnrt icon))
-        (with-cone (conx icon) mark
-          (format stream "-~D" conx)
-          (setf mark icon)))
-      cone)))
+       (with-cone (conx icon) cone
+		  (format stream "<CONE ~D" conx)
+		  (do ((mark icon))
+		      ((not (typep mark 'cone))
+		       (format stream " ~A>" mark))
+		    (declare (type gnrt icon))
+		    (with-cone (conx icon) mark
+			       (format stream "-~D" conx)
+			       (setf mark icon)))
+		  cone)))
 
 #|
 ()
@@ -37,25 +37,25 @@
 (DEFUN CONE-CMPR (cmpr0 cmpr1)
   (declare (type cmprf cmpr0 cmpr1))
   (the cmprf
-    (flet ((rslt (gnrt1 gnrt2)
-             (declare (type cone gnrt1 gnrt2))
-             (the cmpr
-               (let ((ind1 (conx gnrt1))
-                     (ind2 (conx gnrt2))
-                     (gnrt11 (icon gnrt1))
-                     (gnrt22 (icon gnrt2)))
-                 (declare
-                  (fixnum ind1 ind2)
-                  (type gnrt gnrt11 gnrt22))
-                 (ecase ind1
-                   (0 (ecase ind2
-                        (0 (funcall cmpr0 gnrt11 gnrt22))
-                        (1 :less)))
-                   (1 (ecase ind2
-                        (0 :greater)
-                        (1 (funcall cmpr1 gnrt11 gnrt22)))))))))
-      (declare (ftype (function (cone cone) cmpr) rslt))
-      #'rslt)))
+       (flet ((rslt (gnrt1 gnrt2)
+		(declare (type cone gnrt1 gnrt2))
+		(the cmpr
+		     (let ((ind1 (conx gnrt1))
+			   (ind2 (conx gnrt2))
+			   (gnrt11 (icon gnrt1))
+			   (gnrt22 (icon gnrt2)))
+		       (declare
+			(fixnum ind1 ind2)
+			(type gnrt gnrt11 gnrt22))
+		       (ecase ind1
+			 (0 (ecase ind2
+			      (0 (funcall cmpr0 gnrt11 gnrt22))
+			      (1 :less)))
+			 (1 (ecase ind2
+			      (0 :greater)
+			      (1 (funcall cmpr1 gnrt11 gnrt22)))))))))
+	 (declare (ftype (function (cone cone) cmpr) rslt))
+	 #'rslt)))
 
 #|
 ()
@@ -73,20 +73,20 @@
 (DEFUN CONE-BASIS (basis0 basis1)
   (declare (type basis basis0 basis1))
   (the basis
-    (progn
-      (when (or (eq basis0 :locally-effective)
-                (eq basis1 :locally-effective))
-        (return-from cone-basis :locally-effective))
-      (flet ((rslt (degr)
-               (declare (type fixnum degr))
-               (the list
-                 (append
-                  (mapcar #'(lambda (item) (con0 item))
-                    (funcall basis0 degr))
-                  (mapcar #'(lambda (item) (con1 item))
-                    (funcall basis1 (1- degr)))))))
-        (declare (ftype (function (fixnum) list) rslt))
-        #'rslt))))
+       (progn
+	 (when (or (eq basis0 :locally-effective)
+		   (eq basis1 :locally-effective))
+	   (return-from cone-basis :locally-effective))
+	 (flet ((rslt (degr)
+		  (declare (type fixnum degr))
+		  (the list
+		       (append
+			(mapcar #'(lambda (item) (con0 item))
+				(funcall basis0 degr))
+			(mapcar #'(lambda (item) (con1 item))
+				(funcall basis1 (1- degr)))))))
+	   (declare (ftype (function (fixnum) list) rslt))
+	   #'rslt))))
 
 #|
 ()
@@ -99,17 +99,17 @@
 (DEFUN TERM-CON0 (term)
   (declare (type term term))
   (the term
-    (term (cffc term)
-          (con0 (gnrt term)))))
+       (term (cffc term)
+	     (con0 (gnrt term)))))
 (DEFUN TERM-CON1 (term)
   (declare (type term term))
   (the term
-    (term (cffc term)
-          (con1 (gnrt term)))))
+       (term (cffc term)
+	     (con1 (gnrt term)))))
 (DEFUN TERM-UNCON (term)
   (declare (type term term))
   (the term
-    (term (cffc term) (icon (gnrt term)))))
+       (term (cffc term) (icon (gnrt term)))))
 
 #|
 ()
@@ -121,16 +121,16 @@
 (DEFUN CMBN-CON0 (cmbn)
   (declare (type cmbn cmbn))
   (the cmbn
-    (make-cmbn
-     :degr (cmbn-degr cmbn)
-     :list (mapcar #'term-con0 (cmbn-list cmbn)))))
+       (make-cmbn
+	:degr (cmbn-degr cmbn)
+	:list (mapcar #'term-con0 (cmbn-list cmbn)))))
 
 (DEFUN CMBN-CON1 (cmbn)
   (declare (type cmbn cmbn))
   (the cmbn
-    (make-cmbn
-     :degr (cmbn-degr cmbn)
-     :list (mapcar #'term-con1 (cmbn-list cmbn)))))
+       (make-cmbn
+	:degr (cmbn-degr cmbn)
+	:list (mapcar #'term-con1 (cmbn-list cmbn)))))
 
 #|
 ()
@@ -141,22 +141,22 @@
 (DEFUN CONE-CMBN-SPLIT (cmbn)
   (declare (type cmbn cmbn))
   (the (values cmbn cmbn)
-    (with-cmbn (degr list) cmbn
-      (let ((list0 +empty-list+)
-            (list1 +empty-list+))
-        (declare (type list list0 list1))
-        (do ((mark list (cdr mark)))
-            ((endp mark)
-             (setf list0 (nreverse list0)
-                   list1 +empty-list+))
-          (declare (type list mark))
-          (when (eql 1 (conx (cdar mark)))
-            (setf list0 (nreverse list0)
-              list1 (mapcar #'term-uncon mark))
-            (return))
-          (push (term-uncon (car mark)) list0))
-        (values (make-cmbn :degr degr :list list0)
-                (make-cmbn :degr (1- degr) :list list1))))))
+       (with-cmbn (degr list) cmbn
+		  (let ((list0 +empty-list+)
+			(list1 +empty-list+))
+		    (declare (type list list0 list1))
+		    (do ((mark list (cdr mark)))
+			((endp mark)
+			 (setf list0 (nreverse list0)
+			       list1 +empty-list+))
+		      (declare (type list mark))
+		      (when (eql 1 (conx (cdar mark)))
+			(setf list0 (nreverse list0)
+			      list1 (mapcar #'term-uncon mark))
+			(return))
+		      (push (term-uncon (car mark)) list0))
+		    (values (make-cmbn :degr degr :list list0)
+			    (make-cmbn :degr (1- degr) :list list1))))))
 
 #|
 ()
@@ -169,10 +169,10 @@
 (DEFUN CONE-2CMBN-APPEND (cmbn0 cmbn1)
   (declare (type cmbn cmbn0 cmbn1))
   (the cmbn
-    (make-cmbn
-     :degr (cmbn-degr cmbn0)
-     :list (append (mapcar #'term-con0 (cmbn-list cmbn0))
-                   (mapcar #'term-con1 (cmbn-list cmbn1))))))
+       (make-cmbn
+	:degr (cmbn-degr cmbn0)
+	:list (append (mapcar #'term-con0 (cmbn-list cmbn0))
+		      (mapcar #'term-con1 (cmbn-list cmbn1))))))
 
 #|
 ()
@@ -182,15 +182,15 @@
 (DEFUN CONE-2MRPH-DIAG-IMPL (mrph0 mrph1)
   (declare (type morphism mrph0 mrph1))
   (the intr-mrph
-    (flet ((rslt (cmbn)
-                 (declare (type cmbn cmbn))
-                 (the cmbn
-                   (multiple-value-bind (cmbn0 cmbn1)
-                       (cone-cmbn-split cmbn)
-                     (declare (type cmbn cmbn0 cmbn1))
-                     (cone-2cmbn-append (? mrph0 cmbn0)
-                                        (? mrph1 cmbn1))))))
-      #'rslt)))
+       (flet ((rslt (cmbn)
+		(declare (type cmbn cmbn))
+		(the cmbn
+		     (multiple-value-bind (cmbn0 cmbn1)
+			 (cone-cmbn-split cmbn)
+		       (declare (type cmbn cmbn0 cmbn1))
+		       (cone-2cmbn-append (? mrph0 cmbn0)
+					  (? mrph1 cmbn1))))))
+	 #'rslt)))
 
 #|
 ()
@@ -202,18 +202,18 @@
 (DEFUN CONE-3MRPH-TRIANGLE-IMPL (cmpr0 mrph0 mrph1 phi)
   (declare (ignore cmpr0) (type morphism mrph0 mrph1 phi))
   (the intr-mrph
-    (flet ((rslt (degr gnrt)
-             (declare (type fixnum degr) (type gnrt gnrt))
-               (the cmbn
-                 (ecase (conx gnrt)
-                   (0 (cmbn-con0 (? mrph0 degr (icon gnrt))))
-                   (1
-                    (let ((gnrt (icon gnrt)))
-                      (declare (type gnrt gnrt))
-                      (cone-2cmbn-append
-                       (? phi (1- degr) gnrt)
-                       (? mrph1 (1- degr) gnrt))))))))
-      #'rslt)))
+       (flet ((rslt (degr gnrt)
+		(declare (type fixnum degr) (type gnrt gnrt))
+		(the cmbn
+		     (ecase (conx gnrt)
+		       (0 (cmbn-con0 (? mrph0 degr (icon gnrt))))
+		       (1
+			(let ((gnrt (icon gnrt)))
+			  (declare (type gnrt gnrt))
+			  (cone-2cmbn-append
+			   (? phi (1- degr) gnrt)
+			   (? mrph1 (1- degr) gnrt))))))))
+	 #'rslt)))
 
 #|
 ()
@@ -224,25 +224,25 @@
 (funcall rslt 4 (con0 '31))
 (funcall rslt 5 (con1 '31))
 (funcall rslt 4 (con1 '15))
-; (funcall rslt (cmbn 4 1 (con0 '31) 1 (con1 '15)))
+; (funcall rslt (cmbn 4 1 (con0 '31) 1 (con1 '15))) ;
 |#
 
 (DEFUN CONE (mrph)
   (declare (type morphism mrph))
   (the chain-complex
-    (let ((chcm0 (trgt mrph))
-          (chcm1 (sorc mrph)))
-      (declare (type chain-complex chcm0 chcm1))
-      (build-chcm
-       :cmpr (cone-cmpr (cmpr chcm0) (cmpr chcm1))
-       :basis (cone-basis (basis chcm0) (basis chcm1))
-       :bsgn (con0 (bsgn chcm0))
-       :intr-dffr (cone-3mrph-triangle-impl (cmpr chcm0)
-                                            (dffr chcm0)
-                                            (n-mrph -1 (dffr chcm1))
-                                            mrph)
-       :strt :gnrt
-       :orgn `(cone ,mrph)))))
+       (let ((chcm0 (trgt mrph))
+	     (chcm1 (sorc mrph)))
+	 (declare (type chain-complex chcm0 chcm1))
+	 (build-chcm
+	  :cmpr (cone-cmpr (cmpr chcm0) (cmpr chcm1))
+	  :basis (cone-basis (basis chcm0) (basis chcm1))
+	  :bsgn (con0 (bsgn chcm0))
+	  :intr-dffr (cone-3mrph-triangle-impl (cmpr chcm0)
+					       (dffr chcm0)
+					       (n-mrph -1 (dffr chcm1))
+					       mrph)
+	  :strt :gnrt
+	  :orgn `(cone ,mrph)))))
 
 #|
 ()
@@ -269,16 +269,16 @@
    (type chain-complex sorc-cone trgt-cone)
    (type morphism mrph0 mrph1))
   (the morphism
-    (progn
-      (unless (= (degr mrph0) (degr mrph1))
-        (error "Non-coherent degrees in CONE-2MRPH-DIAG."))
-      (build-mrph
-       :sorc sorc-cone
-       :trgt trgt-cone
-       :degr (degr mrph0)
-       :intr (cone-2mrph-diag-impl mrph0 mrph1)
-       :strt :cmbn
-       :orgn `(cone-2mrph-diag ,sorc-cone ,trgt-cone ,mrph0 ,mrph1)))))
+       (progn
+	 (unless (= (degr mrph0) (degr mrph1))
+	   (error "Non-coherent degrees in CONE-2MRPH-DIAG."))
+	 (build-mrph
+	  :sorc sorc-cone
+	  :trgt trgt-cone
+	  :degr (degr mrph0)
+	  :intr (cone-2mrph-diag-impl mrph0 mrph1)
+	  :strt :cmbn
+	  :orgn `(cone-2mrph-diag ,sorc-cone ,trgt-cone ,mrph0 ,mrph1)))))
 
 #|
 ()
@@ -293,21 +293,21 @@
    (type chain-complex sorc-cone trgt-cone)
    (type morphism mrph0 mrph1 phi))
   (the morphism
-    (progn
-      (unless (= (degr mrph0) (degr mrph1))
-        (error "Non-coherent degrees in CONE-3MRPH-TRIANGLE."))
-      (unless (= (1+ (degr mrph0)) (degr phi))
-        (error "Non-coherent-degrees in CONE-3MRPH-TRIANGLE."))
-      (build-mrph
-       :sorc sorc-cone
-       :trgt trgt-cone
-       :degr (degr mrph0)
-       :intr (cone-3mrph-triangle-impl
-              (cmpr (trgt phi))
-              mrph0 mrph1 phi)
-       :strt :gnrt
-       :orgn `(cone-3mrph-triangle ,sorc-cone ,trgt-cone
-                                    ,mrph0 ,mrph1 ,phi)))))
+       (progn
+	 (unless (= (degr mrph0) (degr mrph1))
+	   (error "Non-coherent degrees in CONE-3MRPH-TRIANGLE."))
+	 (unless (= (1+ (degr mrph0)) (degr phi))
+	   (error "Non-coherent-degrees in CONE-3MRPH-TRIANGLE."))
+	 (build-mrph
+	  :sorc sorc-cone
+	  :trgt trgt-cone
+	  :degr (degr mrph0)
+	  :intr (cone-3mrph-triangle-impl
+		 (cmpr (trgt phi))
+		 mrph0 mrph1 phi)
+	  :strt :gnrt
+	  :orgn `(cone-3mrph-triangle ,sorc-cone ,trgt-cone
+				      ,mrph0 ,mrph1 ,phi)))))
 
 #|
 ()
@@ -330,39 +330,38 @@
 (DEFUN CONE-EFHM (cone)
   (declare (type chain-complex cone))
   (the homotopy-equivalence
-    (let* ((phi (second (orgn cone)))
-           (chcm0 (trgt phi)) (chcm1 (sorc phi))
-           (efhm0 (efhm chcm0)) (efhm1 (efhm chcm1))
-           (lf0 (lf efhm0)) (lg0 (lg efhm0)) (lh0 (lh efhm0))
-           (rf0 (rf efhm0)) (rg0 (rg efhm0)) (rh0 (rh efhm0))
-           (lf1 (lf efhm1)) (lg1 (lg efhm1)) (lh1 (lh efhm1))
-           (rf1 (rf efhm1)) (rg1 (rg efhm1)) (rh1 (rh efhm1))
-           (hphi (cmps lg0 (cmps phi lf1)))
-           (ephi (cmps rf0 (cmps hphi rg1)))
-           (hcone (cone hphi))
-           (econe (cone ephi))
-           (LF (cone-2mrph-diag hcone cone lf0 lf1))
-           (LG (cone-2mrph-diag cone hcone lg0 lg1))
-           (LH (cone-2mrph-diag hcone hcone lh0 (n-mrph -1 lh1)))
-           (RF (cone-3mrph-triangle hcone econe rf0 rf1
-                 (cmps rf0 (cmps hphi rh1))))
-           (RG (cone-3mrph-triangle econe hcone rg0 rg1
-                 (n-mrph -1 (cmps rh0 (cmps hphi rg1)))))
-           (RH (cone-3mrph-triangle hcone hcone rh0 (n-mrph -1 rh1)
-                 (cmps rh0 (cmps hphi rh1)))))
-      (declare
-       (type chain-complex chcm0 chcm1 hcone econe)
-       (type morphism phi lf0 lg0 lh0 rf0 rg0 rh0 lf1 lg1 lh1 rf1 rg1 rh1
-                      hphi ephi LF LG LH RF RG RH))
-      (build-hmeq
-       :lrdct (build-rdct :f LF :g LG :h LH
-                          :orgn `(cone-efhm ,cone lrdct))
-       :rrdct (build-rdct :f RF :g RG :h RH
-                          :orgn `(cone-efhm ,cone rrdct))
-       :orgn `(cone-efhm ,cone)))))
+       (let* ((phi (second (orgn cone)))
+	      (chcm0 (trgt phi)) (chcm1 (sorc phi))
+	      (efhm0 (efhm chcm0)) (efhm1 (efhm chcm1))
+	      (lf0 (lf efhm0)) (lg0 (lg efhm0)) (lh0 (lh efhm0))
+	      (rf0 (rf efhm0)) (rg0 (rg efhm0)) (rh0 (rh efhm0))
+	      (lf1 (lf efhm1)) (lg1 (lg efhm1)) (lh1 (lh efhm1))
+	      (rf1 (rf efhm1)) (rg1 (rg efhm1)) (rh1 (rh efhm1))
+	      (hphi (cmps lg0 (cmps phi lf1)))
+	      (ephi (cmps rf0 (cmps hphi rg1)))
+	      (hcone (cone hphi))
+	      (econe (cone ephi))
+	      (LF (cone-2mrph-diag hcone cone lf0 lf1))
+	      (LG (cone-2mrph-diag cone hcone lg0 lg1))
+	      (LH (cone-2mrph-diag hcone hcone lh0 (n-mrph -1 lh1)))
+	      (RF (cone-3mrph-triangle hcone econe rf0 rf1
+				       (cmps rf0 (cmps hphi rh1))))
+	      (RG (cone-3mrph-triangle econe hcone rg0 rg1
+				       (n-mrph -1 (cmps rh0 (cmps hphi rg1)))))
+	      (RH (cone-3mrph-triangle hcone hcone rh0 (n-mrph -1 rh1)
+				       (cmps rh0 (cmps hphi rh1)))))
+	 (declare
+	  (type chain-complex chcm0 chcm1 hcone econe)
+	  (type morphism phi lf0 lg0 lh0 rf0 rg0 rh0 lf1 lg1 lh1 rf1 rg1 rh1
+		hphi ephi LF LG LH RF RG RH))
+	 (build-hmeq
+	  :lrdct (build-rdct :f LF :g LG :h LH
+			     :orgn `(cone-efhm ,cone lrdct))
+	  :rrdct (build-rdct :f RF :g RG :h RH
+			     :orgn `(cone-efhm ,cone rrdct))
+	  :orgn `(cone-efhm ,cone)))))
 
 (DEFMETHOD SEARCH-EFHM (chcm (orgn (eql 'cone)))
   (declare (type chain-complex chcm))
   (the homotopy-equivalence
-    (cone-efhm chcm)))
-
+       (cone-efhm chcm)))
diff --git a/src/macros.lisp b/src/macros.lisp
index f2350b3..f4b38b2 100644
--- a/src/macros.lisp
+++ b/src/macros.lisp
@@ -352,12 +352,18 @@
          ,@body))))
 
 (DEFMACRO BCNB (gnrt)
+  "(BCNB GNRT) returns the representation of the generator GNRT belonging to the
+chain complex B."
   `(make-bicn :bcnx :bcnb :ibicn ,gnrt))
 
 (DEFMACRO BCNC (gnrt)
+  "(BCNC GNRT) returns the representation of the generator GNRT belonging to the
+chain complex C."
   `(make-bicn :bcnx :bcnc :ibicn ,gnrt))
 
 (DEFMACRO BCND (gnrt)
+  "(BCND GNRT) returns the representation of the generator GNRT belonging to the
+chain complex D."
   `(make-bicn :bcnx :bcnd :ibicn ,gnrt))
 
 (DEFMACRO WITH-BICN ((bcnx ibicn) bicn . body)
diff --git a/test/bicones-test.lisp b/test/bicones-test.lisp
new file mode 100644
index 0000000..2158ad5
--- /dev/null
+++ b/test/bicones-test.lisp
@@ -0,0 +1,118 @@
+
+(in-package :kenzo-test)
+
+(in-suite :kenzo)
+
+(test bicn-cmbn
+      (let* ((comb-bic (cat:cmbn 3 2 (cat:bcnb 'b1) 4 (cat:bcnb 'b2)
+				 6 (cat:bcnb 'b3) 3 (cat:bcnc 'c1)
+				 5 (cat:bcnc 'c2) 7 (cat:bcnd 'd1))))
+	(cat:cmbn-list comb-bic)
+	(cat:dispatch-bicn-cmbn (cat:cmbn 3 3 (cat:bcnb 'b1)
+					  4 (cat:bcnb 'b2)
+					  33 (cat:bcnc 'c)
+					  333 (cat:bcnd 'd)))))
+
+(test bicn-cmbn-cmbn*
+      (is (cat:cmbn-non-zero-p
+	   (cat:bicn-cmbn-cmbnb (cat:cmbn 3 1 (cat:bcnb 'a) 2 (cat:bcnc 'b)))))
+      (is (cat:cmbn-zero-p
+	   (cat:bicn-cmbn-cmbnb (cat:cmbn 3 2 (cat:bcnc 'b)))))
+      (is (cat:cmbn-non-zero-p
+	   (cat:bicn-cmbn-cmbnc (cat:cmbn 3 1 (cat:bcnb 'a) 2 (cat:bcnc 'b)
+					  3 (cat:bcnd 'c)))))
+      (is (cat:cmbn-zero-p
+	   (cat:bicn-cmbn-cmbnc (cat:cmbn 3 1 (cat:bcnb 'a) 3 (cat:bcnd 'c)))))
+      (is (cat:cmbn-non-zero-p
+	   (cat:bicn-cmbn-cmbnd (cat:cmbn 3 1 (cat:bcnb 'a) 2 (cat:bcnc 'b)
+					  3 (cat:bcnd 'c)))))
+      (is (cat:cmbn-zero-p
+	   (cat:bicn-cmbn-cmbnd (cat:cmbn 3 2 (cat:bcnb 'b))))))
+
+(test make-bicn-cmbn
+      (multiple-value-call #'cat:make-bicn-cmbn
+	(cat:dispatch-bicn-cmbn
+	 (cat:cmbn 3 3 (cat:bcnb 'b1) 4 (cat:bcnb 'b2) 33 (cat:bcnc 'c)
+		   333 (cat:bcnd 'd)))))
+
+(test bicn-print
+      (let ((a (format nil "~A" (cat:bcnb 'a)))
+	    (b (format nil "~A" (cat:bcnc 'b)))
+	    (c (format nil "~A" (cat:bcnd 'c))))
+	(is (string= a "<BcnB A>"))
+	(is (string= b "<BcnC B>"))
+	(is (string= c "<BcnD C>"))))
+
+(test bicone-cmpr
+      (let ((r (cat:bicone-cmpr #'cat:f-cmpr #'cat:f-cmpr #'cat:f-cmpr)))
+	(is (equal :less (funcall r (cat:bcnb 1) (cat:bcnc 0))))
+	(is (equal :less (funcall r (cat:bcnb 1) (cat:bcnb 2))))))
+
+(test bicone-basis
+      (is (equal :locally-effective
+		 (cat:bicone-basis :locally-effective
+				   :locally-effective
+				   :locally-effective)))
+      (let* ((b #'(lambda (degr)
+		    (mapcar #'(lambda (item)
+				(cons degr item)) (cat:<a-b> 0 degr))))
+	     (r (cat:bicone-basis b b b)))
+	(is (not (null (funcall r 3))))))
+
+
+(test bicone
+      (progn
+	(cat:cat-init)
+	(let ((delta3 (cdelta1 3))
+	      (bic (cat:bicone (make-rdct1 3 2) (make-rdct1 4 2))))
+	  #|
+	  (princ (cat:basis delta3 0))
+	  (princ (cat:basis delta3 1))
+	  (princ (cat:basis delta3 2))
+	  (princ (cat:basis delta3 3))
+	  (princ (cat:basis delta3 4))
+	  |#
+	  (princ (cat:basis bic 0))
+	  (princ (cat:basis bic 1))
+	  (princ (cat:basis bic 4))
+	  (princ (cat:? bic (cat:cmbn 2 3 (cat:bcnb '(0 1 3))
+				      4 (cat:bcnc '(0 1 2 3))
+				      5 (cat:bcnd '(0 1 4)))))
+	  (is (cat:cmbn-zero-p
+	       (cat:? bic
+		      (cat:? bic (cat:cmbn 2 3 (cat:bcnb '(0 1 3))
+					   4 (cat:bcnc '(0 1 2 3))
+					   5 (cat:bcnd '(0 1 4))))))))))
+
+
+(test cmps
+      (progn
+	(cat:cat-init)
+	(let* ((c (cat:build-chcm
+		  :cmpr #'cat:s-cmpr
+		  :basis #'(lambda (dmns) '(a))
+		  :bsgn 'a
+		  :intr-dffr #'cat:zero-intr-dffr
+		  :strt :cmbn
+		  :orgn '(c)))
+	       (h1 (cat:trivial-hmeq c))
+	       (h2 (cat:cmps h1 h1))
+	       (h3 (cat:cmps h2 h2)))
+	  (cat:pre-check-rdct (cat:lrdct h2))
+	  (setf cat:*tc* (cat:cmbn 3 1 (cat:bcnB 'a) 10 (cat:bcnC 'a)
+			       100 (cat:bcnD 'a)))
+	  (setf cat:*bc* (cat:cmbn 3 1 'a))
+	  (check-rdct)
+	  (cat:pre-check-rdct (cat:rrdct h2))
+	  (check-rdct)
+	  (setf cat:*tc* (cat:cmbn 3 1 (cat:bcnB (cat:bcnB 'a))
+				   10 (cat:bcnB (cat:bcnC 'a))
+				   100 (cat:bcnB (cat:bcnD 'a))
+				   1000 (cat:bcnC 'a)
+				   10000 (cat:bcnD (cat:bcnB 'a))
+				   5234 (cat:bcnD (cat:bcnC 'a))
+				   223 (cat:bcnD (cat:bcnD 'a))))
+	  (cat:pre-check-rdct (cat:lrdct h3))
+	  (check-rdct)
+	  (cat:pre-check-rdct (cat:rrdct h3))
+	  (check-rdct))))
diff --git a/test/chain-complexes-test.lisp b/test/chain-complexes-test.lisp
index bb79b4d..54703ad 100644
--- a/test/chain-complexes-test.lisp
+++ b/test/chain-complexes-test.lisp
@@ -45,20 +45,7 @@
 	  (is (equal (cat:cmbn-list comb) (cons (cons 1 n) nil))))))))
 
 
-(defparameter *n* 10)
-(defun ff (degr i)
-  (do ((2*n* (ash *n* 1))
-       (rslt cat:+empty-list+
-             (cons (cons (let ((cffc (- (random 2*n*) *n*)))
-                           (if (minusp cffc) cffc (1+ cffc)))
-                         (decf gnrt (1+ (random *n*))))
-                   rslt))
-       (gnrt i)
-       (k 0 (1+ k)))
-      ((= k *n*)
-       (cat:make-cmbn
-        :degr degr
-        :list rslt))))
+(setf *n* 10)
 
 (test cmbn-?
   (progn
diff --git a/test/chcm-elementary-op-test.lisp b/test/chcm-elementary-op-test.lisp
index a3fef10..797e0e2 100644
--- a/test/chcm-elementary-op-test.lisp
+++ b/test/chcm-elementary-op-test.lisp
@@ -44,20 +44,7 @@
 	  (is (eq -zi -zi2)))))
 
 
-(defparameter *n* 5)
-(defun ff (degr i)
-  (do ((2*n* (ash *n* 1))
-       (rslt cat:+empty-list+
-	     (cons (cons (let ((cffc (- (random 2*n*) *n*)))
-			   (if (minusp cffc) cffc (1+ cffc)))
-			 (decf gnrt (1+ (random *n*))))
-		   rslt))
-       (gnrt i)
-       (k 0 (1+ k)))
-      ((= k *n*)
-       (cat:make-cmbn
-	:degr degr
-	:list rslt))))
+(setf *n* 5)
 
 (test cmps
       (progn
diff --git a/test/common.lisp b/test/common.lisp
new file mode 100644
index 0000000..f525170
--- /dev/null
+++ b/test/common.lisp
@@ -0,0 +1,170 @@
+
+(in-package :kenzo-test)
+
+(def-suite :kenzo)
+
+(defparameter *n* -1)
+
+(defun ff (degr i)
+  (declare (special *n*))
+  (do ((2*n* (ash *n* 1))
+       (rslt cat:+empty-list+
+             (cons (cons (let ((cffc (- (random 2*n*) *n*)))
+                           (if (minusp cffc) cffc (1+ cffc)))
+                         (decf gnrt (1+ (random *n*))))
+                   rslt))
+       (gnrt i)
+       (k 0 (1+ k)))
+      ((= k *n*)
+       (cat:make-cmbn :degr degr :list rslt))))
+
+
+(defun cdelta (dmns)
+  (the cat:chain-complex
+       (cat:build-chcm
+	:cmpr #'cat:l-cmpr
+	:basis :locally-effective
+	:bsgn '(0)
+	:intr-dffr #'(lambda (degr gmsm)
+		       (cat:make-cmbn
+			:degr (1- degr)
+			:list (do ((rslt cat:+empty-list+
+					 (cons (cons sign
+						     (append
+						      (subseq gmsm 0 nark)
+						      (subseq gmsm (1+ nark))))
+					       rslt))
+				   (sign 1 (- sign))
+				   (nark 0 (1+ nark)))
+				  ((> nark degr) rslt))))
+	:strt :gnrt
+	:orgn `(locally effective version of C_* delta ,dmns))))
+
+
+(defun make-f (tdmns bdmns)
+  (cat:build-mrph
+   :sorc (cdelta tdmns) :trgt (cdelta bdmns) :degr 0
+   :intr #'(lambda (degr gmsm)
+	     (let ((pos (position-if #'(lambda (vertex)
+					 (>= vertex bdmns)) gmsm)))
+	       (if pos
+		   (if (< pos degr)
+		       (cat:zero-cmbn degr)
+		       (cat:cmbn degr 1 (nconc (butlast gmsm) (list bdmns))))
+		   (cat:cmbn degr 1 gmsm))))
+   :strt :gnrt
+   :orgn `(projection delta ,tdmns => delta ,bdmns)))
+
+
+(defun make-g (tdmns bdmns)
+  (cat:build-mrph
+   :sorc (cdelta bdmns) :trgt (cdelta tdmns) :degr 0
+   :intr #'identity
+   :strt :cmbn
+   :orgn `(injection delta ,bdmns => delta ,tdmns)))
+
+
+(defun make-h (tdmns bdmns)
+  (cat:build-mrph
+   :sorc (cdelta tdmns) :trgt (cdelta tdmns) :degr +1
+   :intr #'(lambda (degr gmsm)
+	     (let ((pos (position-if #'(lambda (vertex)
+					 (>= vertex bdmns)) gmsm)))
+	       (if pos
+		   (if (member bdmns gmsm)
+		       (cat:zero-cmbn (1+ degr))
+		       (cat:cmbn (1+ degr) (cat:-1-expt-n pos)
+				 (append (subseq gmsm 0 pos) (list bdmns)
+					 (subseq gmsm pos))))
+		   (cat:zero-cmbn (1+ degr)))))
+   :strt :gnrt
+   :orgn `(homotopy for delta ,tdmns => ,bdmns)))
+
+
+(defun make-rdct (tdmns bdmns)
+  (let ((rdct (cat:build-rdct
+	      :f (make-f tdmns bdmns)
+	      :g (make-g tdmns bdmns)
+	      :h (make-h tdmns bdmns)
+	      :orgn `(reduction delta ,tdmns ,bdmns))))
+    rdct))
+
+(defun cdelta1 (dmns)
+  (cat:build-chcm
+   :cmpr #'cat:l-cmpr
+   :basis #'(lambda (n)
+	      (mapcar #'cat:dlop-int-ext (funcall (cat:delta-n-basis dmns) n)))
+   :bsgn '(0)
+   :intr-dffr #'(lambda (degr gmsm)
+		  (cat:make-cmbn
+		   :degr (1- degr)
+		   :list (do ((rslt cat:+empty-list+
+				    (cons (cons sign (append
+						      (subseq gmsm 0 nark)
+						      (subseq gmsm (1+ nark))))
+					  rslt))
+			      (sign 1 (- sign))
+			      (nark 0 (1+ nark)))
+			     ((> nark degr) rslt))))
+   :strt :gnrt
+   :orgn `(locally effective version of C_* delta ,dmns)))
+
+(defun make-f1 (tdmns bdmns)
+  (cat:build-mrph
+   :sorc (cdelta1 tdmns) :trgt (cdelta1 bdmns) :degr 0
+   :intr #'(lambda (degr gmsm)
+	     (let ((pos (position-if #'(lambda (vertex)
+					 (>= vertex bdmns)) gmsm)))
+	       (if pos
+		   (if (< pos degr)
+		       (cat:zero-cmbn degr)
+		       (cat:cmbn degr 1 (nconc (butlast gmsm) (list bdmns))))
+		   (cat:cmbn degr 1 gmsm))))
+   :strt :gnrt
+   :orgn `(projection delta ,tdmns => delta ,bdmns)))
+
+
+(defun make-g1 (tdmns bdmns)
+  (cat:build-mrph
+   :sorc (cdelta1 bdmns) :trgt (cdelta1 tdmns) :degr 0
+   :intr #'identity
+   :strt :cmbn
+   :orgn `(injection delta ,bdmns => delta ,tdmns)))
+
+
+(defun make-h1 (tdmns bdmns)
+  (cat:build-mrph
+   :sorc (cdelta1 tdmns) :trgt (cdelta1 tdmns) :degr +1
+   :intr #'(lambda (degr gmsm)
+	     (let ((pos (position-if #'(lambda (vertex)
+					 (>= vertex bdmns)) gmsm)))
+	       (if pos
+		   (if (member bdmns gmsm)
+		       (cat:zero-cmbn (1+ degr))
+		       (cat:cmbn (1+ degr) (cat:-1-expt-n pos)
+				 (append (subseq gmsm 0 pos) (list bdmns)
+					 (subseq gmsm pos))))
+		   (cat:zero-cmbn (1+ degr)))))
+   :strt :gnrt
+   :orgn `(homotopy for delta ,tdmns => ,bdmns)))
+
+
+(defun make-rdct1 (tdmns bdmns)
+  (let ((rdct (cat:build-rdct
+	      :f (make-f1 tdmns bdmns)
+	      :g (make-g1 tdmns bdmns)
+	      :h (make-h1 tdmns bdmns)
+	      :orgn `(reduction delta ,tdmns ,bdmns))))
+    rdct))
+
+
+(defun check-rdct ()
+  (dolist (phi '(cat:*tdd* cat:*bdd* cat:*df-fd* cat:*dg-gd* cat:*id-fg*
+		 cat:*id-gf-dh-hd* cat:*hh* cat:*fh* cat:*hg*))
+    (declare (type symbol phi))
+    (is (cat:cmbn-zero-p
+	 (cat:cmbn-? (eval phi)
+		     (if (member phi '(cat:*bdd* cat:*dg-gd* cat:*id-fg*
+				       cat:*dg-gd* cat:*hg*))
+			 cat:*bc*
+			 cat:*tc*))))))
diff --git a/test/effective-homology-test.lisp b/test/effective-homology-test.lisp
index 99190b7..45ad1d6 100644
--- a/test/effective-homology-test.lisp
+++ b/test/effective-homology-test.lisp
@@ -3,27 +3,6 @@
 
 (in-suite :kenzo)
 
-(defun cdelta (dmns)
-  (the cat:chain-complex
-       (cat:build-chcm
-	:cmpr #'cat:l-cmpr
-	:basis :locally-effective
-	:bsgn '(0)
-	:intr-dffr #'(lambda (degr gmsm)
-		       (cat:make-cmbn
-			:degr (1- degr)
-			:list (do ((rslt cat:+empty-list+
-					 (cons (cons sign
-						     (append
-						      (subseq gmsm 0 nark)
-						      (subseq gmsm (1+ nark))))
-					       rslt))
-				   (sign 1 (- sign))
-				   (nark 0 (1+ nark)))
-				  ((> nark degr) rslt))))
-	:strt :gnrt
-	:orgn `(locally effective version of C_* delta ,dmns))))
-
 (test cdelta
       (progn
 	(cat:cat-init)
@@ -38,63 +17,6 @@
 	  (signals simple-error (equal (cat:basis cc 5) cat:+empty-list+)))))
 
 
-(defun make-f (tdmns bdmns)
-  (cat:build-mrph
-   :sorc (cdelta tdmns) :trgt (cdelta bdmns) :degr 0
-   :intr #'(lambda (degr gmsm)
-	     (let ((pos (position-if #'(lambda (vertex)
-					 (>= vertex bdmns)) gmsm)))
-	       (if pos
-		   (if (< pos degr)
-		       (cat:zero-cmbn degr)
-		       (cat:cmbn degr 1 (nconc (butlast gmsm) (list bdmns))))
-		   (cat:cmbn degr 1 gmsm))))
-   :strt :gnrt
-   :orgn `(projection delta ,tdmns => delta ,bdmns)))
-
-(defun make-g (tdmns bdmns)
-  (cat:build-mrph
-   :sorc (cdelta bdmns) :trgt (cdelta tdmns) :degr 0
-   :intr #'identity
-   :strt :cmbn
-   :orgn `(injection delta ,bdmns => delta ,tdmns)))
-
-(defun make-h (tdmns bdmns)
-  (cat:build-mrph
-   :sorc (cdelta tdmns) :trgt (cdelta tdmns) :degr +1
-   :intr #'(lambda (degr gmsm)
-	     (let ((pos (position-if #'(lambda (vertex)
-					 (>= vertex bdmns)) gmsm)))
-	       (if pos
-		   (if (member bdmns gmsm)
-		       (cat:zero-cmbn (1+ degr))
-		       (cat:cmbn (1+ degr) (cat:-1-expt-n pos)
-				 (append (subseq gmsm 0 pos) (list bdmns)
-					 (subseq gmsm pos))))
-		   (cat:zero-cmbn (1+ degr)))))
-   :strt :gnrt
-   :orgn `(homotopy for delta ,tdmns => ,bdmns)))
-
-(defun make-rdct (tdmns bdmns)
-  (let ((rdct (cat:build-rdct
-	      :f (make-f tdmns bdmns)
-	      :g (make-g tdmns bdmns)
-	      :h (make-h tdmns bdmns)
-	      :orgn `(reduction delta ,tdmns ,bdmns))))
-    rdct))
-
-
-(defun check-rdct ()
-  (dolist (phi '(cat:*tdd* cat:*bdd* cat:*df-fd* cat:*dg-gd* cat:*id-fg*
-		 cat:*id-gf-dh-hd* cat:*hh* cat:*fh* cat:*hg*))
-    (declare (type symbol phi))
-    (is (cat:cmbn-zero-p
-	 (cat:cmbn-? (eval phi)
-		     (if (member phi '(cat:*bdd* cat:*dg-gd* cat:*id-fg*
-				       cat:*dg-gd* cat:*hg*))
-			 cat:*bc*
-			 cat:*tc*))))))
-
 (test make-rdct
       (progn
 	(cat:cat-init)
@@ -106,6 +28,7 @@
 	  (setf cat:*bc* (cat:cmbn 3 4 '(0 1 2 3)))
 	  (check-rdct))))
 
+
 (test cmps
       (progn
 	(cat:cat-init)
@@ -118,6 +41,7 @@
 	  (setf cat:*bc* (cat:cmbn 2 1 '(0 1 3)))
 	  (check-rdct))))
 
+
 (test zero-mrph
       (progn
 	(cat:cat-init)
@@ -129,6 +53,7 @@
 	  (setf cat:*bc* (cat:cmbn 3 4 '(0 1 2 3)))
 	  (check-rdct))))
 
+
 (test opps
       (progn
 	(cat:cat-init)
@@ -140,6 +65,7 @@
 	  (setf cat:*bc* (cat:cmbn 3 4 '(0 1 2 3)))
 	  (check-rdct))))
 
+
 ;; an absurd reduction ; just to test bpl-*-sigma
 (test bpl-*-sigma
       (progn
@@ -175,6 +101,7 @@
 	  (cat:gnrt-? (cat:dffr (cat:tcc new-rdct)) 3 '(3 5))
 	  (cat:gnrt-? (cat:dffr (cat:bcc new-rdct)) 3 '(3 5)))))
 
+
 (test trivial-hmeq
       (progn
 	(cat:cat-init)