diff --git a/kenzo-test.asd b/kenzo-test.asd
index 1ff5fdd..e1a9f1b 100644
--- a/kenzo-test.asd
+++ b/kenzo-test.asd
@@ -9,6 +9,7 @@
   :pathname #P"test/"
   :components ((:file "package")
 	       (:file "common")
+	       #|
 	       (:file "combinations-test")
 	       (:file "various-test")
 	       (:file "chain-complexes-test")
@@ -24,4 +25,6 @@
 	       (:file "bar-test")
 	       (:file "cartesian-products-test")
 	       (:file "cones-test")
-	       (:file "cl-space-efhm-test")))
+	       (:file "cl-space-efhm-test")
+	       |#
+	       (:file "tensor-products-test")))
diff --git a/package.lisp b/package.lisp
index 3f6b784..2e147ce 100644
--- a/package.lisp
+++ b/package.lisp
@@ -19,6 +19,7 @@
            *LIST-LIST*
 	   *TC*
 	   *TDD*
+	   *TNPR-WITH-DEGREES*
 
 	   ;; bar.lisp
 
@@ -88,6 +89,7 @@
 
 	   ;; cl-space-efhm.lisp
 
+	   CS-HAT-T-U
 	   CS-HAT-U-T
 
 	   ;; classes.lisp
@@ -118,6 +120,7 @@
 	   ORGN
 	   REDUCTION
 	   RRDCT
+	   SORC
 	   TCC
 	   TNPR
 
@@ -258,6 +261,16 @@
 	   SPHERE
 	   BUILD-FINITE-SS
 
+	   ;; tensor-products.lisp
+
+	   2CMBN-TNPR
+	   TNSR-PRDC
+	   TNSR-PRDC-BASIS
+	   TNSR-PRDC-CMPR
+	   TNSR-PRDC-INTR
+	   TNSR-PRDC-INTR-DFFR
+	   TNPR-PRINT
+
 	   ;; various.lisp
 
 	   +EMPTY-LIST+
diff --git a/run-kenzo-test.lisp b/run-kenzo-test.lisp
index 9a872ef..af1dcd3 100644
--- a/run-kenzo-test.lisp
+++ b/run-kenzo-test.lisp
@@ -1,3 +1,6 @@
+
+(DECLAIM (OPTIMIZE (speed 0) (space 0) (debug 3)))
+
 (require 'asdf)
 
 (asdf:operate 'asdf:load-op 'kenzo-test)
diff --git a/src/kenzo.lisp b/src/kenzo.lisp
index 77753f1..555f0ef 100644
--- a/src/kenzo.lisp
+++ b/src/kenzo.lisp
@@ -7,7 +7,6 @@
   (values))
 
 ;;(PROCLAIM '(OPTIMIZE (speed 3) (safety 1) (space 0) (debug 0)))
-(DECLAIM (OPTIMIZE (speed 0) (space 0) (debug 3)))
 
 ;; Don't mess with ANSI's definition of DEFCONSTANT!
 
diff --git a/src/tensor-products.lisp b/src/tensor-products.lisp
index 7da7b06..17dcba8 100644
--- a/src/tensor-products.lisp
+++ b/src/tensor-products.lisp
@@ -12,351 +12,252 @@
    (type tnpr tnpr) (stream stream)
    (ignore depth))
   (the tnpr
-    (progn
-      (with-tnpr (degr1 gnrt1 degr2 gnrt2) tnpr
-                 (format stream
-                     "<TnPr~:[~*~; ~D~] ~A~:[~*~; ~D~] ~A>"
-                   *tnpr-with-degrees* degr1 gnrt1
-                   *tnpr-with-degrees* degr2 gnrt2))
-      tnpr)))
+       (progn
+	 (with-tnpr (degr1 gnrt1 degr2 gnrt2) tnpr
+		    (format stream
+			    "<TnPr~:[~*~; ~D~] ~A~:[~*~; ~D~] ~A>"
+			    *tnpr-with-degrees* degr1 gnrt1
+			    *tnpr-with-degrees* degr2 gnrt2))
+	 tnpr)))
 
 
-
-#|
-  (tnpr 2 'a 3 'b)
-  (setf *tnpr-with-degrees* t)    
-  (tnpr 2 'a 3 'b)
-  (setf *tnpr-with-degrees* nil)
-|#
-
 (DEFUN 2CMBN-TNPR (cmbn1 cmbn2)
-   (declare (type cmbn cmbn1 cmbn2))
-   (the cmbn
-      (with-cmbn (degr1 list1) cmbn1
-      (with-cmbn (degr2 list2) cmbn2
-         (make-cmbn
-            :degr (+ degr1 degr2)
-            :list (mapcan
-                     #'(lambda (term1)
-                          (declare (type term term1))
-                          (the list
-                             (with-term (cffc1 gnrt1) term1
-                                (mapcar
-                                   #'(lambda (term2)
-                                        (declare (type term term2))
-                                        (the term
-                                           (term
-                                              (* cffc1 (cffc term2))
-                                              (tnpr degr1 gnrt1 degr2 (gnrt term2)))))
-                                   list2))))
-                     list1))))))
-#|
-  (setf *tnpr-with-degrees* t)
-  (2cmbn-tnpr (cmbn 2 3 'a 4 'b -5 'c) (cmbn 3 4 'x -3 'y 2 'z)))
-|#
-
+  (declare (type cmbn cmbn1 cmbn2))
+  (the cmbn
+       (with-cmbn
+	   (degr1 list1) cmbn1
+	   (with-cmbn
+	       (degr2 list2) cmbn2
+	       (make-cmbn
+		:degr (+ degr1 degr2)
+		:list (mapcan
+		       #'(lambda (term1)
+			   (declare (type term term1))
+			   (the list
+				(with-term
+				    (cffc1 gnrt1) term1
+				    (mapcar
+				     #'(lambda (term2)
+					 (declare (type term term2))
+					 (the term
+					      (term
+					       (* cffc1 (cffc term2))
+					       (tnpr degr1 gnrt1 degr2
+						     (gnrt term2)))))
+				     list2))))
+		       list1))))))
 
 #|
 (DEFUN TNSR-PRDC-CMPR (cmpr1 cmpr2)
-   (declare (type cmprf cmpr1 cmpr2))
-   (flet ((rslt (tnpr1 tnpr2)
-             (declare (type tnpr tnpr1 tnpr2))
-             (let ((left-cons-1 (cadr tnpr1))
-                   (left-cons-2 (cadr tnpr2)))
-                (declare (cons left-cons-1 left-cons-2))
-                (lexico
-                   (f-cmpr (car left-cons-1) (car left-cons-2))
-                   (funcall cmpr1 (cdr left-cons-1) (cdr left-cons-2))
-                   (funcall cmpr2 (gnrt2 tnpr1) (gnrt2 tnpr2))))))
-      (the cmprf #'rslt)))
+  (declare (type cmprf cmpr1 cmpr2))
+  (flet ((rslt (tnpr1 tnpr2)
+	   (declare (type tnpr tnpr1 tnpr2))
+	   (let ((left-cons-1 (cadr tnpr1))
+		 (left-cons-2 (cadr tnpr2)))
+	     (declare (cons left-cons-1 left-cons-2))
+	     (lexico
+	      (f-cmpr (car left-cons-1) (car left-cons-2))
+	      (funcall cmpr1 (cdr left-cons-1) (cdr left-cons-2))
+	      (funcall cmpr2 (gnrt2 tnpr1) (gnrt2 tnpr2))))))
+    (the cmprf #'rslt)))
 |#
 (DEFUN TNSR-PRDC-CMPR (cmpr1 cmpr2)
   (declare (type cmprf cmpr1 cmpr2))
   (flet ((rslt (tnpr1 tnpr2)
            (declare (type tnpr tnpr1 tnpr2))
            (the cmpr
-             (lexico
-              (f-cmpr (degr1 tnpr1) (degr1 tnpr2))
-              (funcall cmpr1 (gnrt1 tnpr1) (gnrt1 tnpr2))
-              (funcall cmpr2 (gnrt2 tnpr1) (gnrt2 tnpr2))))))
+		(lexico
+		 (f-cmpr (degr1 tnpr1) (degr1 tnpr2))
+		 (funcall cmpr1 (gnrt1 tnpr1) (gnrt1 tnpr2))
+		 (funcall cmpr2 (gnrt2 tnpr1) (gnrt2 tnpr2))))))
     (the cmprf #'rslt)))
 
 
-#|
-  (setf cmpr (tnsr-prdc-cmpr #'s-cmpr #'s-cmpr))
-  (funcall cmpr (tnpr 2 'a 3 'b) (tnpr 3 'a 2 'b))
-  (funcall cmpr (tnpr 3 'a 2 'b) (tnpr 2 'a 3 'b))
-  (funcall cmpr (tnpr 2 'a 3 'b) (tnpr 2 'b 3 'b))
-  (funcall cmpr (tnpr 2 'b 3 'b) (tnpr 2 'a 3 'b))
-  (funcall cmpr (tnpr 2 'a 3 'a) (tnpr 2 'a 3 'b))
-  (funcall cmpr (tnpr 2 'a 3 'c) (tnpr 2 'a 3 'b))
-  (funcall cmpr (tnpr 2 'a 3 'b) (tnpr 2 'a 3 'b)))
-|#
-
 (DEFUN TNSR-PRDC-BASIS (basis1 basis2)
-   (declare (type basis basis1 basis2))
-   (when (or (eq basis1 :locally-effective)
-             (eq basis2 :locally-effective))
-      (return-from tnsr-prdc-basis :locally-effective))
-   (flet ((rslt (degr)
-             (declare (fixnum degr))
-             (the list
+  (declare (type basis basis1 basis2))
+  (when (or (eq basis1 :locally-effective)
+	    (eq basis2 :locally-effective))
+    (return-from tnsr-prdc-basis :locally-effective))
+  (flet ((rslt (degr)
+	   (declare (fixnum degr))
+	   (the list
                 (progn
-                   (when (minusp degr)
-                      (return-from rslt +empty-list+))
-                   (mapcan
-                      #'(lambda (degr1)
-                           (declare (fixnum degr1))
-                           (let* ((basis1 (funcall basis1 degr1))
-                                  (degr2 (- degr degr1))
-                                  (basis2 (funcall basis2 degr2)))
-                              (declare
-                                 (fixnum degr2)
-                                 (list basis1 basis2))
-                              (the list
-                                 (mapcan
-                                    #'(lambda (gnrt1)
-                                         (declare (type gnrt gnrt1))
-                                         (the list
-                                            (mapcar
-                                               #'(lambda (gnrt2)
-                                                    (declare (type gnrt gnrt2))
-                                                    (the tnpr
-                                                       (tnpr degr1 gnrt1 degr2 gnrt2)))
-                                               basis2)))
-                                    basis1))))
-                      (<a-b> 0 degr))))))
-      (the basis #'rslt)))
-
-#|
-  (defun bas (degr)
-     (case degr
-        (0 '(a b c))
-        (1 '(d))
-        (2 nil)
-        (3 '(x y))))
-  (setf bas (tnsr-prdc-basis #'bas #'bas))
-  (dotimes (i 8)
-     (print (funcall bas i))))
-|#
+		  (when (minusp degr)
+		    (return-from rslt +empty-list+))
+		  (mapcan
+		   #'(lambda (degr1)
+		       (declare (fixnum degr1))
+		       (let* ((basis1 (funcall basis1 degr1))
+			      (degr2 (- degr degr1))
+			      (basis2 (funcall basis2 degr2)))
+			 (declare
+			  (fixnum degr2)
+			  (list basis1 basis2))
+			 (the list
+			      (mapcan
+			       #'(lambda (gnrt1)
+				   (declare (type gnrt gnrt1))
+				   (the list
+					(mapcar
+					 #'(lambda (gnrt2)
+					     (declare (type gnrt gnrt2))
+					     (the tnpr
+						  (tnpr degr1 gnrt1 degr2
+							gnrt2)))
+					 basis2)))
+			       basis1))))
+		   (<a-b> 0 degr))))))
+    (the basis #'rslt)))
 
 
 (DEFUN TNSR-PRDC-INTR-DFFR (dffr1 dffr2)
-   (declare (type morphism dffr1 dffr2))
-   (flet ((rslt (degr tnpr)
-             (declare
-                (fixnum degr)
-                (type tnpr tnpr))
-             (the cmbn
-                (with-tnpr (degr1 gnrt1 degr2 gnrt2) tnpr
-                   (let ((degr1-1 (1- degr1))
-                         (degr2-1 (1- degr2))
-                         (sign (oddp degr1))
-                         (list1 (cmbn-list (gnrt-? dffr1 degr1 gnrt1)))
-                         (list2 (cmbn-list (gnrt-? dffr2 degr2 gnrt2))))
-                      (declare
+  (declare (type morphism dffr1 dffr2))
+  (flet ((rslt (degr tnpr)
+	   (declare
+	    (fixnum degr)
+	    (type tnpr tnpr))
+	   (the cmbn
+                (with-tnpr
+		    (degr1 gnrt1 degr2 gnrt2) tnpr
+		    (let ((degr1-1 (1- degr1))
+			  (degr2-1 (1- degr2))
+			  (sign (oddp degr1))
+			  (list1 (cmbn-list (gnrt-? dffr1 degr1 gnrt1)))
+			  (list2 (cmbn-list (gnrt-? dffr2 degr2 gnrt2))))
+		      (declare
 		       (fixnum degr1-1 degr2-1)
 		       (boolean sign)
 		       (list list1 list2))
-                      (make-cmbn
-                         :degr (1- degr)
-                         :list (nconc
-                                  (mapcar
-                                     #'(lambda (term1)
-                                          (declare (type term term1))
-                                          (with-term (cffc1 gnrt1) term1
-                                             (term cffc1
-                                                (tnpr degr1-1 gnrt1 degr2 gnrt2))))
-                                     list1)
-                                  (mapcar
-                                     #'(lambda (term2)
-                                          (declare (type term term2))
-                                          (with-term (cffc2 gnrt2) term2
-                                             (term (if sign (- cffc2) cffc2)
-                                                (tnpr degr1 gnrt1 degr2-1 gnrt2))))
-                                     list2))))))))
-      (the intr-mrph #'rslt)))
+		      (make-cmbn
+		       :degr (1- degr)
+		       :list (nconc
+			      (mapcar
+			       #'(lambda (term1)
+				   (declare (type term term1))
+				   (with-term
+				       (cffc1 gnrt1) term1
+				       (term cffc1 (tnpr degr1-1 gnrt1
+							 degr2 gnrt2))))
+			       list1)
+			      (mapcar
+			       #'(lambda (term2)
+				   (declare (type term term2))
+				   (with-term (cffc2 gnrt2) term2
+					      (term (if sign (- cffc2) cffc2)
+						    (tnpr degr1 gnrt1
+							  degr2-1 gnrt2))))
+			       list2))))))))
+    (the intr-mrph #'rslt)))
 
 
-#|
-  (cat-init)
-  (setf chcm (build-chcm :cmpr #'s-cmpr :strt :gnrt :orgn '(test-1)))
-  (setf dffr (build-mrph :sorc chcm :trgt chcm :degr -1
-                         :intr #'(lambda (degr gnrt)
-                                    (ecase gnrt
-                                       (a (cmbn (1- degr) 2 'd1a -3 'd2a))
-                                       (b (cmbn (1- degr) 3 'd1b -4 'd2b))))
-                         :strt :gnrt :orgn '(test-2)))
-  (setf rslt (tnsr-prdc-intr-dffr dffr dffr))
-  (funcall rslt 4 (tnpr 2 'a 2 'b))
-  (funcall rslt 5 (tnpr 3 'a 2 'b))
-  (funcall rslt 5 (tnpr 2 'a 3 'b))
-  (funcall rslt 6 (tnpr 3 'a 3 'b)))
-|#
-
 (DEFGENERIC TNSR-PRDC (chcm-hmeq-mrph-rdct1 chcm-hmeq-mrph-rdct2))
 
 (DEFMETHOD TNSR-PRDC ((chcm1 chain-complex) (chcm2 chain-complex))
-   (the chain-complex
-      (with-slots ((cmpr1 cmpr) (basis1 basis) (dffr1 dffr)) chcm1
-         (declare
-            (type cmprf cmpr1)
-            (type basis basis1)
-	    (type morphism dffr1))
-      (with-slots ((cmpr2 cmpr) (basis2 basis) (dffr2 dffr)) chcm2
+  (the chain-complex
+       (with-slots ((cmpr1 cmpr) (basis1 basis) (dffr1 dffr)) chcm1
          (declare
+	  (type cmprf cmpr1)
+	  (type basis basis1)
+	  (type morphism dffr1))
+	 (with-slots ((cmpr2 cmpr) (basis2 basis) (dffr2 dffr)) chcm2
+	   (declare
             (type cmprf cmpr2)
             (type basis basis2)
 	    (type morphism dffr2))
-	 (let ((rslt
-		(build-chcm
-		 :cmpr (tnsr-prdc-cmpr cmpr1 cmpr2)
-		 :basis (tnsr-prdc-basis basis1 basis2)
-		 :intr-dffr (tnsr-prdc-intr-dffr dffr1 dffr2)
-		 :strt :gnrt
-		 :orgn `(tnsr-prdc ,chcm1 ,chcm2))))
-	   (declare (type chain-complex rslt))
-	   (if (and (slot-boundp chcm1 'bsgn)
-		    (slot-boundp chcm2 'bsgn))
-	      (setf (slot-value rslt 'bsgn)
-		    (tnpr 0 (bsgn chcm1) 0 (bsgn chcm2)))
-	      (slot-makunbound rslt 'bsgn))
-	   rslt)))))
+	   (let ((rslt
+		  (build-chcm
+		   :cmpr (tnsr-prdc-cmpr cmpr1 cmpr2)
+		   :basis (tnsr-prdc-basis basis1 basis2)
+		   :intr-dffr (tnsr-prdc-intr-dffr dffr1 dffr2)
+		   :strt :gnrt
+		   :orgn `(tnsr-prdc ,chcm1 ,chcm2))))
+	     (declare (type chain-complex rslt))
+	     (if (and (slot-boundp chcm1 'bsgn)
+		      (slot-boundp chcm2 'bsgn))
+		 (setf (slot-value rslt 'bsgn)
+		       (tnpr 0 (bsgn chcm1) 0 (bsgn chcm2)))
+		 (slot-makunbound rslt 'bsgn))
+	     rslt)))))
 
-#|
-  (setf dd (tnsr-prdc (delta 2) (delta 3)))
-  (cmpr dd (tnpr 2 7 2 11) (tnpr 2 7 2 14))
-  (basis dd 3)
-  (? dd 4 (tnpr 2 7 2 14))
-  (? dd 3 (tnpr 1 6 2 14))
-  (? dd (? dd 4 (tnpr 2 7 2 14)))
-  (? dd (? dd 3 (tnpr 1 6 2 14))))
-|#
 
 (DEFUN TNSR-PRDC-INTR (mrph1 mrph2)
-   (declare
-      (type morphism mrph1 mrph2))
-   (let ((mrph2-sign (oddp (degr mrph2))))
-      (declare (type boolean mrph2-sign))         
-      (flet ((rslt (degr tnpr)
-              (declare
-                 (ignore degr)
-                 (type tnpr tnpr))
-              (with-tnpr (degr1 gnrt1 degr2 gnrt2) tnpr
-                 (let ((rslt (2cmbn-tnpr
-                                (gnrt-? mrph1 degr1 gnrt1)
-                                (gnrt-? mrph2 degr2 gnrt2))))
-                    (declare (type cmbn rslt))
-                    (when (and mrph2-sign
-                               (oddp degr1))
-                       (mapc #'(lambda (term)
-                                  (declare (type term term))
-                                  (setf (the fixnum (cffc term))
-                                        (the fixnum (- (cffc term)))))
-                          (cmbn-list rslt)))
-                    rslt))))
-         (the intr-mrph #'rslt))))
-
-#|
-  (cat-init)
-  (setf chcm (build-chcm :cmpr #'s-cmpr :strt :gnrt :orgn '(test-1)))
-  (setf mrph (build-mrph :sorc chcm :trgt chcm :degr 0
-                         :intr #'(lambda (degr gnrt)
-                                    (ecase gnrt
-                                       (a (cmbn degr 2 'd1a -3 'd2a))
-                                       (b (cmbn degr 3 'd1b -4 'd2b))))
-                         :strt :gnrt :orgn '(test-2)))
-  (setf rslt (tnsr-prdc-intr mrph mrph))
-  (funcall rslt 6 (tnpr 2 'a 4 'b))
-  (funcall rslt 5 (tnpr 3 'a 2 'b))
-  (setf mrph (build-mrph :sorc chcm :trgt chcm :degr 1
-                         :intr #'(lambda (degr gnrt)
-                                    (ecase gnrt
-                                       (a (cmbn (1+ degr) 2 'd1a -3 'd2a))
-                                       (b (cmbn (1+ degr) 3 'd1b -4 'd2b))))
-                         :strt :gnrt :orgn '(test-3)))
-  (setf rslt (tnsr-prdc-intr mrph mrph))
-  (funcall rslt 6 (tnpr 2 'a 4 'b))
-  (funcall rslt 5 (tnpr 3 'a 2 'b)))
-|#
-
+  (declare
+   (type morphism mrph1 mrph2))
+  (let ((mrph2-sign (oddp (degr mrph2))))
+    (declare (type boolean mrph2-sign))
+    (flet ((rslt (degr tnpr)
+	     (declare
+	      (ignore degr)
+	      (type tnpr tnpr))
+	     (with-tnpr (degr1 gnrt1 degr2 gnrt2) tnpr
+			(let ((rslt (2cmbn-tnpr
+				     (gnrt-? mrph1 degr1 gnrt1)
+				     (gnrt-? mrph2 degr2 gnrt2))))
+			  (declare (type cmbn rslt))
+			  (when (and mrph2-sign
+				     (oddp degr1))
+			    (mapc #'(lambda (term)
+				      (declare (type term term))
+				      (setf (the fixnum (cffc term))
+					    (the fixnum (- (cffc term)))))
+				  (cmbn-list rslt)))
+			  rslt))))
+      (the intr-mrph #'rslt))))
 
 
 (DEFMETHOD TNSR-PRDC ((mrph1 morphism) (mrph2 morphism))
   (the morphism
-   (with-slots ((sorc1 sorc) (trgt1 trgt) (degr1 degr)) mrph1
-   (with-slots ((sorc2 sorc) (trgt2 trgt) (degr2 degr)) mrph2
-      (the morphism
-	 (progn
-	   (when (and (eq 'idnt-mrph (first (orgn mrph1)))
-		      (eq 'idnt-mrph (first (orgn mrph2))))
-	      (return-from tnsr-prdc
-		 (idnt-mrph (tnsr-prdc sorc1 sorc2))))
-	   (when (or (eq 'zero-mrph (first (orgn mrph1)))
-		     (eq 'zero-mrph (first (orgn mrph2))))
-	      (return-from tnsr-prdc
-		 (zero-mrph (tnsr-prdc sorc1 sorc2)
-			    (tnsr-prdc trgt1 trgt2)
-			    (+ degr1 degr2))))
-	   (build-mrph
-              :sorc (tnsr-prdc sorc1 sorc2)
-	      :trgt (tnsr-prdc trgt1 trgt2)
-	      :degr (+ degr1 degr2)
-	      :intr (tnsr-prdc-intr mrph1 mrph2)
-	      :strt :gnrt
-	      :orgn `(tnsr-prdc ,mrph1 ,mrph2))))))))
+       (with-slots ((sorc1 sorc) (trgt1 trgt) (degr1 degr)) mrph1
+	 (with-slots ((sorc2 sorc) (trgt2 trgt) (degr2 degr)) mrph2
+	   (the morphism
+		(progn
+		  (when (and (eq 'idnt-mrph (first (orgn mrph1)))
+			     (eq 'idnt-mrph (first (orgn mrph2))))
+		    (return-from tnsr-prdc
+		      (idnt-mrph (tnsr-prdc sorc1 sorc2))))
+		  (when (or (eq 'zero-mrph (first (orgn mrph1)))
+			    (eq 'zero-mrph (first (orgn mrph2))))
+		    (return-from tnsr-prdc
+		      (zero-mrph (tnsr-prdc sorc1 sorc2)
+				 (tnsr-prdc trgt1 trgt2)
+				 (+ degr1 degr2))))
+		  (build-mrph
+		   :sorc (tnsr-prdc sorc1 sorc2)
+		   :trgt (tnsr-prdc trgt1 trgt2)
+		   :degr (+ degr1 degr2)
+		   :intr (tnsr-prdc-intr mrph1 mrph2)
+		   :strt :gnrt
+		   :orgn `(tnsr-prdc ,mrph1 ,mrph2))))))))
 
-#|
-  (cat-init)
-  (setf d (dffr (delta-infinity)))
-  (setf dd (tnsr-prdc d d))
-  (eq (sorc dd) (tnsr-prdc (delta-infinity) (delta-infinity)))
-  (? dd 5 (tnpr 2 7 3 15))
-  (? dd 5 (tnpr 3 15 2 7))
-  (? dd (? dd 5 (tnpr 2 7 3 15)))
-  (? dd (? dd 5 (tnpr 3 15 2 7)))
-  (setf ddd (cmps dd dd))
-  (? ddd 5 (tnpr 2 7 3 15))
-  (? ddd 5 (tnpr 3 15 2 7))
-|#
 
 (DEFMETHOD TNSR-PRDC ((rdct1 reduction) (rdct2 reduction))
   (the reduction
-     (progn
-       (when (and (eq 'trivial-rdct (first (orgn rdct1)))
-		  (eq 'trivial-rdct (first (orgn rdct2))))
-          (return-from tnsr-prdc
+       (progn
+	 (when (and (eq 'trivial-rdct (first (orgn rdct1)))
+		    (eq 'trivial-rdct (first (orgn rdct2))))
+	   (return-from tnsr-prdc
 	     (trivial-rdct (tnsr-prdc (bcc rdct1) (bcc rdct2)))))
-       (with-slots ((tcc1 tcc) (bcc1 bcc) (f1 f) (g1 g) (h1 h)) rdct1
-          (declare
-             (type chain-complex tcc1 bcc1)
-	     (type morphism f1 g1 h1))
-       (with-slots ((tcc2 tcc) (bcc2 bcc) (f2 f) (g2 g) (h2 h)) rdct2
-          (declare
-             (type chain-complex tcc2 bcc2)
-	     (type morphism f2 g2 h2))
-	  (build-rdct
-	     :f (tnsr-prdc f1 f2)
-	     :g (tnsr-prdc g1 g2)
-	     :h (add
-	         (tnsr-prdc h1 (cmps g2 f2))
-		 (tnsr-prdc (idnt-mrph tcc1) h2))
-	     :orgn `(tnsr-prdc ,rdct1 ,rdct2)))))))
+	 (with-slots ((tcc1 tcc) (bcc1 bcc) (f1 f) (g1 g) (h1 h)) rdct1
+	   (declare
+	    (type chain-complex tcc1 bcc1)
+	    (type morphism f1 g1 h1))
+	   (with-slots ((tcc2 tcc) (bcc2 bcc) (f2 f) (g2 g) (h2 h)) rdct2
+	     (declare
+	      (type chain-complex tcc2 bcc2)
+	      (type morphism f2 g2 h2))
+	     (build-rdct
+	      :f (tnsr-prdc f1 f2)
+	      :g (tnsr-prdc g1 g2)
+	      :h (add
+		  (tnsr-prdc h1 (cmps g2 f2))
+		  (tnsr-prdc (idnt-mrph tcc1) h2))
+	      :orgn `(tnsr-prdc ,rdct1 ,rdct2)))))))
 
-#|
-  (cat-init)
-  (setf r (ez (delta-infinity) (delta-infinity)))
-  (setf r2 (tnsr-prdc r r))
-  (setf *bc* (cmbn 4 1 (tnpr 2 (tnpr 1 3 1 3) 2 (tnpr 1 3 1 3)))
-        *tc* (cmbn 2 1 (tnpr 1 (crpr 0 3 0 3) 1 (crpr 0 3 0 3))))
-  (pre-check-rdct r2)
-  (check-rdct)
-|#
 
 (DEFMETHOD TNSR-PRDC ((hmeq1 homotopy-equivalence)
 		      (hmeq2 homotopy-equivalence))
   (the homotopy-equivalence
-     (build-hmeq
+       (build-hmeq
         :lrdct (tnsr-prdc (lrdct hmeq1) (lrdct hmeq2))
 	:rrdct (tnsr-prdc (rrdct hmeq1) (rrdct hmeq2))
 	:orgn `(tnsr-prdc ,hmeq1 ,hmeq2))))
@@ -366,10 +267,3 @@
   (the homotopy-equivalence
        (tnsr-prdc (efhm (second (orgn chcm)))
 		  (efhm (third (orgn chcm))))))
-
-#|
-(cat-init)
-(setf k (k-z 2))
-(setf k2 (tnsr-prdc k k))
-(homology k2 0 10)
-|#
diff --git a/test/tensor-products-test.lisp b/test/tensor-products-test.lisp
new file mode 100644
index 0000000..a29d8f5
--- /dev/null
+++ b/test/tensor-products-test.lisp
@@ -0,0 +1,150 @@
+
+(in-package :kenzo-test)
+
+(in-suite :kenzo)
+
+
+(test tnpr
+      (cat:tnpr 2 'a 3 'b)
+      (setf cat:*tnpr-with-degrees* t)
+      (cat:tnpr 2 'a 3 'b)
+      (setf cat:*tnpr-with-degrees* nil))
+
+
+(test 2cmbn-tnpr
+      (setf cat:*tnpr-with-degrees* t)
+      (cat:2cmbn-tnpr (cat:cmbn 2 3 'a 4 'b -5 'c)
+		      (cat:cmbn 3 4 'x -3 'y 2 'z)))
+
+
+(test tnsr-prdc-cmpr
+      (let ((cmpr (cat:tnsr-prdc-cmpr #'cat:s-cmpr #'cat:s-cmpr)))
+	(is (equal :less (funcall cmpr
+				  (cat:tnpr 2 'a 3 'b)
+				  (cat:tnpr 3 'a 2 'b))))
+	(is (equal :greater (funcall cmpr
+				     (cat:tnpr 3 'a 2 'b)
+				     (cat:tnpr 2 'a 3 'b))))
+	(is (equal :less (funcall cmpr
+				   (cat:tnpr 2 'a 3 'b)
+				   (cat:tnpr 2 'b 3 'b))))
+	(is (equal :greater (funcall cmpr
+				     (cat:tnpr 2 'b 3 'b)
+				     (cat:tnpr 2 'a 3 'b))))
+	(is (equal :less (funcall cmpr
+				  (cat:tnpr 2 'a 3 'a)
+				  (cat:tnpr 2 'a 3 'b))))
+	(is (equal :greater (funcall cmpr
+				     (cat:tnpr 2 'a 3 'c)
+				     (cat:tnpr 2 'a 3 'b))))
+	(is (equal :equal (funcall cmpr
+				   (cat:tnpr 2 'a 3 'b)
+				   (cat:tnpr 2 'a 3 'b))))))
+
+
+(defun bas (degr)
+  (case degr
+    (0 '(a b c))
+    (1 '(d))
+    (2 nil)
+    (3 '(x y))))
+
+
+(test tnsr-prdc-basis
+      (let ((bas (cat:tnsr-prdc-basis #'bas #'bas)))
+	(dotimes (i 8)
+	  (print (funcall bas i)))))
+
+
+(test tnsr-prdc-intr-dffr
+      	(cat:cat-init)
+	(let* ((chcm (cat:build-chcm :cmpr #'cat:s-cmpr
+				     :basis :locally-effective
+				     :intr-dffr #'cat:zero-mrph
+				     :strt :gnrt :orgn '(test-1)))
+	       (dffr (cat:build-mrph
+		       :sorc chcm :trgt chcm :degr -1
+		       :intr #'(lambda (degr gnrt)
+				 (ecase gnrt
+				   (a (cat:cmbn (1- degr) 2 'd1a -3 'd2a))
+				   (b (cat:cmbn (1- degr) 3 'd1b -4 'd2b))))
+		       :strt :gnrt :orgn '(test-2)))
+	       (rslt (cat:tnsr-prdc-intr-dffr dffr dffr)))
+	  (funcall rslt 4 (cat:tnpr 2 'a 2 'b))
+	  (funcall rslt 5 (cat:tnpr 3 'a 2 'b))
+	  (funcall rslt 5 (cat:tnpr 2 'a 3 'b))
+	  (funcall rslt 6 (cat:tnpr 3 'a 3 'b))))
+
+
+(test tnsr-prdc
+      (let ((dd (cat:tnsr-prdc (cat:delta 2) (cat:delta 3))))
+	(cat:cmpr dd (cat:tnpr 2 7 2 11) (cat:tnpr 2 7 2 14))
+	(cat:basis dd 3)
+	(cat:? dd 4 (cat:tnpr 2 7 2 14))
+	(cat:? dd 3 (cat:tnpr 1 6 2 14))
+	(cat:? dd (cat:? dd 4 (cat:tnpr 2 7 2 14)))
+	(cat:? dd (cat:? dd 3 (cat:tnpr 1 6 2 14)))))
+
+
+(test tnsr-prdc-intr
+      (cat:cat-init)
+      (let* ((chcm (cat:build-chcm :cmpr #'cat:s-cmpr
+				   :basis :locally-effective
+				   :intr-dffr #'cat:zero-mrph
+				   :strt :gnrt
+				   :orgn '(test-1)))
+
+	     (mrph (cat:build-mrph
+		    :sorc chcm :trgt chcm :degr 0
+		    :intr #'(lambda (degr gnrt)
+			      (ecase gnrt
+				(a (cat:cmbn degr 2 'd1a -3 'd2a))
+				(b (cat:cmbn degr 3 'd1b -4 'd2b))))
+		    :strt :gnrt :orgn '(test-2)))
+	     (rslt (cat:tnsr-prdc-intr mrph mrph)))
+	(funcall rslt 6 (cat:tnpr 2 'a 4 'b))
+	(funcall rslt 5 (cat:tnpr 3 'a 2 'b))
+	(setf mrph (cat:build-mrph
+		    :sorc chcm :trgt chcm :degr 1
+		    :intr #'(lambda (degr gnrt)
+			      (ecase gnrt
+				(a (cat:cmbn (1+ degr) 2 'd1a -3 'd2a))
+				(b (cat:cmbn (1+ degr) 3 'd1b -4 'd2b))))
+		    :strt :gnrt :orgn '(test-3)))
+	(setf rslt (cat:tnsr-prdc-intr mrph mrph))
+	(funcall rslt 6 (cat:tnpr 2 'a 4 'b))
+	(funcall rslt 5 (cat:tnpr 3 'a 2 'b))))
+
+
+(test tnsr-prdc
+      (cat:cat-init)
+      (let* ((d (cat:dffr (cat:delta-infinity)))
+	     (dd (cat:tnsr-prdc d d))
+	     (ddd (cat:cmps dd dd)))
+	(is (eq (cat:sorc dd) (cat:tnsr-prdc (cat:delta-infinity)
+					     (cat:delta-infinity))))
+	(cat:? dd 5 (cat:tnpr 2 7 3 15))
+	(cat:? dd 5 (cat:tnpr 3 15 2 7))
+	(cat:? dd (cat:? dd 5 (cat:tnpr 2 7 3 15)))
+	(cat:? dd (cat:? dd 5 (cat:tnpr 3 15 2 7)))
+	(cat:? ddd 5 (cat:tnpr 2 7 3 15))
+	(cat:? ddd 5 (cat:tnpr 3 15 2 7))))
+
+#|
+(test tnsr-prdc1
+      (cat:cat-init)
+      (let* ((r (cat:ez (cat:delta-infinity) (cat:delta-infinity)))
+	     (r2 (cat:tnsr-prdc r r)))
+	(setf cat:*bc* (cat:cmbn 4 1 (cat:tnpr 2 (cat:tnpr 1 3 1 3) 2
+					       (cat:tnpr 1 3 1 3)))
+	      cat:*tc* (cat:cmbn 2 1 (cat:tnpr 1 (cat:crpr 0 3 0 3) 1
+					       (cat:crpr 0 3 0 3))))
+	(cat:pre-check-rdct r2)
+	(check-rdct)))
+
+(test tnsr-prdc2
+      (cat:cat-init)
+      (let* ((k (cat:k-z 2))
+	     (k2 (cat:tnsr-prdc k k)))
+	(cat:homology k2 0 10)))
+|#