59 lines
2.0 KiB
Common Lisp
59 lines
2.0 KiB
Common Lisp
;;; COALGEBRAS COALGEBRAS COALGEBRAS COALGEBRAS COALGEBRAS COALGEBRAS
|
|
;;; COALGEBRAS COALGEBRAS COALGEBRAS COALGEBRAS COALGEBRAS COALGEBRAS
|
|
;;; COALGEBRAS COALGEBRAS COALGEBRAS COALGEBRAS COALGEBRAS COALGEBRAS
|
|
|
|
(IN-PACKAGE "CAT")
|
|
|
|
(PROVIDE "coalgebras")
|
|
|
|
(DEFMETHOD PRINT-OBJECT ((clgb coalgebra) stream)
|
|
(the coalgebra
|
|
(progn
|
|
(format stream "[K~D Coalgebra]" (idnm clgb))
|
|
clgb)))
|
|
|
|
(DEFUN COALGEBRA (&rest rest &key dfnt &allow-other-keys)
|
|
(declare (type list dfnt))
|
|
(already coalgebra dfnt)
|
|
(the coalgebra
|
|
(apply #'make-instance 'coalgebra rest)))
|
|
|
|
(DEFMETHOD SHARED-INITIALIZE ((clgb coalgebra) slot-names &key cprd-intr cprd-strt)
|
|
(declare
|
|
(type (or (eql t) list) slot-names)
|
|
(type intr cprd-intr)
|
|
(type strt cprd-strt))
|
|
(call-next-method)
|
|
(when-slot cprd
|
|
(with-slots (cprd) clgb
|
|
(declare (type morphism cprd))
|
|
(when cprd-intr
|
|
(unless cprd-strt
|
|
(error "IN COALGEBRA, a CPRD-INTR is given, but not its CPRD-STRT."))
|
|
(setf cprd (morphism :sorc clgb :trgt (tnsr-prdc clgb clgb) :degr 0
|
|
:intr cprd-intr :strt cprd-strt
|
|
:dfnt `(coalgebra-coproduct ,clgb))))))
|
|
clgb)
|
|
|
|
(DEFUN CHANGE-CHCM-TO-CLGB (chcm &key cprd-intr cprd-strt dfnt)
|
|
(declare
|
|
(type chain-complex chcm)
|
|
(type intr cprd-intr)
|
|
(type strt cprd-strt)
|
|
(list dfnt))
|
|
(the coalgebra
|
|
(progn
|
|
(change-class chcm 'coalgebra)
|
|
(setf dfnt (list (dfnt chcm) 'then dfnt))
|
|
(let ((already (find dfnt *k-list* :key #'dfnt :test #'equal)))
|
|
(declare (type (or null coalgebra) already))
|
|
(when already
|
|
(return-from change-chcm-to-clgb already)))
|
|
(setf (slot-value chcm 'cprd) (morphism
|
|
:sorc chcm :trgt (tnsr-prdc chcm chcm)
|
|
:degr 0
|
|
:intr cprd-intr :strt cprd-strt
|
|
:dfnt dfnt))
|
|
chcm)))
|
|
|