From 9fba07a1c0159628188322639dc34821a14948bf Mon Sep 17 00:00:00 2001
From: Gerd Heber <gheber@hdfgroup.org>
Date: Tue, 14 Jul 2015 20:31:52 -0500
Subject: [PATCH] Formatting updates.

---
 src/cl-space-efhm.lisp       |  89 ++++++++++------------
 test/circle.lisp             |  17 +----
 test/cl-space-efhm-test.lisp | 139 +++++++++++++++++++++++------------
 3 files changed, 133 insertions(+), 112 deletions(-)

diff --git a/src/cl-space-efhm.lisp b/src/cl-space-efhm.lisp
index f942c25..f158e51 100644
--- a/src/cl-space-efhm.lisp
+++ b/src/cl-space-efhm.lisp
@@ -17,6 +17,7 @@
   (the chain-complex
        (tnsr-prdc clsp-tnsr-smgr bar)))
 
+
 (DEFUN CS-HAT-RIGHT-PERTURBATION-INTR (smgr)
   (declare (type simplicial-group smgr))
   (let ((aprd (aprd smgr)))
@@ -24,56 +25,44 @@
 	     (declare
 	      (fixnum degr)
 	      (type tnpr tnpr))
-	     (with-tnpr (degr1 tnpr1 degr2 abar2) tnpr
-			(when (zerop degr2)
-			  (return-from rslt (zero-cmbn (1- degr))))
-			(with-tnpr (degr11 gbar11 degr12 gmsm12) tnpr1
-				   (let ((sign (-1-expt-n degr1))
-					 (brgn21 (first (abar-list abar2)))
-					 (bar22 (make-abar
-						 :list (rest (abar-list
-							      abar2)))))
-				     (declare
-				      (fixnum sign)
-				      (type brgn brgn21)
-				      (type abar bar22))
-				     (with-brgn (degr21 gmsm21) brgn21
-						(let ((degr22 (- degr2 degr21)))
-						  (declare (fixnum degr22))
-						  (decf degr21) ;; = dmns(gmsm21)
-						  (let ((aprd
-							 (gnrt-? aprd
-								 (+ degr12
-								    degr21)
-								 (tnpr degr12
-								       gmsm12
-								       degr21
-								       gmsm21))))
-						    (declare (type cmbn aprd))
-						    (with-cmbn (degr12+21 list)
-						      aprd
-						      (make-cmbn
-						       :degr (1- degr)
-						       :list
-						       (mapcar
-							#'(lambda (term)
-							    (declare
-							     (type term term))
-							    (with-term
-								(cffc gmsm) term
-								(term (* sign
-									 cffc)
-								      (tnpr
-								       (+ degr1
-									  degr21)
-								       (tnpr
-									degr11
-									gbar11
-									degr12+21
-									gmsm)
-								       degr22
-								       bar22))))
-							list)))))))))))
+	     (with-tnpr
+		 (degr1 tnpr1 degr2 abar2) tnpr
+		 (when (zerop degr2)
+		   (return-from rslt (zero-cmbn (1- degr))))
+		 (with-tnpr
+		     (degr11 gbar11 degr12 gmsm12) tnpr1
+		     (let ((sign (-1-expt-n degr1))
+			   (brgn21 (first (abar-list abar2)))
+			   (bar22 (make-abar :list (rest (abar-list abar2)))))
+		       (declare
+			(fixnum sign)
+			(type brgn brgn21)
+			(type abar bar22))
+		       (with-brgn
+			   (degr21 gmsm21) brgn21
+			   (let ((degr22 (- degr2 degr21)))
+			     (declare (fixnum degr22))
+			     (decf degr21) ;; = dmns(gmsm21)
+			     (let ((aprd (gnrt-? aprd (+ degr12 degr21)
+						 (tnpr degr12 gmsm12
+						       degr21 gmsm21))))
+			       (declare (type cmbn aprd))
+			       (with-cmbn
+				   (degr12+21 list) aprd
+				   (make-cmbn
+				    :degr (1- degr)
+				    :list
+				    (mapcar
+				     #'(lambda (term)
+					 (declare (type term term))
+					 (with-term
+					     (cffc gmsm) term
+					     (term (* sign cffc)
+						   (tnpr (+ degr1 degr21)
+							 (tnpr degr11 gbar11
+							       degr12+21 gmsm)
+							 degr22 bar22))))
+				     list)))))))))))
       (the intr-mrph #'rslt))))
 
 
diff --git a/test/circle.lisp b/test/circle.lisp
index cf6d6e7..45ba537 100644
--- a/test/circle.lisp
+++ b/test/circle.lisp
@@ -3,26 +3,11 @@
 
 (in-suite :kenzo)
 
-(defun circle ()
-  (the cat:chain-complex
-       (cat:build-chcm
-	:cmpr #'(lambda (gnrt1 gnrt2)
-		  (declare (ignore gnrt1 gnrt2))
-		  (the cat:cmpr :equal))
-	:basis #'(lambda (dmns)
-		   (the list
-			(case dmns (0 '(*)) (1 '(s1))
-			      (otherwise cat:+empty-list+))))
-	:bsgn '*
-	:intr-dffr #'cat:zero-intr-dffr
-	:strt :cmbn
-	:orgn '(circle))))
-
 
 (test circle
       (progn
 	(cat:cat-init)
-	(let ((circle (circle)))
+	(let ((circle (cat:circle)))
 	  (is (equal (cat:basis circle 0) '(*)))
 	  (is (equal (cat:basis circle 1) '(s1)))
 	  (is (equal (cat:basis circle 2) cat:+empty-list+)))))
diff --git a/test/cl-space-efhm-test.lisp b/test/cl-space-efhm-test.lisp
index e31f832..857e782 100644
--- a/test/cl-space-efhm-test.lisp
+++ b/test/cl-space-efhm-test.lisp
@@ -5,49 +5,96 @@
 
 
 (test cs-hat-u-t
-      (progn
-	(cat:cat-init)
-	(let* ((c (cat:cs-hat-u-t (cat:k-z-1)))
-	       (abar (random-abar 8 4))
-	       (abar-degr (apply #'+ (mapcar #'car (cat:abar-list abar))))
-	       (gnrt (cat:tnpr 5 (cat:tnpr 3 (cat:gbar 3 0 '(1 2) 0 '(3) 0 '())
-					   2 '(4 5))
-			       abar-degr abar)))
-	  (dotimes (i 5) (print (random-abar 8 4)))
-	  (cat:? c (+ 5 abar-degr) gnrt)
-	  (cat:? c (cat:? c (+ 5 abar-degr) gnrt))
-	  (dotimes (i 10)
-	    (let ((abar (random-abar 8 4)))
-	      (setf abar-degr (apply #'+ (mapcar #'car (cat:abar-list abar))))
-	      (setf gnrt (cat:tnpr 5 (cat:tnpr 3 (cat:gbar 3 0 '(1 2) 0 '(3)
-							   0 '()) 2 '(4 5))
-				   abar-degr abar))
-	      (unless (>= abar-degr 10)
-		(print (cat:? c (+ 5 abar-degr) gnrt))
-		(print (cat:? c (cat:? c (+ 5 abar-degr) gnrt))))))
-	  (dotimes (i 10)
-	    (let ((abar (random-abar 8 4)))
-	      (setf abar-degr (apply #'+ (mapcar #'car (cat:abar-list abar))))
-	      (setf gnrt (cat:tnpr 6 (cat:tnpr 3 (cat:gbar 3 0 '(1 2) 0 '(3)
-							   0 '()) 3 '(4 5 6))
-				   abar-degr abar))
-	      (unless (>= abar-degr 9)
-		(print (cat:? c (+ 6 abar-degr) gnrt))
-		(print (cat:? c (cat:? c (+ 6 abar-degr) gnrt))))))
-	  (dotimes (i 10)
-	    (let ((abar (random-abar 8 4)))
-	      (setf abar-degr (apply #'+ (mapcar #'car (cat:abar-list abar))))
-	      (setf gnrt (cat:tnpr 5 (cat:tnpr 2 (cat:gbar 2 0 '(3) 0 '())
-					       3 '(4 5 6)) abar-degr abar))
-	      (unless (>= abar-degr 10)
-		(print (cat:? c (+ 5 abar-degr) gnrt))
-		(print (cat:? c (cat:? c (+ 5 abar-degr) gnrt))))))
-	  (dotimes (i 10)
-	    (let ((abar (random-abar 8 4)))
-	      (setf abar-degr (apply #'+ (mapcar #'car (cat:abar-list abar))))
-	      (setf gnrt (cat:tnpr 4 (cat:tnpr 2 (cat:gbar 2 0 '(3) 0 '())
-					       2 '(4 5))
-				   abar-degr abar))
-	      (unless (>= abar-degr 11)
-		(print (cat:? c (+ 4 abar-degr) gnrt))
-		(print (cat:? c (cat:? c (+ 4 abar-degr) gnrt)))))))))
+      (cat:cat-init)
+      (let* ((c (cat:cs-hat-u-t (cat:k-z-1)))
+	     (abar (random-abar 8 4))
+	     (abar-degr (apply #'+ (mapcar #'car (cat:abar-list abar))))
+	     (gnrt (cat:tnpr 5 (cat:tnpr 3 (cat:gbar 3 0 '(1 2) 0 '(3) 0 '())
+					 2 '(4 5))
+			     abar-degr abar)))
+	(cat:? c (+ 5 abar-degr) gnrt)
+	(cat:? c (cat:? c (+ 5 abar-degr) gnrt))
+	(dotimes (i 10)
+	  (let ((abar (random-abar 8 4)))
+	    (setf abar-degr (apply #'+ (mapcar #'car (cat:abar-list abar))))
+	    (setf gnrt (cat:tnpr 5 (cat:tnpr 3 (cat:gbar 3 0 '(1 2) 0 '(3)
+							 0 '()) 2 '(4 5))
+				 abar-degr abar))
+	    (unless (>= abar-degr 10)
+	      (print (cat:? c (+ 5 abar-degr) gnrt))
+	      (print (cat:? c (cat:? c (+ 5 abar-degr) gnrt))))))
+	(dotimes (i 10)
+	  (let ((abar (random-abar 8 4)))
+	    (setf abar-degr (apply #'+ (mapcar #'car (cat:abar-list abar))))
+	    (setf gnrt (cat:tnpr 6 (cat:tnpr 3 (cat:gbar 3 0 '(1 2) 0 '(3)
+							 0 '()) 3 '(4 5 6))
+				 abar-degr abar))
+	    (unless (>= abar-degr 9)
+	      (print (cat:? c (+ 6 abar-degr) gnrt))
+	      (print (cat:? c (cat:? c (+ 6 abar-degr) gnrt))))))
+	(dotimes (i 10)
+	  (let ((abar (random-abar 8 4)))
+	    (setf abar-degr (apply #'+ (mapcar #'car (cat:abar-list abar))))
+	    (setf gnrt (cat:tnpr 5 (cat:tnpr 2 (cat:gbar 2 0 '(3) 0 '())
+					     3 '(4 5 6)) abar-degr abar))
+	    (unless (>= abar-degr 10)
+	      (print (cat:? c (+ 5 abar-degr) gnrt))
+	      (print (cat:? c (cat:? c (+ 5 abar-degr) gnrt))))))
+	(dotimes (i 10)
+	  (let ((abar (random-abar 8 4)))
+	    (setf abar-degr (apply #'+ (mapcar #'car (cat:abar-list abar))))
+	    (setf gnrt (cat:tnpr 4 (cat:tnpr 2 (cat:gbar 2 0 '(3) 0 '())
+					     2 '(4 5))
+				 abar-degr abar))
+	    (unless (>= abar-degr 11)
+	      (print (cat:? c (+ 4 abar-degr) gnrt))
+	      (print (cat:? c (cat:? c (+ 4 abar-degr) gnrt))))))))
+
+
+(test cs-hat-t-u
+      (cat:cat-init)
+      (dotimes (i 5) (print (random-abar 8 4)))
+      (let* ((c (cat:cs-hat-t-u (cat:k-z-1)))
+	     (abar (random-abar 8 4))
+	     (abar-degr (apply #'+ (mapcar #'car (cat:abar-list abar))))
+	     (gnrt (cat:tnpr 5 (cat:tnpr 3 (cat:gbar 3 0 '(1 2) 0 '(3) 0 '())
+					 2 '(4 5))
+			     abar-degr abar)))
+	(cat:? c (+ 5 abar-degr) gnrt)
+	(cat:? c (cat:? c (+ 5 abar-degr) gnrt))
+	(dotimes (i 10)
+	  (let ((abar (random-abar 8 4)))
+	    (setf abar-degr (apply #'+ (mapcar #'car (cat:abar-list abar))))
+	    (setf gnrt (cat:tnpr 5 (cat:tnpr 3 (cat:gbar 3 0 '(1 2) 0 '(3)
+							 0 '()) 2 '(4 5))
+				 abar-degr abar))
+	    (unless (>= abar-degr 10)
+	      (print (cat:? c (+ 5 abar-degr) gnrt))
+	      (print (cat:? c (cat:? c (+ 5 abar-degr) gnrt))))))
+	(dotimes (i 10)
+	  (let ((abar (random-abar 8 4)))
+	    (setf abar-degr (apply #'+ (mapcar #'car (cat:abar-list abar))))
+	    (setf gnrt (cat:tnpr 6 (cat:tnpr 3 (cat:gbar 3 0 '(1 2) 0 '(3)
+							 0 '()) 3 '(4 5 6))
+				 abar-degr abar))
+	    (unless (>= abar-degr 9)
+	      (print (cat:? c (+ 6 abar-degr) gnrt))
+	      (print (cat:? c (cat:? c (+ 6 abar-degr) gnrt))))))
+	(dotimes (i 10)
+	  (let ((abar (random-abar 8 4)))
+	    (setf abar-degr (apply #'+ (mapcar #'car (cat:abar-list abar))))
+	    (setf gnrt (cat:tnpr 5 (cat:tnpr 2 (cat:gbar 2 0 '(3) 0 '())
+					     3 '(4 5 6))
+				 abar-degr abar))
+	    (unless (>= abar-degr 10)
+	      (print (cat:? c (+ 5 abar-degr) gnrt))
+	      (print (cat:? c (cat:? c (+ 5 abar-degr) gnrt))))))
+	(dotimes (i 10)
+	  (let ((abar (random-abar 8 4)))
+	    (setf abar-degr (apply #'+ (mapcar #'car (cat:abar-list abar))))
+	    (setf gnrt (cat:tnpr 4 (cat:tnpr 2 (cat:gbar 2 0 '(3) 0 '())
+					     2 '(4 5))
+				 abar-degr abar))
+	    (unless (>= abar-degr 11)
+	      (print (cat:? c (+ 4 abar-degr) gnrt))
+	      (print (cat:? c (cat:? c (+ 4 abar-degr) gnrt))))))))