Extracted simplicial groups test.

kenzo-test.asd

@@ -27,6 +27,7 @@
 	       (:file "k-pi-n-test")
 	       (:file "kan-test")
 	       (:file "searching-homology-test")
+	       (:file "simplicial-groups-test")
 	       (:file "simplicial-mrphs-test")
 	       (:file "simplicial-sets-test")
 	       (:file "tensor-products-test")

package.lisp

@@ -236,6 +236,7 @@
 	   ;; kan.lisp
 
 	   CHECK-HAT
+	   CHECK-KAN
 	   SMST-KAN
 
 	   ;; loop-spaces.lisp

src/simplicial-groups.lisp

@@ -6,11 +6,13 @@
 
 (PROVIDE "simplicial-groups")
 
+
 (DEFUN SMGR (idnm)
   (declare (fixnum idnm))
   (the (or null simplicial-group)
        (find idnm *smgr-list* :key #'idnm)))
 
+
 #+clisp(eval-when (:compile-toplevel :load-toplevel :execute)
          (setf (ext:package-lock :clos) nil))
 (DEFMETHOD PRINT-OBJECT ((smgr simplicial-group) stream)
@@ -70,6 +72,7 @@
     (push rslt *smgr-list*)
     rslt))
 
+
 (DEFUN A-GRML4 (sintr-grml dmns absm1 absm2)
   (declare
    (fixnum dmns)
@@ -83,6 +86,7 @@
 				    (- dmns (logcount dgop))
 				    crpr))))))
 
+
 (DEFUN A-GRIN4 (sintr-grin dmns absm)
   (declare
    (type sintr sintr-grin)
@@ -92,7 +96,9 @@
        (with-absm (dgop gmsm) absm
 		  (absm dgop
 			(gmsm
-	       (funcall sintr-grin (- dmns (logcount dgop)) gmsm))))))
+			 (funcall sintr-grin (- dmns (logcount dgop))
+				  gmsm))))))
+
 
 (DEFMETHOD SLOT-UNBOUND (class (smgr simplicial-group)
 			 (name (eql 'kfll)))
@@ -102,6 +108,7 @@
 	 (push smgr *kan-list*)
 	 (setf (slot-value smgr 'kfll) (smgr-kfll smgr)))))
 
+
 (DEFUN SMGR-KFLL-INTR (face sintr-grml sintr-grin)
   (flet ((rslt (indx dmns hat
 		     &aux (dmns-1 (1- dmns)))
@@ -156,6 +163,7 @@
 		  rslt))))
     (the kfll #'rslt)))
 
+
 (DEFUN SMGR-KFLL (smgr)
   (declare (type simplicial-group smgr))
   (with-slots (face grml grin) smgr
@@ -164,14 +172,6 @@
      (type simplicial-mrph grml grin))
     (smgr-kfll-intr face (sintr grml) (sintr grin))))
 
-#|
-  (cat-init)
-  (setf k (k-z-1))
-  (setf rslt '(1 10 100))
-  (setf hat (mapcar #'(lambda (i) (face k i 3 rslt)) (<a-b> 0 3)))
-  (dotimes (i 4)
-    (check-kan k i 3 (remove (nth i hat) hat :test #'equal)))
-|#
 
 (DEFMETHOD SLOT-UNBOUND (class (smgr simplicial-group)
 			 (name (eql 'aprd)))
@@ -181,6 +181,7 @@
 	 (push smgr *hopf-list*)
 	 (setf (slot-value smgr 'aprd) (smgr-aprd smgr)))))
 
+
 (DEFUN SMGR-APRD (smgr)
   (declare (type simplicial-group smgr))
   (the morphism
@@ -190,5 +191,3 @@
 	  (type morphism eml)
 	  (type simplicial-mrph grml))
 	 (cmps grml eml))))
-
-       

test/simplicial-groups-test.lisp

@@ -0,0 +1,15 @@
+
+(in-package :kenzo-test)
+
+(in-suite :kenzo)
+
+#|
+(test check-kan
+      (cat:cat-init)
+      (let* ((k (cat:k-z-1))
+	     (rslt '(1 10 100))
+	     (hat (mapcar #'(lambda (i) (cat:face k i 3 rslt))
+			  (cat:<a-b> 0 3))))
+	(dotimes (i 4)
+	  (cat:check-kan k i 3 (remove (nth i hat) hat :test #'equal)))))
+|#