Added a few missing DEFGENERICs.

Good for the soul...
This commit is contained in:
gheber 2015-07-04 18:35:29 -05:00
parent 3c5c05989e
commit 1d828f8cf6
9 changed files with 30 additions and 5 deletions

View File

@ -248,6 +248,8 @@
(funcall r 5 (abar 2 (d 3) 3 (d 7)))) (funcall r 5 (abar 2 (d 3) 3 (d 7))))
|# |#
(DEFGENERIC VRTC-BAR (chcm-hmeq-mrph))
(DEFMETHOD VRTC-BAR ((chcm chain-complex)) (DEFMETHOD VRTC-BAR ((chcm chain-complex))
(the chain-complex (the chain-complex
(with-slots (cmpr basis dffr) chcm (with-slots (cmpr basis dffr) chcm
@ -397,6 +399,8 @@
(cmbn-list (gnrt-? vrtc-dffr degr abar)))))) (cmbn-list (gnrt-? vrtc-dffr degr abar))))))
(the intr-mrph #'rslt))) (the intr-mrph #'rslt)))
(DEFGENERIC BAR (algebra-or-hmeq))
(DEFMETHOD BAR ((algebra algebra)) (DEFMETHOD BAR ((algebra algebra))
(let ((vrtc-bar (vrtc-bar algebra)) (let ((vrtc-bar (vrtc-bar algebra))
(bar-hrzn-dffr (bar-hrzn-dffr algebra))) (bar-hrzn-dffr (bar-hrzn-dffr algebra)))

View File

@ -117,6 +117,7 @@ identifier IDNUM or NIL, if it doesn't exist."
(result-clnm result) (result-rntm result)) (result-clnm result) (result-rntm result))
result) result)
(DEFGENERIC ?2 (chcm-or-mrph cmbn))
(DEFMETHOD ?2 ((mrph morphism) cmbn) (DEFMETHOD ?2 ((mrph morphism) cmbn)
(declare (type cmbn cmbn)) (declare (type cmbn cmbn))
@ -129,6 +130,8 @@ identifier IDNUM or NIL, if it doesn't exist."
(the cmbn (the cmbn
(cmbn-? (dffr1 chcm) cmbn))) (cmbn-? (dffr1 chcm) cmbn)))
(DEFGENERIC ?3 (chcm-or-mrph degr gnrt))
(DEFMETHOD ?3 ((mrph morphism) degr gnrt) (DEFMETHOD ?3 ((mrph morphism) degr gnrt)
(declare (declare
(fixnum degr) (fixnum degr)

View File

@ -59,6 +59,7 @@
:strt :cmbn :strt :cmbn
:orgn `(opps ,mrph))))) :orgn `(opps ,mrph)))))
(DEFGENERIC CMPS (chain-complex chcm-or-mrph &optional strt))
(DEFMETHOD CMPS ((chcm1 chain-complex) (chcm2 chain-complex) &optional strt) (DEFMETHOD CMPS ((chcm1 chain-complex) (chcm2 chain-complex) &optional strt)
(declare (type (or strt null) strt)) (declare (type (or strt null) strt))
@ -146,6 +147,7 @@
:intr (n-mrph-intr n mrph) :strt :cmbn :intr (n-mrph-intr n mrph) :strt :cmbn
:orgn `(n-mrph ,n ,mrph))))) :orgn `(n-mrph ,n ,mrph)))))
(DEFGENERIC ADD (chcm-or-mrph morphism &optional strt))
(DEFMETHOD ADD ((mrph1 morphism) (mrph2 morphism) &optional strt) (DEFMETHOD ADD ((mrph1 morphism) (mrph2 morphism) &optional strt)
(declare (type (or null strt) strt)) (declare (type (or null strt) strt))
@ -199,6 +201,7 @@
:strt :cmbn :strt :cmbn
:orgn `(2mrph-add ,mrph1 ,mrph2 ,strt))))))))) :orgn `(2mrph-add ,mrph1 ,mrph2 ,strt)))))))))
(DEFGENERIC SBTR (chcm-or-mrph morphism &optional strt))
(DEFMETHOD SBTR ((mrph1 morphism) (mrph2 morphism) &optional strt) (DEFMETHOD SBTR ((mrph1 morphism) (mrph2 morphism) &optional strt)
(declare (type (or null strt) strt)) (declare (type (or null strt) strt))
@ -253,7 +256,6 @@
:strt :cmbn :strt :cmbn
:orgn `(2mrph-sbtr ,mrph1 ,mrph2 ,strt))))))))) :orgn `(2mrph-sbtr ,mrph1 ,mrph2 ,strt)))))))))
(DEFUN CHANGE-SORC-TRGT (mrph &key new-sorc new-trgt) (DEFUN CHANGE-SORC-TRGT (mrph &key new-sorc new-trgt)
(declare (declare
(type morphism mrph) (type morphism mrph)
@ -274,7 +276,7 @@
(type (or null chain-complex) new-sorc new-trgt)) (type (or null chain-complex) new-sorc new-trgt))
(the morphism (the morphism
(with-slots (sorc trgt) mrph (with-slots (sorc trgt) mrph
(when new-sorc (when new-sorc
(setf sorc new-sorc)) (setf sorc new-sorc))
(when new-trgt (when new-trgt
(setf trgt new-trgt)) (setf trgt new-trgt))

View File

@ -290,6 +290,8 @@
(print (funcall face i 4 gbar))) (print (funcall face i 4 gbar)))
|# |#
(DEFGENERIC CLASSIFYING-SPACE (smgr))
(DEFMETHOD CLASSIFYING-SPACE ((smgr simplicial-group)) (DEFMETHOD CLASSIFYING-SPACE ((smgr simplicial-group))
(the simplicial-set (the simplicial-set
(build-smst :cmpr (classifying-space-cmpr (cmpr smgr)) (build-smst :cmpr (classifying-space-cmpr (cmpr smgr))
@ -364,6 +366,7 @@
(funcall grin 3 (gbar 3 0 '(1 2) 1 '() 0 '())) (funcall grin 3 (gbar 3 0 '(1 2) 1 '() 0 '()))
|# |#
(DEFMETHOD CLASSIFYING-SPACE ((smgr ab-simplicial-group)) (DEFMETHOD CLASSIFYING-SPACE ((smgr ab-simplicial-group))
(the ab-simplicial-group (the ab-simplicial-group
(change-class (change-class

View File

@ -86,7 +86,7 @@
#'(lambda (item) #'(lambda (item)
(declare (type gnrt item)) (declare (type gnrt item))
(list (cbgn degr item))) (list (cbgn degr item)))
(funcall basis (1+ degr))))) (funcall basis (1+ degr)))))
(mapcan (mapcan
#'(lambda (degr1) #'(lambda (degr1)
(declare (fixnum degr1)) (declare (fixnum degr1))
@ -265,6 +265,8 @@
(funcall r 5 (allp 2 (d (mask 4)) 3 (d (mask 5))))) (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)) (DEFMETHOD VRTC-COBAR ((chcm chain-complex))
(the chain-complex (the chain-complex
(with-slots (cmpr basis dffr) chcm (with-slots (cmpr basis dffr) chcm
@ -407,6 +409,8 @@
(cmbn-list (gnrt-? hrzn-dffr degr allp)))))) (cmbn-list (gnrt-? hrzn-dffr degr allp))))))
(the intr-mrph #'rslt))) (the intr-mrph #'rslt)))
(DEFGENERIC COBAR (clgbr-or-hmeq))
(DEFMETHOD COBAR ((coalgebra coalgebra)) (DEFMETHOD COBAR ((coalgebra coalgebra))
(let ((vrtc-cobar (vrtc-cobar coalgebra)) (let ((vrtc-cobar (vrtc-cobar coalgebra))
(cobar-hrzn-dffr (cobar-hrzn-dffr coalgebra))) (cobar-hrzn-dffr (cobar-hrzn-dffr coalgebra)))

View File

@ -131,6 +131,7 @@ Return NIL if it doesn't exist."
#+clisp(eval-when (:compile-toplevel :load-toplevel :execute) #+clisp(eval-when (:compile-toplevel :load-toplevel :execute)
(setf (ext:package-lock :clos) t)) (setf (ext:package-lock :clos) t))
(DEFGENERIC HMEQ (integer))
(DEFMETHOD HMEQ ((n integer)) (DEFMETHOD HMEQ ((n integer))
(declare (fixnum n)) (declare (fixnum n))
@ -165,7 +166,6 @@ Return NIL if it doesn't exist."
;; Functions. ;; Functions.
(DEFUN PRE-CHECK-RDCT (rdct) (DEFUN PRE-CHECK-RDCT (rdct)
(declare (type reduction rdct)) (declare (type reduction rdct))
(with-slots (bcc tcc f g h) rdct (with-slots (bcc tcc f g h) rdct

View File

@ -9,6 +9,8 @@
(DEFUN ECHCM (chcm) (DEFUN ECHCM (chcm)
(rbcc (efhm chcm))) (rbcc (efhm chcm)))
(DEFGENERIC HOMOLOGY (chcm degr1 &optional degr2))
(DEFMETHOD HOMOLOGY ((chcm chain-complex) degr1 &optional (degr2 (1+ degr1))) (DEFMETHOD HOMOLOGY ((chcm chain-complex) degr1 &optional (degr2 (1+ degr1)))
(declare (fixnum degr1 degr2)) (declare (fixnum degr1 degr2))
(do ((degr degr1 (1+ degr))) (do ((degr degr1 (1+ degr)))

View File

@ -72,6 +72,9 @@
obj obj
(suspension-1 (suspension obj (1- n))))) (suspension-1 (suspension obj (1- n)))))
(DEFGENERIC SUSPENSION-1 (x))
(DEFMETHOD SUSPENSION-1 ((chcm chain-complex)) (DEFMETHOD SUSPENSION-1 ((chcm chain-complex))
(the chain-complex (the chain-complex
(with-slots (cmpr basis dffr) chcm (with-slots (cmpr basis dffr) chcm
@ -244,7 +247,7 @@
(funcall sd (cmbn 2 4 3)) (funcall sd (cmbn 2 4 3))
(funcall sd (cmbn 3 4 7)) (funcall sd (cmbn 3 4 7))
|# |#
(DEFMETHOD SUSPENSION-1 ((mrph morphism)) (DEFMETHOD SUSPENSION-1 ((mrph morphism))
(the morphism (the morphism
(let ((orgn (orgn mrph))) (let ((orgn (orgn mrph)))

View File

@ -194,6 +194,8 @@
(funcall rslt 6 (tnpr 3 '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)) (DEFMETHOD TNSR-PRDC ((chcm1 chain-complex) (chcm2 chain-complex))
(the chain-complex (the chain-complex
(with-slots ((cmpr1 cmpr) (basis1 basis) (dffr1 dffr)) chcm1 (with-slots ((cmpr1 cmpr) (basis1 basis) (dffr1 dffr)) chcm1
@ -278,6 +280,8 @@
(funcall rslt 5 (tnpr 3 'a 2 'b))) (funcall rslt 5 (tnpr 3 'a 2 'b)))
|# |#
(DEFMETHOD TNSR-PRDC ((mrph1 morphism) (mrph2 morphism)) (DEFMETHOD TNSR-PRDC ((mrph1 morphism) (mrph2 morphism))
(the morphism (the morphism
(with-slots ((sorc1 sorc) (trgt1 trgt) (degr1 degr)) mrph1 (with-slots ((sorc1 sorc) (trgt1 trgt) (degr1 degr)) mrph1