diff --git a/src/chain-complexes.lisp b/src/chain-complexes.lisp
index 1d2f8b2..c6efb70 100644
--- a/src/chain-complexes.lisp
+++ b/src/chain-complexes.lisp
@@ -31,13 +31,13 @@ Args: ()
 Return the number of user created objects by object type.
 ------------------------------------------------------------------------------"
   (mapc #'(lambda (symbol)
-	    (declare (type (or string symbol) symbol))
-	    (let ((length (length (eval symbol))))
-	      (declare (fixnum length))
-	      (setf symbol (symbol-name symbol))
-	      (setf symbol (subseq symbol 1 (- (length symbol) 6)))
-	      (format t "~%~6D ~As" length symbol)))
-	*list-list*)
+            (declare (type (or string symbol) symbol))
+            (let ((length (length (eval symbol))))
+              (declare (fixnum length))
+              (setf symbol (symbol-name symbol))
+              (setf symbol (subseq symbol 1 (- (length symbol) 6)))
+              (format t "~%~6D ~As" length symbol)))
+        *list-list*)
   (done))
 
 
@@ -48,12 +48,12 @@ Args: ()
 Return a string representation of a user created objects.
 ------------------------------------------------------------------------------"
   (let ((object-list
-	 (sort (delete-duplicates
-		(mapcan #'(lambda (symbol)
-			    (copy-list (eval symbol)))
-			*list-list*)
-		:test #'eq)
-	       #'< :key #'idnm)))
+         (sort (delete-duplicates
+                (mapcan #'(lambda (symbol)
+                            (copy-list (eval symbol)))
+                        *list-list*)
+                :test #'eq)
+               #'< :key #'idnm)))
     (declare (list object-list))
     (dolist (item object-list)
       (format t "~%~A = ~A" item (orgn item))))
@@ -71,9 +71,9 @@ Return the type of Kenzo object number IDNM and print the comment list
   (dolist (list *list-list*)
     (let ((found (find idnm (eval list) :key #'idnm)))
       (when found
-	(format t "~%Object: ~A
+        (format t "~%Object: ~A
 ~3TOrigin: ~A~2%" found (orgn found))
-	(return-from kd (values))))))
+        (return-from kd (values))))))
 
 
 (DEFUN K (idnm)
@@ -86,7 +86,7 @@ Returns the IDNM-th Kenzo object.
   (dolist (list *list-list*)
     (let ((found (find idnm (eval list) :key #'idnm)))
       (when found
-	(return-from k found)))))
+        (return-from k found)))))
 
 
 (DEFUN KD2 (idnm)
@@ -104,16 +104,16 @@ the list of object numbers.
       (return-from kd2 nil))
     (setf k-list (list k-list))
     (do ((idnm (1- idnm) (1- idnm)))
-	((zerop idnm))
+        ((zerop idnm))
       (declare (fixnum idnm))
       (let ((found (find-if
-		    #'(lambda (item)
-			(declare (type (or chain-complex morphism) item))
-			(member (k idnm) (orgn item)))
-		    k-list)))
-	(declare (type (or null chain-complex morphism) found))
-	(when found
-	  (push (k idnm) k-list))))
+                    #'(lambda (item)
+                        (declare (type (or chain-complex morphism) item))
+                        (member (k idnm) (orgn item)))
+                    k-list)))
+        (declare (type (or null chain-complex morphism) found))
+        (when found
+          (push (k idnm) k-list))))
     (mapc #'kd (nreverse (mapcar #'idnm k-list)))))
 
 
@@ -122,8 +122,8 @@ the list of object numbers.
 (DEFMETHOD PRINT-OBJECT ((chcm chain-complex) stream)
   (the chain-complex
        (progn
-	 (format stream "[K~D Chain-Complex]" (idnm chcm))
-	 chcm)))
+         (format stream "[K~D Chain-Complex]" (idnm chcm))
+         chcm)))
 #+clisp(eval-when (:compile-toplevel :load-toplevel :execute)
          (setf (ext:package-lock :clos) t))
 
@@ -149,8 +149,8 @@ identifier IDNUM or NIL, if it doesn't exist.
 ~3TVALUE-> ~A
 ~4TCLNM-> ~6D
 ~4TRNTM-> ~11,3F"
-	  (result-gnrt result) (result-value result)
-	  (result-clnm result) (result-rntm result))
+          (result-gnrt result) (result-value result)
+          (result-clnm result) (result-rntm result))
   result)
 
 
@@ -193,12 +193,12 @@ identifier IDNUM or NIL, if it doesn't exist.
 (DEFMETHOD PRINT-OBJECT ((mrph morphism) stream)
   (the morphism
        (progn
-	 (if (eq (first (orgn (trgt mrph))) 'z-chcm)
-	     (format stream "[K~D Cohomology-Class on K~D of degree ~D]"
-		     (idnm mrph) (idnm (sorc mrph)) (- (degr mrph)))
-	     (format stream "[K~D Morphism (degree ~D): K~D -> K~D]"
-		     (idnm mrph) (degr mrph)
-		     (idnm (sorc mrph)) (idnm (trgt mrph))))
+         (if (eq (first (orgn (trgt mrph))) 'z-chcm)
+             (format stream "[K~D Cohomology-Class on K~D of degree ~D]"
+                     (idnm mrph) (idnm (sorc mrph)) (- (degr mrph)))
+             (format stream "[K~D Morphism (degree ~D): K~D -> K~D]"
+                     (idnm mrph) (degr mrph)
+                     (idnm (sorc mrph)) (idnm (trgt mrph))))
          mrph)))
 #+clisp(eval-when (:compile-toplevel :load-toplevel :execute)
          (setf (ext:package-lock :clos) t))
@@ -239,10 +239,12 @@ follows:
             of the differential homomorphism, either by generator or by
             combination. The default is :GNRT
 
-:ORGN ORGN, a list containing a relevant and carefully chosen comment about
-            the origin of the chain complex. This comment should be unique
-            for a Kenzo session (between calls of CAT-INIT), as it is used
-            for caching purposes.
+:ORGN ORGN, a list which is the copy of a Lisp statement, in principle the
+            statement which was at the origin of the creation of this Kenzo
+            object. A caching process, using this slot, prevents the creation
+            of multiple copies of the same mathematical object, which is
+            important for efficiency. It is used also for debugging and
+            analyzing the program.
 
 Use this function instead of creating instances via the standard constructor
 MAKE-INSTANCE.
@@ -250,25 +252,25 @@ MAKE-INSTANCE.
   (the chain-complex
        (progn
          (let ((already (find orgn *chcm-list* :test #'equal :key #'orgn)))
-	   (declare (type (or chain-complex null) already))
-	   (when already
-	     (return-from build-chcm already)))
+           (declare (type (or chain-complex null) already))
+           (when already
+             (return-from build-chcm already)))
          (unless basis
-	   (setf basis :locally-effective))
+           (setf basis :locally-effective))
          (let ((chcm (make-instance 'chain-complex
-				    :cmpr cmpr
-				    :basis basis
-				    :bsgn bsgn
-				    :orgn orgn)))
-	   (declare (type chain-complex chcm))
-	   (setf (slot-value chcm 'dffr)
-		 (build-mrph
-		  :sorc chcm :trgt chcm :degr -1
-		  :intr intr-dffr :strt strt
-		  :orgn `(dffr ,chcm)))
-	   (setf (slot-value chcm 'grmd) chcm)
-	   (push chcm *chcm-list*)
-	   chcm))))
+                                    :cmpr cmpr
+                                    :basis basis
+                                    :bsgn bsgn
+                                    :orgn orgn)))
+           (declare (type chain-complex chcm))
+           (setf (slot-value chcm 'dffr)
+                 (build-mrph
+                  :sorc chcm :trgt chcm :degr -1
+                  :intr intr-dffr :strt strt
+                  :orgn `(dffr ,chcm)))
+           (setf (slot-value chcm 'grmd) chcm)
+           (push chcm *chcm-list*)
+           chcm))))
 
 
 (DEFUN BASIS2 (object n)         ;;;
@@ -279,7 +281,7 @@ MAKE-INSTANCE.
        (with-slots (basis) object
          (declare (type basis basis))
          (when (eq :locally-effective basis)
-	   (error "The object ~A is locally-effective." object))
+           (error "The object ~A is locally-effective." object))
          (funcall basis n))))
 
 
@@ -308,10 +310,12 @@ follows:
             of the differential homomorphism, either by generator or by
             combination. The default is :GNRT
 
-:ORGN ORGN, a list containing a relevant and carefully chosen comment about
-            the origin of the chain complex. This comment should be unique
-            for a Kenzo session (between calls of CAT-INIT), as it is used
-            for caching purposes.
+:ORGN ORGN, a list which is the copy of a Lisp statement, in principle the
+            statement which was at the origin of the creation of this Kenzo
+            object. A caching process, using this slot, prevents the creation
+            of multiple copies of the same mathematical object, which is
+            important for efficiency. It is used also for debugging and
+            analyzing the program.
 
 Use this function instead of creating instances via the standard constructor
 MAKE-INSTANCE.
@@ -319,63 +323,63 @@ MAKE-INSTANCE.
   (the morphism
        (progn
          (let ((already (find orgn *mrph-list* :test #'equal :key #'orgn)))
-	   (declare (type (or morphism null) already))
-	   (when already
-	     (return-from build-mrph already)))
+           (declare (type (or morphism null) already))
+           (when already
+             (return-from build-mrph already)))
          (let ((mrph (make-instance 'morphism
-				    :sorc sorc :trgt trgt :degr degr
-				    :intr intr :strt strt
-				    :orgn orgn)))
-	   (declare (type morphism mrph))
-	   (setf (slot-value mrph 'rslts)
-		 (ecase strt
-		   (:gnrt (map 'simple-vector
+                                    :sorc sorc :trgt trgt :degr degr
+                                    :intr intr :strt strt
+                                    :orgn orgn)))
+           (declare (type morphism mrph))
+           (setf (slot-value mrph 'rslts)
+                 (ecase strt
+                   (:gnrt (map 'simple-vector
                                ;; (vector (vector result))
                                #'(lambda (dummy)
-				   (declare (ignore dummy))
-				   (make-array 0
-					       :adjustable t
-					       :fill-pointer 0))
+                                   (declare (ignore dummy))
+                                   (make-array 0
+                                               :adjustable t
+                                               :fill-pointer 0))
                                (make-list +maximal-dimension+)))
-		   (:cmbn (make-array 0))))
-	   (push mrph *mrph-list*)
-	   mrph))))
+                   (:cmbn (make-array 0))))
+           (push mrph *mrph-list*)
+           mrph))))
 
 ;;; FUNCTIONS
 
 (DEFUN NRESULTS ()
   (the fixnum
        (let ((nrslts 0))
-	 (declare (fixnum nrslts))
-	 (dolist (item *mrph-list*)
-	   (declare (type morphism item))
-	   (when (eq :gnrt (strt item))
-	     (map nil
-		  #'(lambda (drslt)
-		      (declare (vector drslt))
-		      (incf nrslts (length drslt)))
-		  (rslts item))))
-	 nrslts)))
+         (declare (fixnum nrslts))
+         (dolist (item *mrph-list*)
+           (declare (type morphism item))
+           (when (eq :gnrt (strt item))
+             (map nil
+                  #'(lambda (drslt)
+                      (declare (vector drslt))
+                      (incf nrslts (length drslt)))
+                  (rslts item))))
+         nrslts)))
 
 
 (DEFUN TIME-LIST ()
   (the list
        (let ((time-list +empty-list+))
-	 (declare (list time-list))
-	 (dolist (item *mrph-list*)
-	   (declare (type morphism item))
-	   (when (eq :gnrt (strt item))
-	     (map nil #'(lambda (drslt)
-			  (declare (vector drslt))
-			  (map nil #'(lambda (rslt)
-				       (declare (type result rslt))
-				       (let ((rntm (result-rntm rslt)))
-					 (declare (single-float rntm))
-					 (when (plusp rntm)
-					   (push rntm time-list))))
-			       drslt))
-		  (rslts item))))
-	 (sort time-list #'>))))
+         (declare (list time-list))
+         (dolist (item *mrph-list*)
+           (declare (type morphism item))
+           (when (eq :gnrt (strt item))
+             (map nil #'(lambda (drslt)
+                          (declare (vector drslt))
+                          (map nil #'(lambda (rslt)
+                                       (declare (type result rslt))
+                                       (let ((rntm (result-rntm rslt)))
+                                         (declare (single-float rntm))
+                                         (when (plusp rntm)
+                                           (push rntm time-list))))
+                               drslt))
+                  (rslts item))))
+         (sort time-list #'>))))
 
 
 (DEFUN CLEAN-RESULTS (&optional (results-coef *results-coef*))
@@ -384,35 +388,35 @@ MAKE-INSTANCE.
    (special *results-coef* *results-cmlt-tm* *results-n* *results-verbose*))
   (the (values )
        (let ((cut (* results-coef (/ *results-cmlt-tm* *results-n*))))
-	 (declare (single-float cut))
-	 (setf *results-n* 0 *results-cmlt-tm* 0.0)
-	 (dolist (item *mrph-list*)
-	   (declare (type morphism item))
-	   (when (eq :gnrt (strt item))
-	     (let ((rslts (rslts item)))
-	       (declare (vector rslts))
-	       (dotimes (i +maximal-dimension+)
-		 (declare (fixnum i))
-		 (let ((rslts-i (aref rslts i))
-		       (output (make-array 0 :adjustable t :fill-pointer 0)))
-		   (declare (vector rslts-i output))
-		   (map nil
-			#'(lambda (rslt)
-			    (declare (type result rslt))
-			    (let ((rntm (result-rntm rslt)))
-			      (declare (single-float rntm))
-			      (when (> rntm cut)
-				(incf *results-n*)
-				(incf *results-cmlt-tm* rntm)
-				(vector-push-extend rslt output))))
-			rslts-i)
-		   (setf (aref rslts i) output))))))
-	 (when *results-verbose*
-	   (format t "~%*CR* -- Cut = ~A -- N = ~A" cut *results-n*)))))
+         (declare (single-float cut))
+         (setf *results-n* 0 *results-cmlt-tm* 0.0)
+         (dolist (item *mrph-list*)
+           (declare (type morphism item))
+           (when (eq :gnrt (strt item))
+             (let ((rslts (rslts item)))
+               (declare (vector rslts))
+               (dotimes (i +maximal-dimension+)
+                 (declare (fixnum i))
+                 (let ((rslts-i (aref rslts i))
+                       (output (make-array 0 :adjustable t :fill-pointer 0)))
+                   (declare (vector rslts-i output))
+                   (map nil
+                        #'(lambda (rslt)
+                            (declare (type result rslt))
+                            (let ((rntm (result-rntm rslt)))
+                              (declare (single-float rntm))
+                              (when (> rntm cut)
+                                (incf *results-n*)
+                                (incf *results-cmlt-tm* rntm)
+                                (vector-push-extend rslt output))))
+                        rslts-i)
+                   (setf (aref rslts i) output))))))
+         (when *results-verbose*
+           (format t "~%*CR* -- Cut = ~A -- N = ~A" cut *results-n*)))))
 
 
 (DEFUN MRPH-GNRT (cmpr2 intr degr gnrt memory
-		  &optional (left -1) (right (fill-pointer memory)))
+                  &optional (left -1) (right (fill-pointer memory)))
   (declare
    (type intr-mrph intr)
    ;; (function (fixnum gnrt) cmbn)
@@ -427,47 +431,47 @@ MAKE-INSTANCE.
        ;; cmbn = image of the generator
        ;; fixnum = index "exact" or just "lower" of the maybe stored result
        (loop
-	  (when (= right (1+ left)) ; the result for gnrt is not available
-	    (push (get-internal-run-time) *start-stack*)
-	    (let ((value (funcall intr degr gnrt))
-		  (runtime (- (get-internal-run-time) (pop *start-stack*))))
-	      (declare
-	       (type cmbn value)
-	       (integer runtime))
-	      (if (> runtime +too-much-time+)
-		  ;; the condition deciding whether
-		  ;; storing must happen
-		  (let ((old-length (vector-push-extend nil memory)))
-		    (declare (fixnum old-length))
-		    (replace memory memory
-			     :start1 (1+ right) :end1 (1+ old-length)
-			     :start2 right :end2 old-length)
-		    (setf (aref memory right)
-			  (make-result
-			   :gnrt gnrt :value value :clnm 1
-			   :rntm (let ((rntm
-					(float
-					 (/ runtime
-					    internal-time-units-per-second))))
-				   (declare (single-float rntm))
-				   (incf *results-cmlt-tm* rntm)
-				   rntm)))
-		    (mapl #'(lambda (mark)
-			      (declare (cons mark))
-			      (incf (car mark) runtime))
-			  *start-stack*)
-		    (when (> (incf *results-n*) *results-max*)
-		      (clean-results))
-		    (return (values value right)))
-		  (return (values value left)))))
-	  (let ((middle (truncate (+ right left) 2)))
+          (when (= right (1+ left)) ; the result for gnrt is not available
+            (push (get-internal-run-time) *start-stack*)
+            (let ((value (funcall intr degr gnrt))
+                  (runtime (- (get-internal-run-time) (pop *start-stack*))))
+              (declare
+               (type cmbn value)
+               (integer runtime))
+              (if (> runtime +too-much-time+)
+                  ;; the condition deciding whether
+                  ;; storing must happen
+                  (let ((old-length (vector-push-extend nil memory)))
+                    (declare (fixnum old-length))
+                    (replace memory memory
+                             :start1 (1+ right) :end1 (1+ old-length)
+                             :start2 right :end2 old-length)
+                    (setf (aref memory right)
+                          (make-result
+                           :gnrt gnrt :value value :clnm 1
+                           :rntm (let ((rntm
+                                        (float
+                                         (/ runtime
+                                            internal-time-units-per-second))))
+                                   (declare (single-float rntm))
+                                   (incf *results-cmlt-tm* rntm)
+                                   rntm)))
+                    (mapl #'(lambda (mark)
+                              (declare (cons mark))
+                              (incf (car mark) runtime))
+                          *start-stack*)
+                    (when (> (incf *results-n*) *results-max*)
+                      (clean-results))
+                    (return (values value right)))
+                  (return (values value left)))))
+          (let ((middle (truncate (+ right left) 2)))
             (declare (fixnum middle))
             (ecase (funcall cmpr2 gnrt (result-gnrt (aref memory middle)))
-	      (:equal (let ((rslt (aref memory middle)))
-			(declare (type result rslt))
-			(incf (result-clnm rslt))
-			(return (values (result-value rslt) middle))))
-	      (:less (setf right middle))
+              (:equal (let ((rslt (aref memory middle)))
+                        (declare (type result rslt))
+                        (incf (result-clnm rslt))
+                        (return (values (result-value rslt) middle))))
+              (:less (setf right middle))
               (:greater (setf left middle)))))))
 
 
@@ -481,17 +485,17 @@ MAKE-INSTANCE.
   ;; (vector result)
   (the cmbn
        (with-cmbn (degr list) cmbn
-		  (let ((n-cmbn-list +empty-list+))
-		    (declare (list n-cmbn-list))
-		    (do ((mark list (cdr mark))
-			 (left -1))
-			((endp mark))
-		      (declare (list mark))
-		      (multiple-value-bind (rslt new-left)
-			  (mrph-gnrt scmpr2 intr degr (-gnrt mark) memory left)
-			(setf left new-left)
-			(push (cons (-cffc mark) rslt) n-cmbn-list)))
-		    (cmbn-cmbn tcmpr2 n-cmbn-list)))))
+                  (let ((n-cmbn-list +empty-list+))
+                    (declare (list n-cmbn-list))
+                    (do ((mark list (cdr mark))
+                         (left -1))
+                        ((endp mark))
+                      (declare (list mark))
+                      (multiple-value-bind (rslt new-left)
+                          (mrph-gnrt scmpr2 intr degr (-gnrt mark) memory left)
+                        (setf left new-left)
+                        (push (cons (-cffc mark) rslt) n-cmbn-list)))
+                    (cmbn-cmbn tcmpr2 n-cmbn-list)))))
 
 (DEFUN DO-CONTROL (cmpr cmbn)
   (declare
@@ -501,14 +505,14 @@ MAKE-INSTANCE.
     (let ((list (cmbn-list cmbn)))
       (declare (list list))
       (do ((mark1 (rest list) (cdr mark1))
-	   (mark2 list mark1))
-	  ((endp mark1))
-	(declare (list mark1 mark2))
-	(unless (eq :less (funcall cmpr (-gnrt mark2) (-gnrt mark1)))
-	  (setf *wrong-cmbn* cmbn)
-	  (error "In the combination located by *WRONG-CMBN*, the generators:~@
+           (mark2 list mark1))
+          ((endp mark1))
+        (declare (list mark1 mark2))
+        (unless (eq :less (funcall cmpr (-gnrt mark2) (-gnrt mark1)))
+          (setf *wrong-cmbn* cmbn)
+          (error "In the combination located by *WRONG-CMBN*, the generators:~@
                     ~A and ~A are in a wrong order." (cdar mark2)
-		    (cdar mark1))))))
+                    (cdar mark1))))))
    cmbn)
 
 #|
@@ -517,9 +521,9 @@ MAKE-INSTANCE.
 
 (DEFUN PROFILER-INIT ()
   (mapc #'(lambda (mrph)
-	    (declare (type morphism mrph))
-	    (setf (wrtm mrph) 0))
-	*mrph-list*))
+            (declare (type morphism mrph))
+            (setf (wrtm mrph) 0))
+        *mrph-list*))
 
 (DEFUN PROFILER-ON ()
   (push (get-internal-run-time) *profiler-stack*))
@@ -527,12 +531,12 @@ MAKE-INSTANCE.
 (DEFUN PROFILER-OFF (mrph)
   (declare (type morphism mrph))
   (let ((time-spent 
-	 (- (get-internal-run-time) (pop *profiler-stack*))))
+         (- (get-internal-run-time) (pop *profiler-stack*))))
     (declare (integer time-spent))
     (mapl #'(lambda (mark)
-	      (declare (cons mark))
-	      (incf (car mark) time-spent))
-	  *profiler-stack*)
+              (declare (cons mark))
+              (incf (car mark) time-spent))
+          *profiler-stack*)
     (incf (wrtm mrph) time-spent)))
 |#
 
@@ -544,35 +548,35 @@ MAKE-INSTANCE.
    (type gnrt gnrt))
   (the cmbn
        (progn
-	 ;;         (profiler-on)
+         ;;         (profiler-on)
          (when (and *future-display*
                     (> (get-internal-run-time) *future-display*))
-	   (format t "~%GNRT-?
+           (format t "~%GNRT-?
 ~3T~A  ORGN = ~A
 ~3TDEGR = ~D
 ~3TGNRT = ~A"
-		   mrph (orgn mrph) degr gnrt)
-	   (setf *future-display* (+ (get-internal-run-time) *time-interval*)))
+                   mrph (orgn mrph) degr gnrt)
+           (setf *future-display* (+ (get-internal-run-time) *time-interval*)))
          (with-slots (sorc (mdegr degr) intr strt ?-clnm) mrph
-	   (declare
-	    (type chain-complex sorc)
-	    (fixnum mdegr ?-clnm)
-	    (type intr-mrph intr)
-	    (type strt strt))
-	   (with-slots ((scmpr cmpr)) sorc
-	     (declare (type cmprf scmpr))
-	     (control (slot-value (slot-value mrph 'trgt) 'cmpr)
-		      (progn
-			(incf ?-clnm)
-			(prog1
-			    (ecase strt
-			      (:gnrt
-			       (mrph-gnrt scmpr intr
-					  degr gnrt (svref (rslts mrph) degr)))
-			      (:cmbn
-			       (funcall intr (term-cmbn degr 1 gnrt))))
-			  ;;                     (profiler-off mrph)
-			  ))))))))
+           (declare
+            (type chain-complex sorc)
+            (fixnum mdegr ?-clnm)
+            (type intr-mrph intr)
+            (type strt strt))
+           (with-slots ((scmpr cmpr)) sorc
+             (declare (type cmprf scmpr))
+             (control (slot-value (slot-value mrph 'trgt) 'cmpr)
+                      (progn
+                        (incf ?-clnm)
+                        (prog1
+                            (ecase strt
+                              (:gnrt
+                               (mrph-gnrt scmpr intr
+                                          degr gnrt (svref (rslts mrph) degr)))
+                              (:cmbn
+                               (funcall intr (term-cmbn degr 1 gnrt))))
+                          ;;                     (profiler-off mrph)
+                          ))))))))
 
 
 (DEFUN CMBN-? (mrph cmbn)
@@ -581,35 +585,35 @@ MAKE-INSTANCE.
    (type cmbn cmbn))
   (the cmbn
        (progn
-	 ;;         (profiler-on)
+         ;;         (profiler-on)
          (when (and *future-display*
                     (> (get-internal-run-time) *future-display*))
-	   (format t "~%CMBN-?
+           (format t "~%CMBN-?
 ~3T~A  ORGN = ~A
 ~3TCMBN = ~A"
-		   mrph (orgn mrph) cmbn)
-	   (setf *future-display* (+ (get-internal-run-time) *time-interval*)))
+                   mrph (orgn mrph) cmbn)
+           (setf *future-display* (+ (get-internal-run-time) *time-interval*)))
          (with-slots (sorc trgt degr intr strt ???-clnm) mrph
-	   (declare
-	    (type chain-complex sorc trgt)
-	    (fixnum degr ???-clnm)
-	    (type intr-mrph intr)
-	    (type strt strt))
-	   (with-slots ((scmpr cmpr)) sorc
-	     (declare (type cmprf scmpr))
-	     (with-slots ((tcmpr cmpr)) trgt
-	       (declare (type cmprf tcmpr))
-	       (control tcmpr
-			(progn
-			  (controln scmpr cmbn)
-			  (incf ???-clnm)
-			  (when (eq strt :cmbn)
-			    (return-from cmbn-? (funcall intr cmbn)))
-			  (prog1
-			      (if (cmbn-zero-p cmbn)
-				  (zero-cmbn (+ (cmbn-degr cmbn) degr))
-				  (mrph-cmbn scmpr tcmpr intr
-					     cmbn (svref (rslts mrph)
-							 (cmbn-degr cmbn))))
-			    ;;                     (profiler-off mrph)
-			    )))))))))
+           (declare
+            (type chain-complex sorc trgt)
+            (fixnum degr ???-clnm)
+            (type intr-mrph intr)
+            (type strt strt))
+           (with-slots ((scmpr cmpr)) sorc
+             (declare (type cmprf scmpr))
+             (with-slots ((tcmpr cmpr)) trgt
+               (declare (type cmprf tcmpr))
+               (control tcmpr
+                        (progn
+                          (controln scmpr cmbn)
+                          (incf ???-clnm)
+                          (when (eq strt :cmbn)
+                            (return-from cmbn-? (funcall intr cmbn)))
+                          (prog1
+                              (if (cmbn-zero-p cmbn)
+                                  (zero-cmbn (+ (cmbn-degr cmbn) degr))
+                                  (mrph-cmbn scmpr tcmpr intr
+                                             cmbn (svref (rslts mrph)
+                                                         (cmbn-degr cmbn))))
+                            ;;                     (profiler-off mrph)
+                            )))))))))
diff --git a/src/classes.lisp b/src/classes.lisp
index acba52e..41b2cbe 100644
--- a/src/classes.lisp
+++ b/src/classes.lisp
@@ -192,9 +192,11 @@ Intances of this class represent chain complexes. The class has 8 slots:
 7. IDNM, an integer, a system generated identifier for this object. Its reader
    function is IDNM.
 
-8. ORGN, a list containg a comment indicating the origin of the object. The
-   should be unique (per session), since it is used in the implementation for
-   caching purposes. Its reader function is ORGN.
+8. ORGN, a list which is the copy of a Lisp statement, in principle the
+   statement which was at the origin of the creation of this Kenzo object.
+   A caching process, using this slot, prevents the creation of multiple
+   copies of the same mathematical object, which is important for efficiency.
+   It is used also for debugging and analyzing the program.
 -----------------------------------------------------------------------------"))
 
 
@@ -275,9 +277,11 @@ degree -1. The class has 10 slots:
 9. IDNM, an integer, a system-generated identifier for this object. Its reader
    function is IDNM.
 
-10. ORGN, a list containg a comment indicating the origin of the object. The
-    should be unique (per session), since it is used in the implementation for
-    caching purposes. Its reader function is ORGN.
+10. ORGN, a list which is the copy of a Lisp statement, in principle the
+    statement which was at the origin of the creation of this Kenzo object.
+    A caching process, using this slot, prevents the creation of multiple
+    copies of the same mathematical object, which is important for efficiency.
+    It is used also for debugging and analyzing the program.
 -----------------------------------------------------------------------------"))
 
 
@@ -335,13 +339,14 @@ The class has 7 slots:
 5. H, an object of type MORPHISM representing the morphism of graded modules h.
    Its reader function is H1.
 
-9. IDNM, an integer, a system-generated identifier for this object. Its reader
+6. IDNM, an integer, a system-generated identifier for this object. Its reader
    function is IDNM.
 
-10. ORGN, a list containg a comment indicating the origin of the object.
-    This comment should be unique for a Kenzo session (between calls of
-    CAT-INIT), as it is used for caching purposes. Its reader function
-    is ORGN.
+7. ORGN, a list which is the copy of a Lisp statement, in principle the
+   statement which was at the origin of the creation of this Kenzo object.
+   A caching process, using this slot, prevents the creation of multiple
+   copies of the same mathematical object, which is important for efficiency.
+   It is used also for debugging and analyzing the program.
 -----------------------------------------------------------------------------"))
 
 
diff --git a/src/effective-homology.lisp b/src/effective-homology.lisp
index a99c24d..d98f79b 100644
--- a/src/effective-homology.lisp
+++ b/src/effective-homology.lisp
@@ -16,9 +16,9 @@
 (DEFMETHOD PRINT-OBJECT ((rdct reduction) stream)
   (the reduction
        (progn
-	 (format stream "[K~D Reduction K~D => K~D]"
-		 (idnm rdct) (idnm (tcc rdct)) (idnm (bcc rdct)))
-	 rdct)))
+         (format stream "[K~D Reduction K~D => K~D]"
+                 (idnm rdct) (idnm (tcc rdct)) (idnm (bcc rdct)))
+         rdct)))
 #+clisp(eval-when (:compile-toplevel :load-toplevel :execute)
          (setf (ext:package-lock :clos) t))
 
@@ -54,10 +54,12 @@ follows:
 :H H, an object of type MORPHISM representing the morphism of graded modules h
             of a reduction
 
-:ORGN ORGN, a list containing a relevant and carefully chosen comment about
-            the origin of the chain complex. This comment should be unique
-            for a Kenzo session (between calls of CAT-INIT), as it is used
-            for caching purposes.
+:ORGN ORGN, a list which is the copy of a Lisp statement, in principle the
+            statement which was at the origin of the creation of this Kenzo
+            object. A caching process, using this slot, prevents the creation
+            of multiple copies of the same mathematical object, which is
+            important for efficiency. It is used also for debugging and
+            analyzing the program.
 
 Use this function instead of creating instances via the standard constructor
 MAKE-INSTANCE.
@@ -65,38 +67,38 @@ MAKE-INSTANCE.
   (the reduction
        (progn
          (unless orgn
-	   (setf orgn `(build-rdct ,f ,g ,h)))
+           (setf orgn `(build-rdct ,f ,g ,h)))
          (let ((already (find orgn *rdct-list* :test #'equal :key #'orgn)))
-	   (declare (type (or reduction null) already))
-	   (when already
-	     (return-from build-rdct already)))
+           (declare (type (or reduction null) already))
+           (when already
+             (return-from build-rdct already)))
          (with-slots ((fsorc sorc) (ftrgt trgt) (fdegr degr)) f
-	   (declare
-	    (type chain-complex fsorc ftrgt)
-	    (fixnum fdegr))
-	   (with-slots ((gsorc sorc) (gtrgt trgt) (gdegr degr)) g
-	     (declare
-	      (type chain-complex gsorc gtrgt)
-	      (fixnum gdegr))
-	     (with-slots ((hsorc sorc) (htrgt trgt) (hdegr degr)) h
-	       (declare
-		(type chain-complex hsorc htrgt)
-		(fixnum hdegr))
-	       (unless (and (eq gsorc ftrgt)
-			    (eq fsorc gtrgt)
-			    (eq hsorc fsorc)
-			    (eq htrgt fsorc)
-			    (zerop fdegr)
-			    (zerop gdegr)
-			    (= +1 hdegr))
-		 (error "In BUILD-RDCT, the data are non coherent."))
-	       (let ((rdct (make-instance 'reduction
-					  :tcc fsorc :bcc ftrgt
-					  :f f :g g :h h
-					  :orgn orgn)))
-		 (declare (type reduction rdct))
-		 (push rdct *rdct-list*)
-		 rdct)))))))
+           (declare
+            (type chain-complex fsorc ftrgt)
+            (fixnum fdegr))
+           (with-slots ((gsorc sorc) (gtrgt trgt) (gdegr degr)) g
+             (declare
+              (type chain-complex gsorc gtrgt)
+              (fixnum gdegr))
+             (with-slots ((hsorc sorc) (htrgt trgt) (hdegr degr)) h
+               (declare
+                (type chain-complex hsorc htrgt)
+                (fixnum hdegr))
+               (unless (and (eq gsorc ftrgt)
+                            (eq fsorc gtrgt)
+                            (eq hsorc fsorc)
+                            (eq htrgt fsorc)
+                            (zerop fdegr)
+                            (zerop gdegr)
+                            (= +1 hdegr))
+                 (error "In BUILD-RDCT, the data are non coherent."))
+               (let ((rdct (make-instance 'reduction
+                                          :tcc fsorc :bcc ftrgt
+                                          :f f :g g :h h
+                                          :orgn orgn)))
+                 (declare (type reduction rdct))
+                 (push rdct *rdct-list*)
+                 rdct)))))))
 
 
 (DEFUN TRIVIAL-RDCT (chcm)
@@ -142,27 +144,27 @@ See also: ZERO-MRPH, IDNT-MRPH.
   (the homotopy-equivalence
        (progn
          (with-slots ((lf f) (lg g) (lh h) (ltcc tcc) (lbcc bcc)) lrdct
-	   (declare
-	    (type morphism lf lg lh)
-	    (type chain-complex ltcc lbcc))
-	   (with-slots ((rf f) (rg g) (rh h) (rtcc tcc) (rbcc bcc)) rrdct
-	     (declare
-	      (type morphism rf rg rh)
-	      (type chain-complex rtcc rbcc))
-	     (unless (eq ltcc rtcc)
+           (declare
+            (type morphism lf lg lh)
+            (type chain-complex ltcc lbcc))
+           (with-slots ((rf f) (rg g) (rh h) (rtcc tcc) (rbcc bcc)) rrdct
+             (declare
+              (type morphism rf rg rh)
+              (type chain-complex rtcc rbcc))
+             (unless (eq ltcc rtcc)
                (error "In BUILD-HMEQ (version from rdct), the tcc's are not the same."))
-	     (unless orgn
+             (unless orgn
                (setf orgn `(build-hmeq ,lrdct ,rrdct)))
-	     (let ((already (find orgn *hmeq-list* :test #'equal :key #'orgn)))
+             (let ((already (find orgn *hmeq-list* :test #'equal :key #'orgn)))
                (declare (type (or homotopy-equivalence null) already))
                (when already
-		 (return-from build-hmeq already)))
-	     (let ((hmeq (make-instance 'homotopy-equivalence
-					:lbcc lbcc :tcc ltcc :rbcc rbcc
-					:lf lf :lg lg :lh lh
-					:rf rf :rg rg :rh rh
-					:lrdct lrdct :rrdct rrdct
-					:orgn orgn)))
+                 (return-from build-hmeq already)))
+             (let ((hmeq (make-instance 'homotopy-equivalence
+                                        :lbcc lbcc :tcc ltcc :rbcc rbcc
+                                        :lf lf :lg lg :lh lh
+                                        :rf rf :rg rg :rh rh
+                                        :lrdct lrdct :rrdct rrdct
+                                        :orgn orgn)))
                (declare (type homotopy-equivalence hmeq))
                (push hmeq *hmeq-list*)
                hmeq))))))
@@ -173,10 +175,10 @@ See also: ZERO-MRPH, IDNT-MRPH.
 (DEFMETHOD PRINT-OBJECT ((hmeq homotopy-equivalence) stream)
   (the homotopy-equivalence
        (progn
-	 (format stream "[K~D Homotopy-Equivalence K~D <= K~D => K~D]"
-		 (idnm hmeq)
-		 (idnm (lbcc hmeq)) (idnm (tcc hmeq)) (idnm (rbcc hmeq)))
-	 hmeq)))
+         (format stream "[K~D Homotopy-Equivalence K~D <= K~D => K~D]"
+                 (idnm hmeq)
+                 (idnm (lbcc hmeq)) (idnm (tcc hmeq)) (idnm (rbcc hmeq)))
+         hmeq)))
 #+clisp(eval-when (:compile-toplevel :load-toplevel :execute)
          (setf (ext:package-lock :clos) t))
 
@@ -194,16 +196,16 @@ See also: ZERO-MRPH, IDNT-MRPH.
   (the homotopy-equivalence
        (progn
          (unless orgn
-	   (setf orgn `(build-hmeq ,lf ,lg ,lh ,rf ,rg ,rh)))
+           (setf orgn `(build-hmeq ,lf ,lg ,lh ,rf ,rg ,rh)))
          (let ((already (find orgn *hmeq-list* :test #'equal :key #'orgn)))
-	   (declare (type (or null homotopy-equivalence) already))
-	   (when already
-	     (return-from build-hmeq already)))
+           (declare (type (or null homotopy-equivalence) already))
+           (when already
+             (return-from build-hmeq already)))
          (build-hmeq
           :lrdct (build-rdct :f lf :g lg :h lh
-			     :orgn `(build-hmeq ,lf ,lg ,lh ,rf ,rg ,rh lrdct))
+                             :orgn `(build-hmeq ,lf ,lg ,lh ,rf ,rg ,rh lrdct))
           :rrdct (build-rdct :f rf :g rg :h rh
-			     :orgn `(build-hmeq ,lf ,lg ,lh ,rf ,rg ,rh rrdct))
+                             :orgn `(build-hmeq ,lf ,lg ,lh ,rf ,rg ,rh rrdct))
           :orgn orgn))))
 
 (DEFUN TRIVIAL-HMEQ (chcm)
@@ -256,21 +258,21 @@ according to these formulas:
      (type chain-complex bcc tcc)
      (type morphism f g h))
     (setf *tdd* (cmps tcc tcc)
-	  *bdd* (cmps bcc bcc)
-	  *df-fd* (sbtr
-		   (cmps bcc f)
-		   (cmps f tcc))
-	  *dg-gd* (sbtr
-		   (cmps tcc g)
-		   (cmps g bcc))
-	  *id-fg* (sbtr (idnt-mrph bcc) (cmps f g))
-	  *id-gf-dh-hd* (i-sbtr (idnt-mrph tcc)
-				(cmps g f)
-				(cmps tcc h)
-				(cmps h tcc))
-	  *hh* (cmps h h)
-	  *fh* (cmps f h)
-	  *hg* (cmps h g)))
+          *bdd* (cmps bcc bcc)
+          *df-fd* (sbtr
+                   (cmps bcc f)
+                   (cmps f tcc))
+          *dg-gd* (sbtr
+                   (cmps tcc g)
+                   (cmps g bcc))
+          *id-fg* (sbtr (idnt-mrph bcc) (cmps f g))
+          *id-gf-dh-hd* (i-sbtr (idnt-mrph tcc)
+                                (cmps g f)
+                                (cmps tcc h)
+                                (cmps h tcc))
+          *hh* (cmps h h)
+          *fh* (cmps f h)
+          *hg* (cmps h g)))
   (done))
 
 
@@ -292,13 +294,13 @@ the <Enter> key.
     (declare (type symbol cmbn))
     (format t "~%~A => ~A" cmbn (eval cmbn)))
   (dolist (phi '(*tdd* *bdd* *df-fd* *dg-gd* *id-fg* *id-gf-dh-hd*
-		 *hh* *fh* *hg*))
+                 *hh* *fh* *hg*))
     (declare (type symbol phi))
     (format t "~%Checking ~A = 0" phi)
     (format t "~%Result: ")
     (princ (cmbn-? (eval phi)
-		   (if (member phi '(*bdd* *dg-gd* *id-fg* *dg-gd* *hg*))
-		       *bc* *tc*)))
+                   (if (member phi '(*bdd* *dg-gd* *id-fg* *dg-gd* *hg*))
+                       *bc* *tc*)))
     (read-line))
   (done))
 
@@ -317,13 +319,13 @@ coherent, the result of each mapping is a null combination.
     (declare (type symbol cmbn))
     (format t "~%~A => ~A" cmbn (eval cmbn)))
   (dolist (phi '(*tdd* *bdd* *df-fd* *dg-gd* *id-fg* *id-gf-dh-hd*
-		 *hh* *fh* *hg*))
+                 *hh* *fh* *hg*))
     (declare (type symbol phi))
     (format t "~%Checking ~A = 0" phi)
     (format t "~%Result: ")
     (princ (cmbn-? (eval phi)
-		   (if (member phi '(*bdd* *dg-gd* *id-fg* *dg-gd* *hg*))
-		       *bc* *tc*))))
+                   (if (member phi '(*bdd* *dg-gd* *id-fg* *dg-gd* *hg*))
+                       *bc* *tc*))))
   (done))
 
 
@@ -366,47 +368,47 @@ coherent, the result of each mapping is a null combination.
    (type morphism top-perturbation))
   (the (values reduction morphism)
        (with-slots ((old-tcc tcc) (old-bcc bcc)
-		    (old-f f) (old-g g) (old-h h)) reduction
+                    (old-f f) (old-g g) (old-h h)) reduction
          (declare
-	  (type chain-complex old-tcc old-bcc)
-	  (type morphism old-f old-g old-h))
+          (type chain-complex old-tcc old-bcc)
+          (type morphism old-f old-g old-h))
          (when (eq (first (orgn top-perturbation)) 'zero-mrph)
-	   (return-from basic-perturbation-lemma
-	     (values reduction (zero-mrph old-bcc))))
+           (return-from basic-perturbation-lemma
+             (values reduction (zero-mrph old-bcc))))
          (when (eq (first (orgn (h reduction))) 'zero-mrph)
-	   (return-from basic-perturbation-lemma
-	     (values
-	      (trivial-rdct (add old-tcc top-perturbation))
-	      (i-cmps old-f top-perturbation old-g))))
+           (return-from basic-perturbation-lemma
+             (values
+              (trivial-rdct (add old-tcc top-perturbation))
+              (i-cmps old-f top-perturbation old-g))))
          (let* ((sigma (bpl-*-sigma old-h top-perturbation))
                 (new-f (cmps old-f
-			     (sbtr (idnt-mrph old-tcc)
-				   (i-cmps
-				    top-perturbation
-				    sigma
-				    old-h))))
+                             (sbtr (idnt-mrph old-tcc)
+                                   (i-cmps
+                                    top-perturbation
+                                    sigma
+                                    old-h))))
                 (new-g (cmps sigma old-g))
                 (new-h (cmps sigma old-h))
                 (bottom-perturbation (i-cmps
-				      old-f
-				      top-perturbation
-				      new-g))
+                                      old-f
+                                      top-perturbation
+                                      new-g))
                 (new-tcc (add old-tcc top-perturbation))
                 (new-bcc (add old-bcc bottom-perturbation)))
-	   (declare
-	    (type chain-complex new-tcc new-bcc)
-	    (type morphism sigma new-f new-g new-h bottom-perturbation))
-	   (setf new-f (dstr-change-sorc-trgt new-f :new-sorc new-tcc
-					      :new-trgt new-bcc)
-		 new-g (dstr-change-sorc-trgt new-g :new-sorc new-bcc
-					      :new-trgt new-tcc)
-		 new-h (dstr-change-sorc-trgt new-h :new-sorc new-tcc
-					      :new-trgt new-tcc))
-	   (values
-	    (build-rdct :f new-f :g new-g :h new-h
-			:orgn `(basic-perturbation-lemma ,reduction
-							 ,top-perturbation))
-	    bottom-perturbation)))))
+           (declare
+            (type chain-complex new-tcc new-bcc)
+            (type morphism sigma new-f new-g new-h bottom-perturbation))
+           (setf new-f (dstr-change-sorc-trgt new-f :new-sorc new-tcc
+                                              :new-trgt new-bcc)
+                 new-g (dstr-change-sorc-trgt new-g :new-sorc new-bcc
+                                              :new-trgt new-tcc)
+                 new-h (dstr-change-sorc-trgt new-h :new-sorc new-tcc
+                                              :new-trgt new-tcc))
+           (values
+            (build-rdct :f new-f :g new-g :h new-h
+                        :orgn `(basic-perturbation-lemma ,reduction
+                                                         ,top-perturbation))
+            bottom-perturbation)))))
 
 (DEFUN EASY-PERTURBATION-LEMMA (reduction bottom-perturbation)
   (declare
@@ -414,32 +416,32 @@ coherent, the result of each mapping is a null combination.
    (type morphism bottom-perturbation))
   (the (values reduction morphism)
        (with-slots ((old-tcc tcc) (old-bcc bcc)
-		    (old-f f) (old-g g) (old-h h)) reduction
+                    (old-f f) (old-g g) (old-h h)) reduction
          (declare
-	  (type chain-complex old-tcc old-bcc)
-	  (type morphism old-f old-g old-h))
+          (type chain-complex old-tcc old-bcc)
+          (type morphism old-f old-g old-h))
          (when (eq 'zero-mrph (first (orgn bottom-perturbation)))
-	   (return-from easy-perturbation-lemma
-	     (values reduction (zero-mrph old-tcc))))
-	 (when (eq 'trivial-rdct (first (orgn reduction)))
-	   (return-from easy-perturbation-lemma
-	     (trivial-rdct (add (bcc reduction) bottom-perturbation))))
+           (return-from easy-perturbation-lemma
+             (values reduction (zero-mrph old-tcc))))
+         (when (eq 'trivial-rdct (first (orgn reduction)))
+           (return-from easy-perturbation-lemma
+             (trivial-rdct (add (bcc reduction) bottom-perturbation))))
          (let ((top-perturbation (i-cmps old-g bottom-perturbation old-f)))
-	   (declare (type morphism top-perturbation))
-	   (let ((new-bcc (add old-bcc bottom-perturbation))
-		 (new-tcc (add old-tcc top-perturbation)))
-	     (declare (type chain-complex new-bcc new-tcc))
-	     (values
-	      (build-rdct
-	       :f (dstr-change-sorc-trgt old-f :new-sorc new-tcc
-					 :new-trgt new-bcc)
-	       :g (dstr-change-sorc-trgt old-g :new-sorc new-bcc
-					 :new-trgt new-tcc)
-	       :h (dstr-change-sorc-trgt old-h :new-sorc new-tcc
-					 :new-trgt new-tcc)
-	       :orgn `(easy-perturbation-lemma ,reduction
-					       ,bottom-perturbation))
-	      top-perturbation))))))
+           (declare (type morphism top-perturbation))
+           (let ((new-bcc (add old-bcc bottom-perturbation))
+                 (new-tcc (add old-tcc top-perturbation)))
+             (declare (type chain-complex new-bcc new-tcc))
+             (values
+              (build-rdct
+               :f (dstr-change-sorc-trgt old-f :new-sorc new-tcc
+                                         :new-trgt new-bcc)
+               :g (dstr-change-sorc-trgt old-g :new-sorc new-bcc
+                                         :new-trgt new-tcc)
+               :h (dstr-change-sorc-trgt old-h :new-sorc new-tcc
+                                         :new-trgt new-tcc)
+               :orgn `(easy-perturbation-lemma ,reduction
+                                               ,bottom-perturbation))
+              top-perturbation))))))
 
 (DEFUN SPECIAL-BPL (reduction top-perturbation)
   (declare
@@ -449,28 +451,28 @@ coherent, the result of each mapping is a null combination.
     (return-from special-bpl reduction))
   (the reduction
        (with-slots ((old-tcc tcc) (old-bcc bcc)
-		    (old-f f) (old-g g) (old-h h)) reduction
+                    (old-f f) (old-g g) (old-h h)) reduction
          (declare
-	  (type chain-complex old-tcc old-bcc)
-	  (type morphism old-f old-g old-h))
+          (type chain-complex old-tcc old-bcc)
+          (type morphism old-f old-g old-h))
          (let* ((sigma (bpl-*-sigma old-h top-perturbation))
                 (new-f (cmps old-f
-			     (sbtr (idnt-mrph old-tcc)
-				   (i-cmps
-				    top-perturbation
-				    sigma
-				    old-h))))
+                             (sbtr (idnt-mrph old-tcc)
+                                   (i-cmps
+                                    top-perturbation
+                                    sigma
+                                    old-h))))
                 (new-h (cmps sigma old-h))
                 (new-tcc (add old-tcc top-perturbation)))
-	   (declare
-	    (type chain-complex new-tcc)
-	    (type morphism sigma new-f new-h))
-	   (setf new-f (dstr-change-sorc-trgt new-f :new-sorc new-tcc)
-		 old-g (dstr-change-sorc-trgt old-g :new-trgt new-tcc)
-		 new-h (dstr-change-sorc-trgt new-h :new-sorc new-tcc
-					      :new-trgt new-tcc))
-	   (build-rdct :f new-f :g old-g :h new-h
-		       :orgn `(special-bpl ,reduction ,top-perturbation))))))
+           (declare
+            (type chain-complex new-tcc)
+            (type morphism sigma new-f new-h))
+           (setf new-f (dstr-change-sorc-trgt new-f :new-sorc new-tcc)
+                 old-g (dstr-change-sorc-trgt old-g :new-trgt new-tcc)
+                 new-h (dstr-change-sorc-trgt new-h :new-sorc new-tcc
+                                              :new-trgt new-tcc))
+           (build-rdct :f new-f :g old-g :h new-h
+                       :orgn `(special-bpl ,reduction ,top-perturbation))))))
 
 (DEFUN SPECIAL-BPL-2 (reduction top-perturbation)
   (declare
@@ -478,69 +480,69 @@ coherent, the result of each mapping is a null combination.
    (type morphism top-perturbation))
   (the reduction
        (with-slots ((old-tcc tcc) (old-bcc bcc)
-		    (old-f f) (old-g g) (old-h h)) reduction
+                    (old-f f) (old-g g) (old-h h)) reduction
          (declare
-	  (type chain-complex old-tcc old-bcc)
-	  (type morphism old-f old-g old-h))
+          (type chain-complex old-tcc old-bcc)
+          (type morphism old-f old-g old-h))
          (when (eq (first (orgn top-perturbation)) 'zero-mrph)
-	   (return-from special-bpl-2
-	     (values reduction (zero-mrph old-bcc))))
+           (return-from special-bpl-2
+             (values reduction (zero-mrph old-bcc))))
          (when (eq (first (orgn (h reduction))) 'zero-mrph)
-	   (return-from special-bpl-2
-	     (values
-	      (trivial-rdct (add old-tcc top-perturbation))
-	      (i-cmps old-f top-perturbation old-g))))
+           (return-from special-bpl-2
+             (values
+              (trivial-rdct (add old-tcc top-perturbation))
+              (i-cmps old-f top-perturbation old-g))))
          (let* ((sigma (bpl-*-sigma old-h top-perturbation))
                 (new-g (cmps sigma old-g))
                 (new-h (cmps sigma old-h))
                 (new-tcc (add old-tcc top-perturbation)))
-	   (declare
-	    (type chain-complex new-tcc)
-	    (type morphism sigma new-g new-h))
-	   (setf old-f (dstr-change-sorc-trgt old-f :new-sorc new-tcc)
-		 new-g (dstr-change-sorc-trgt new-g :new-trgt new-tcc)
-		 new-h (dstr-change-sorc-trgt new-h :new-sorc new-tcc
-					      :new-trgt new-tcc))
-	   (values
-	    (build-rdct :f old-f :g new-g :h new-h
-			:orgn `(special-bpl-2 ,reduction ,top-perturbation)))))))
+           (declare
+            (type chain-complex new-tcc)
+            (type morphism sigma new-g new-h))
+           (setf old-f (dstr-change-sorc-trgt old-f :new-sorc new-tcc)
+                 new-g (dstr-change-sorc-trgt new-g :new-trgt new-tcc)
+                 new-h (dstr-change-sorc-trgt new-h :new-sorc new-tcc
+                                              :new-trgt new-tcc))
+           (values
+            (build-rdct :f old-f :g new-g :h new-h
+                        :orgn `(special-bpl-2 ,reduction ,top-perturbation)))))))
 
 (DEFUN BPL-*-sigma (homotopy perturbation)
   (declare (type morphism homotopy perturbation))
   (the morphism
        (let ((cmpr (cmpr (sorc perturbation)))
-	     (h-delta (cmps homotopy perturbation)))
+             (h-delta (cmps homotopy perturbation)))
          (declare
-	  (type cmprf cmpr)
-	  (type morphism h-delta))
+          (type cmprf cmpr)
+          (type morphism h-delta))
          (flet
-	     ((sigma-* (degr gnrt)
+             ((sigma-* (degr gnrt)
                 (declare
-		 (fixnum degr)
-		 (type gnrt gnrt))
+                 (fixnum degr)
+                 (type gnrt gnrt))
                 (do ((rslt (zero-cmbn degr) (2cmbn-add cmpr rslt iterated))
                      (iterated (term-cmbn degr 1 gnrt)
-			       (cmbn-opps (cmbn-? h-delta iterated))))
+                               (cmbn-opps (cmbn-? h-delta iterated))))
                     ((cmbn-zero-p iterated) rslt)
-		  (declare (type cmbn rslt iterated)))))
-	   (build-mrph
-	    :sorc (sorc homotopy) :trgt (sorc homotopy) :degr 0
-	    :intr #'sigma-*
-	    :strt :gnrt
-	    :orgn `(bpl-*-sigma ,homotopy ,perturbation))))))
+                  (declare (type cmbn rslt iterated)))))
+           (build-mrph
+            :sorc (sorc homotopy) :trgt (sorc homotopy) :degr 0
+            :intr #'sigma-*
+            :strt :gnrt
+            :orgn `(bpl-*-sigma ,homotopy ,perturbation))))))
 
 (DEFMETHOD ADD ((hmeq homotopy-equivalence) (lb-perturbation morphism)
-		&optional dummy)
+                &optional dummy)
   (declare (ignore dummy))
   (the homotopy-equivalence
        (with-slots (lrdct rrdct) hmeq
          (declare (type reduction lrdct rrdct))
          (multiple-value-bind (new-lrdct top-perturbation)
-	     (add lrdct lb-perturbation)
-	   (declare
-	    (type reduction new-lrdct)
-	    (type morphism lb-perturbation))
-	   (build-hmeq
-	    :lrdct new-lrdct
-	    :rrdct (add rrdct top-perturbation)
-	    :orgn `(add ,hmeq ,lb-perturbation))))))
+             (add lrdct lb-perturbation)
+           (declare
+            (type reduction new-lrdct)
+            (type morphism lb-perturbation))
+           (build-hmeq
+            :lrdct new-lrdct
+            :rrdct (add rrdct top-perturbation)
+            :orgn `(add ,hmeq ,lb-perturbation))))))