Updated formattting
This commit is contained in:
parent
fe0f5a3e96
commit
baaec230bb
@ -389,7 +389,8 @@
|
||||
(unless (eq :less (funcall cmpr (-gnrt mark2) (-gnrt mark1)))
|
||||
(setf *wrong-cmbn* cmbn)
|
||||
(error "In the combination located by *WRONG-CMBN*, the generators:~@
|
||||
~A and ~A are in a wrong order." (cdar mark2) (cdar mark1)))))
|
||||
~A and ~A are in a wrong order." (cdar mark2)
|
||||
(cdar mark1)))))
|
||||
cmbn)
|
||||
|
||||
|
||||
@ -425,7 +426,7 @@
|
||||
(type gnrt gnrt))
|
||||
(the cmbn
|
||||
(progn
|
||||
;; (profiler-on)
|
||||
;; (profiler-on)
|
||||
(when (and *future-display*
|
||||
(> (get-internal-run-time) *future-display*))
|
||||
(format t "~%GNRT-?
|
||||
@ -452,7 +453,7 @@
|
||||
degr gnrt (svref (rslts mrph) degr)))
|
||||
(:cmbn
|
||||
(funcall intr (term-cmbn degr 1 gnrt))))
|
||||
;; (profiler-off mrph)
|
||||
;; (profiler-off mrph)
|
||||
))))))))
|
||||
|
||||
|
||||
@ -462,7 +463,7 @@
|
||||
(type cmbn cmbn))
|
||||
(the cmbn
|
||||
(progn
|
||||
;; (profiler-on)
|
||||
;; (profiler-on)
|
||||
(when (and *future-display*
|
||||
(> (get-internal-run-time) *future-display*))
|
||||
(format t "~%CMBN-?
|
||||
@ -490,6 +491,7 @@
|
||||
(if (cmbn-zero-p cmbn)
|
||||
(zero-cmbn (+ (cmbn-degr cmbn) degr))
|
||||
(mrph-cmbn scmpr tcmpr intr
|
||||
cmbn (svref (rslts mrph) (cmbn-degr cmbn))))
|
||||
;; (profiler-off mrph)
|
||||
cmbn (svref (rslts mrph)
|
||||
(cmbn-degr cmbn))))
|
||||
;; (profiler-off mrph)
|
||||
)))))))))
|
||||
|
||||
@ -215,7 +215,8 @@
|
||||
(unless (and (eq (grmd sorc1) (grmd sorc2))
|
||||
(eq (grmd trgt1) (grmd trgt2))
|
||||
(= degr1 degr2))
|
||||
(error "In 2MRPH-SBTR, ~A and ~A may not be subtracteded." mrph1 mrph2))
|
||||
(error "In 2MRPH-SBTR, ~A and ~A may not be subtracteded."
|
||||
mrph1 mrph2))
|
||||
(when (eq (first (orgn mrph1)) 'zero-mrph)
|
||||
(return-from sbtr mrph2))
|
||||
(when (eq (first (orgn mrph2)) 'zero-mrph)
|
||||
|
||||
@ -37,7 +37,7 @@
|
||||
|
||||
;; CMPRF = CoMPaRison Function
|
||||
(DEFTYPE CMPRF () 'function)
|
||||
;; (function (gnrt gnrt) cmpr)
|
||||
;; (function (gnrt gnrt) cmpr)
|
||||
|
||||
(DEFUN TERM-P (object)
|
||||
(declare (type any object))
|
||||
@ -74,12 +74,12 @@
|
||||
|#
|
||||
|
||||
(DEFTYPE BASIS () '(or function (eql :locally-effective)))
|
||||
;; (function (degr) (list gnrt))
|
||||
;; (function (degr) (list gnrt))
|
||||
|
||||
;; INTR-MRPH = INTeRnal-MoRPHism
|
||||
(DEFTYPE INTR-MRPH () 'function)
|
||||
;; (or (function (degr gnrt) cmbn) ;; if :gnrt strategy
|
||||
;; (function (cmbn) (cmbn)) ;; if :cmbn strategy
|
||||
;; (or (function (degr gnrt) cmbn) ;; if :gnrt strategy
|
||||
;; (function (cmbn) (cmbn)) ;; if :cmbn strategy
|
||||
|
||||
;;;
|
||||
;;; CHAIN-COMPLEXES
|
||||
@ -135,8 +135,8 @@
|
||||
(intr :type intr-mrph :initarg :intr :reader intr)
|
||||
;; STRaTegy
|
||||
(strt :type strt :initarg :strt :reader strt)
|
||||
;; ;; WoRk-TiMe
|
||||
;; (wrtm :type integer :initform 0 :accessor wrtm)
|
||||
;; ;; WoRk-TiMe
|
||||
;; (wrtm :type integer :initform 0 :accessor wrtm)
|
||||
;; CaLl NuMber
|
||||
(???-clnm :type fixnum :initform 0 :accessor ???-clnm)
|
||||
(?-clnm :type fixnum :initform 0 :accessor ?-clnm)
|
||||
@ -366,10 +366,10 @@
|
||||
|
||||
|
||||
(DEFTYPE FACE () 'function)
|
||||
;; (function (indx dmns gmsm) absm)
|
||||
;; (function (indx dmns gmsm) absm)
|
||||
|
||||
(DEFTYPE FACE* () 'function)
|
||||
;; (function (indx dmns gmsm) (or gmsm (eql :degenerate)))
|
||||
;; (function (indx dmns gmsm) (or gmsm (eql :degenerate)))
|
||||
|
||||
(DEFCLASS SIMPLICIAL-SET (coalgebra)
|
||||
((face :type face :initarg :face :reader face1)))
|
||||
@ -380,7 +380,7 @@
|
||||
;;;
|
||||
|
||||
(DEFTYPE SINTR () 'function)
|
||||
;; (function (dmns gmsm) absm)
|
||||
;; (function (dmns gmsm) absm)
|
||||
|
||||
(DEFCLASS SIMPLICIAL-MRPH (morphism)
|
||||
((sintr :type sintr :initarg :sintr :reader sintr)))
|
||||
@ -416,7 +416,7 @@
|
||||
;;;;
|
||||
|
||||
(DEFTYPE KFLL () 'function)
|
||||
;; (function (indx dmns (list absm)) absm)
|
||||
;; (function (indx dmns (list absm)) absm)
|
||||
|
||||
(DEFCLASS KAN (simplicial-set)
|
||||
((kfll :type kfll :initarg :kfll :reader kfll1)))
|
||||
@ -514,4 +514,3 @@
|
||||
(DEFSTRUCT (GBAR (:print-function gbar-print))
|
||||
(dmns -1 :type fixnum)
|
||||
(list () :type list))
|
||||
|
||||
|
||||
@ -167,7 +167,8 @@
|
||||
:degr degr
|
||||
:list (mapcar #'(lambda (term)
|
||||
(declare (type term term))
|
||||
(with-term (cffc gnrt) term
|
||||
(with-term
|
||||
(cffc gnrt) term
|
||||
(term (- cffc) gnrt)))
|
||||
list)))))
|
||||
|
||||
@ -185,7 +186,8 @@
|
||||
:degr degr
|
||||
:list (mapcar #'(lambda (term)
|
||||
(declare (type term term))
|
||||
(with-term (cffc gnrt) term
|
||||
(with-term
|
||||
(cffc gnrt) term
|
||||
(term (* n cffc) gnrt)))
|
||||
list))))))
|
||||
|
||||
@ -195,8 +197,10 @@
|
||||
(type cmprf cmpr)
|
||||
(type cmbn cmbn1 cmbn2))
|
||||
(the cmbn
|
||||
(with-cmbn (degr1 list1) cmbn1
|
||||
(with-cmbn (degr2 list2) cmbn2
|
||||
(with-cmbn
|
||||
(degr1 list1) cmbn1
|
||||
(with-cmbn
|
||||
(degr2 list2) cmbn2
|
||||
(unless (= degr1 degr2)
|
||||
(error "In ADD, the combination arguments have different degrees ~D and ~D."
|
||||
degr1 degr2))
|
||||
@ -208,8 +212,10 @@
|
||||
(mark1 list1)
|
||||
(mark2 list2))
|
||||
(declare (list pre-rslt mark1 mark2))
|
||||
(with--term (cffc1 gnrt1) mark1
|
||||
(with--term (cffc2 gnrt2) mark2
|
||||
(with--term
|
||||
(cffc1 gnrt1) mark1
|
||||
(with--term
|
||||
(cffc2 gnrt2) mark2
|
||||
(tagbody
|
||||
:begin
|
||||
(ecase (funcall cmpr gnrt1 gnrt2)
|
||||
@ -255,8 +261,10 @@
|
||||
(type cmprf cmpr)
|
||||
(type cmbn cmbn1 cmbn2))
|
||||
(the cmbn
|
||||
(with-cmbn (degr1 list1) cmbn1
|
||||
(with-cmbn (degr2 list2) cmbn2
|
||||
(with-cmbn
|
||||
(degr1 list1) cmbn1
|
||||
(with-cmbn
|
||||
(degr2 list2) cmbn2
|
||||
(unless (= degr1 degr2)
|
||||
(error "In SBTR, the combination arguments have different degrees ~D and ~D."
|
||||
degr1 degr2))
|
||||
@ -268,8 +276,10 @@
|
||||
(mark1 list1)
|
||||
(mark2 list2))
|
||||
(declare (list pre-rslt mark1 mark2))
|
||||
(with--term (cffc1 gnrt1) mark1
|
||||
(with--term (cffc2 gnrt2) mark2
|
||||
(with--term
|
||||
(cffc1 gnrt1) mark1
|
||||
(with--term
|
||||
(cffc2 gnrt2) mark2
|
||||
(tagbody
|
||||
:begin
|
||||
(ecase (funcall cmpr gnrt1 gnrt2)
|
||||
@ -307,7 +317,8 @@
|
||||
(nreconc pre-rslt
|
||||
(mapcar #'(lambda (term)
|
||||
(declare (cons term))
|
||||
(with-term (cffc gnrt) term
|
||||
(with-term
|
||||
(cffc gnrt) term
|
||||
(term (- cffc) gnrt)))
|
||||
mark2)))
|
||||
(go :exit)
|
||||
@ -327,8 +338,10 @@
|
||||
(fixnum n1 n2)
|
||||
(type cmbn cmbn1 cmbn2))
|
||||
(the cmbn
|
||||
(with-cmbn (degr1 list1) cmbn1
|
||||
(with-cmbn (degr2 list2) cmbn2
|
||||
(with-cmbn
|
||||
(degr1 list1) cmbn1
|
||||
(with-cmbn
|
||||
(degr2 list2) cmbn2
|
||||
(unless (= degr1 degr2)
|
||||
(error "In 2N-2CMBN, the combination arguments have different degrees ~D and ~D."
|
||||
degr1 degr2))
|
||||
@ -340,8 +353,10 @@
|
||||
(mark1 list1)
|
||||
(mark2 list2))
|
||||
(declare (list pre-rslt mark1 mark2))
|
||||
(with--term (cffc1 gnrt1) mark1
|
||||
(with--term (cffc2 gnrt2) mark2
|
||||
(with--term
|
||||
(cffc1 gnrt1) mark1
|
||||
(with--term
|
||||
(cffc2 gnrt2) mark2
|
||||
(setf cffc1 (* n1 cffc1)
|
||||
cffc2 (* n2 cffc2))
|
||||
(tagbody
|
||||
@ -382,8 +397,10 @@
|
||||
mark2
|
||||
(mapcar #'(lambda (term)
|
||||
(declare (cons term))
|
||||
(with-term (cffc gnrt) term
|
||||
(term (* n2 cffc) gnrt)))
|
||||
(with-term
|
||||
(cffc gnrt) term
|
||||
(term (* n2 cffc)
|
||||
gnrt)))
|
||||
mark2))))
|
||||
(go :exit)
|
||||
:cmbn2-is-finished
|
||||
@ -393,8 +410,10 @@
|
||||
mark1
|
||||
(mapcar #'(lambda (term)
|
||||
(declare (cons term))
|
||||
(with-term (cffc gnrt) term
|
||||
(term (* n1 cffc) gnrt)))
|
||||
(with-term
|
||||
(cffc gnrt) term
|
||||
(term (* n1 cffc)
|
||||
gnrt)))
|
||||
mark1))))
|
||||
:exit))
|
||||
(make-cmbn
|
||||
|
||||
@ -93,10 +93,10 @@
|
||||
,@body))
|
||||
|
||||
#|
|
||||
(macroexpand-1 '(with-term (cffc gnrt) term
|
||||
(macroexpand-1 '(with-term (cffc gnrt) term
|
||||
(statement-1)
|
||||
(statement-2)))
|
||||
(macroexpand-1 '(with-term (nil gnrt) term
|
||||
(macroexpand-1 '(with-term (nil gnrt) term
|
||||
(statement-1)
|
||||
(statement-2)))
|
||||
|#
|
||||
@ -110,7 +110,7 @@
|
||||
,@body))
|
||||
|
||||
#|
|
||||
(macroexpand-1 '(with--term (cffc gnrt) mark
|
||||
(macroexpand-1 '(with--term (cffc gnrt) mark
|
||||
(statement-1)
|
||||
(statement-2)))
|
||||
|#
|
||||
@ -125,7 +125,7 @@
|
||||
,@body))
|
||||
|
||||
#|
|
||||
(macroexpand-1 '(with-cmbn (degr list) cmbn
|
||||
(macroexpand-1 '(with-cmbn (degr list) cmbn
|
||||
(statement-1)
|
||||
(statement-2)))
|
||||
|#
|
||||
@ -168,8 +168,8 @@
|
||||
`(funcall (cmpr1 ,object) ,item1 ,item2))
|
||||
|
||||
#|
|
||||
(macroexpand '(cmpr chcm))
|
||||
(macroexpand '(cmpr chcm item1 item2))
|
||||
(macroexpand '(cmpr chcm))
|
||||
(macroexpand '(cmpr chcm item1 item2))
|
||||
|#
|
||||
|
||||
(DEFMACRO BASIS (&rest rest)
|
||||
@ -188,9 +188,9 @@
|
||||
((2 3) `(? (dffr1 ,(first rest)) ,@(rest rest)))))
|
||||
|
||||
#|
|
||||
(macroexpand '(dffr chcm))
|
||||
(macroexpand '(dffr chcm cmbn))
|
||||
(macroexpand '(dffr chcm degr gnrt))
|
||||
(macroexpand '(dffr chcm))
|
||||
(macroexpand '(dffr chcm cmbn))
|
||||
(macroexpand '(dffr chcm degr gnrt))
|
||||
|#
|
||||
|
||||
(DEFMACRO ? (&rest rest)
|
||||
@ -208,9 +208,9 @@
|
||||
mrph1))
|
||||
|
||||
#|
|
||||
(macroexpand '(i-cmps m1))
|
||||
(macroexpand '(i-cmps m1 m2))
|
||||
(macroexpand '(i-cmps m1 m2 m3))
|
||||
(macroexpand '(i-cmps m1))
|
||||
(macroexpand '(i-cmps m1 m2))
|
||||
(macroexpand '(i-cmps m1 m2 m3))
|
||||
|#
|
||||
|
||||
(DEFMACRO I-ADD (mrph1 &rest rest)
|
||||
@ -219,17 +219,17 @@
|
||||
mrph1))
|
||||
|
||||
#|
|
||||
(macroexpand '(i-add m1))
|
||||
(macroexpand '(i-add m1 m2))
|
||||
(macroexpand '(i-add m1 m2 m3))
|
||||
(macroexpand '(i-add m1))
|
||||
(macroexpand '(i-add m1 m2))
|
||||
(macroexpand '(i-add m1 m2 m3))
|
||||
|#
|
||||
|
||||
(DEFMACRO I-SBTR (mrph1 mrph2 &rest rest)
|
||||
`(sbtr ,mrph1 (i-add ,mrph2 ,@rest)))
|
||||
|
||||
#|
|
||||
(macroexpand '(i-sbtr m1 m2))
|
||||
(macroexpand '(i-sbtr m1 m2 m3))
|
||||
(macroexpand '(i-sbtr m1 m2))
|
||||
(macroexpand '(i-sbtr m1 m2 m3))
|
||||
|#
|
||||
|
||||
;;;
|
||||
@ -255,9 +255,9 @@
|
||||
`(? (f1 ,(first rest)) ,@(rest rest)))))
|
||||
|
||||
#|
|
||||
(macroexpand '(f rdct))
|
||||
(macroexpand '(f rdct cmbn))
|
||||
(macroexpand '(f rdct degr gnrt))
|
||||
(macroexpand '(f rdct))
|
||||
(macroexpand '(f rdct cmbn))
|
||||
(macroexpand '(f rdct degr gnrt))
|
||||
|#
|
||||
|
||||
(DEFMACRO G (&rest rest)
|
||||
@ -405,12 +405,12 @@
|
||||
,@body))
|
||||
|
||||
#|
|
||||
(macroexpand '(tnpr 1 a 2 b))
|
||||
1 (tnpr 2 'a 4 (tnpr 2 'b 2 'c))
|
||||
(macroexpand-1 '(with-tnpr (degr1 gnrt1 degr2 gnrt2) tnpr
|
||||
(macroexpand '(tnpr 1 a 2 b))
|
||||
1 (tnpr 2 'a 4 (tnpr 2 'b 2 'c))
|
||||
(macroexpand-1 '(with-tnpr (degr1 gnrt1 degr2 gnrt2) tnpr
|
||||
(statement-1)
|
||||
(statement-2)))
|
||||
(macroexpand-1 '(with-tnpr (nil gnrt1 degr2 gnrt2) tnpr
|
||||
(macroexpand-1 '(with-tnpr (nil gnrt1 degr2 gnrt2) tnpr
|
||||
(statement-1)
|
||||
(statement-2)))
|
||||
|#
|
||||
@ -748,7 +748,7 @@
|
||||
(macroexpand-1 '(with-crpr (dgop1 gmsm1 dgop2 gmsm2) crpr
|
||||
(statement-1)
|
||||
(statement-2))))
|
||||
(macroexpand-1
|
||||
(macroexpand-1
|
||||
(macroexpand-1 '(with-crpr (absm1 absm2) crpr
|
||||
(statement-1)
|
||||
(statement-2))))
|
||||
|
||||
@ -86,7 +86,7 @@
|
||||
(values))
|
||||
|
||||
#|
|
||||
(clock))
|
||||
(clock))
|
||||
|#
|
||||
|
||||
(DEFUN DONE ()
|
||||
@ -94,8 +94,5 @@
|
||||
(values))
|
||||
|
||||
#|
|
||||
(done))
|
||||
(done))
|
||||
|#
|
||||
|
||||
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user