diff --git a/src/bar.lisp b/src/bar.lisp index 9433902..651b313 100644 --- a/src/bar.lisp +++ b/src/bar.lisp @@ -248,6 +248,8 @@ (funcall r 5 (abar 2 (d 3) 3 (d 7)))) |# +(DEFGENERIC VRTC-BAR (chcm-hmeq-mrph)) + (DEFMETHOD VRTC-BAR ((chcm chain-complex)) (the chain-complex (with-slots (cmpr basis dffr) chcm @@ -397,6 +399,8 @@ (cmbn-list (gnrt-? vrtc-dffr degr abar)))))) (the intr-mrph #'rslt))) +(DEFGENERIC BAR (algebra-or-hmeq)) + (DEFMETHOD BAR ((algebra algebra)) (let ((vrtc-bar (vrtc-bar algebra)) (bar-hrzn-dffr (bar-hrzn-dffr algebra))) diff --git a/src/chain-complexes.lisp b/src/chain-complexes.lisp index 80390e2..189f5ed 100644 --- a/src/chain-complexes.lisp +++ b/src/chain-complexes.lisp @@ -117,6 +117,7 @@ identifier IDNUM or NIL, if it doesn't exist." (result-clnm result) (result-rntm result)) result) +(DEFGENERIC ?2 (chcm-or-mrph cmbn)) (DEFMETHOD ?2 ((mrph morphism) cmbn) (declare (type cmbn cmbn)) @@ -129,6 +130,8 @@ identifier IDNUM or NIL, if it doesn't exist." (the cmbn (cmbn-? (dffr1 chcm) cmbn))) +(DEFGENERIC ?3 (chcm-or-mrph degr gnrt)) + (DEFMETHOD ?3 ((mrph morphism) degr gnrt) (declare (fixnum degr) diff --git a/src/chcm-elementary-op.lisp b/src/chcm-elementary-op.lisp index 37a2e9c..d3de64f 100644 --- a/src/chcm-elementary-op.lisp +++ b/src/chcm-elementary-op.lisp @@ -59,6 +59,7 @@ :strt :cmbn :orgn `(opps ,mrph))))) +(DEFGENERIC CMPS (chain-complex chcm-or-mrph &optional strt)) (DEFMETHOD CMPS ((chcm1 chain-complex) (chcm2 chain-complex) &optional strt) (declare (type (or strt null) strt)) @@ -146,6 +147,7 @@ :intr (n-mrph-intr n mrph) :strt :cmbn :orgn `(n-mrph ,n ,mrph))))) +(DEFGENERIC ADD (chcm-or-mrph morphism &optional strt)) (DEFMETHOD ADD ((mrph1 morphism) (mrph2 morphism) &optional strt) (declare (type (or null strt) strt)) @@ -199,6 +201,7 @@ :strt :cmbn :orgn `(2mrph-add ,mrph1 ,mrph2 ,strt))))))))) +(DEFGENERIC SBTR (chcm-or-mrph morphism &optional strt)) (DEFMETHOD SBTR ((mrph1 morphism) (mrph2 morphism) &optional strt) (declare (type (or null strt) strt)) @@ -253,7 +256,6 @@ :strt :cmbn :orgn `(2mrph-sbtr ,mrph1 ,mrph2 ,strt))))))))) - (DEFUN CHANGE-SORC-TRGT (mrph &key new-sorc new-trgt) (declare (type morphism mrph) @@ -274,7 +276,7 @@ (type (or null chain-complex) new-sorc new-trgt)) (the morphism (with-slots (sorc trgt) mrph - (when new-sorc + (when new-sorc (setf sorc new-sorc)) (when new-trgt (setf trgt new-trgt)) diff --git a/src/classifying-spaces.lisp b/src/classifying-spaces.lisp index 780223f..bd138c6 100644 --- a/src/classifying-spaces.lisp +++ b/src/classifying-spaces.lisp @@ -290,6 +290,8 @@ (print (funcall face i 4 gbar))) |# +(DEFGENERIC CLASSIFYING-SPACE (smgr)) + (DEFMETHOD CLASSIFYING-SPACE ((smgr simplicial-group)) (the simplicial-set (build-smst :cmpr (classifying-space-cmpr (cmpr smgr)) @@ -364,6 +366,7 @@ (funcall grin 3 (gbar 3 0 '(1 2) 1 '() 0 '())) |# + (DEFMETHOD CLASSIFYING-SPACE ((smgr ab-simplicial-group)) (the ab-simplicial-group (change-class diff --git a/src/cobar.lisp b/src/cobar.lisp index 6e76425..137ea09 100644 --- a/src/cobar.lisp +++ b/src/cobar.lisp @@ -86,7 +86,7 @@ #'(lambda (item) (declare (type gnrt item)) (list (cbgn degr item))) - (funcall basis (1+ degr))))) + (funcall basis (1+ degr))))) (mapcan #'(lambda (degr1) (declare (fixnum degr1)) @@ -265,6 +265,8 @@ (funcall r 5 (allp 2 (d (mask 4)) 3 (d (mask 5))))) |# +(DEFGENERIC VRTC-COBAR (chcm-or-hmeq-or-rdct)) + (DEFMETHOD VRTC-COBAR ((chcm chain-complex)) (the chain-complex (with-slots (cmpr basis dffr) chcm @@ -407,6 +409,8 @@ (cmbn-list (gnrt-? hrzn-dffr degr allp)))))) (the intr-mrph #'rslt))) +(DEFGENERIC COBAR (clgbr-or-hmeq)) + (DEFMETHOD COBAR ((coalgebra coalgebra)) (let ((vrtc-cobar (vrtc-cobar coalgebra)) (cobar-hrzn-dffr (cobar-hrzn-dffr coalgebra))) diff --git a/src/effective-homology.lisp b/src/effective-homology.lisp index a99fba2..8472b30 100644 --- a/src/effective-homology.lisp +++ b/src/effective-homology.lisp @@ -131,6 +131,7 @@ Return NIL if it doesn't exist." #+clisp(eval-when (:compile-toplevel :load-toplevel :execute) (setf (ext:package-lock :clos) t)) +(DEFGENERIC HMEQ (integer)) (DEFMETHOD HMEQ ((n integer)) (declare (fixnum n)) @@ -165,7 +166,6 @@ Return NIL if it doesn't exist." ;; Functions. - (DEFUN PRE-CHECK-RDCT (rdct) (declare (type reduction rdct)) (with-slots (bcc tcc f g h) rdct diff --git a/src/searching-homology.lisp b/src/searching-homology.lisp index ae7f1be..a1d4faf 100644 --- a/src/searching-homology.lisp +++ b/src/searching-homology.lisp @@ -9,6 +9,8 @@ (DEFUN ECHCM (chcm) (rbcc (efhm chcm))) +(DEFGENERIC HOMOLOGY (chcm degr1 &optional degr2)) + (DEFMETHOD HOMOLOGY ((chcm chain-complex) degr1 &optional (degr2 (1+ degr1))) (declare (fixnum degr1 degr2)) (do ((degr degr1 (1+ degr))) diff --git a/src/suspensions.lisp b/src/suspensions.lisp index a5bfe9a..49f401f 100644 --- a/src/suspensions.lisp +++ b/src/suspensions.lisp @@ -72,6 +72,9 @@ obj (suspension-1 (suspension obj (1- n))))) + +(DEFGENERIC SUSPENSION-1 (x)) + (DEFMETHOD SUSPENSION-1 ((chcm chain-complex)) (the chain-complex (with-slots (cmpr basis dffr) chcm @@ -244,7 +247,7 @@ (funcall sd (cmbn 2 4 3)) (funcall sd (cmbn 3 4 7)) |# - + (DEFMETHOD SUSPENSION-1 ((mrph morphism)) (the morphism (let ((orgn (orgn mrph))) diff --git a/src/tensor-products.lisp b/src/tensor-products.lisp index 50e814f..7da7b06 100644 --- a/src/tensor-products.lisp +++ b/src/tensor-products.lisp @@ -194,6 +194,8 @@ (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 @@ -278,6 +280,8 @@ (funcall rslt 5 (tnpr 3 'a 2 'b))) |# + + (DEFMETHOD TNSR-PRDC ((mrph1 morphism) (mrph2 morphism)) (the morphism (with-slots ((sorc1 sorc) (trgt1 trgt) (degr1 degr)) mrph1