mmarco/kenzo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Extracted tests from macros.lisp.

Browse Source
This commit is contained in:
Gerd Heber 2015-07-29 01:42:15 -05:00
parent c2dedbc6c4
commit a4c9914cd4
4 changed files with 232 additions and 129 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
kenzo-test.asd
View File

@ -35,6 +35,7 @@
(:file "loop-spaces-test")
(:file "lp-space-efhm-test")
(:file "ls-twisted-products-test")
(:file "macros-test")
(:file "searching-homology-test")
(:file "serre-test")
(:file "simplicial-groups-test")

19
package.lisp
View File

@ -117,6 +117,8 @@
;; classes.lisp
ABSM
ABSM1
ABSM2
AB-SIMPLICIAL-GROUP
ALLP-LIST
APOWR
@ -131,6 +133,8 @@
CMBN-LIST
DEGR
DGOP
DGOP1
DGOP2
DFFR1
EFHM
F
@ -138,6 +142,7 @@
G
GBAR
GMSM
GMSM2
H
HOMOTOPY-EQUIVALENCE
IABSM
@ -158,7 +163,6 @@
SINTR
SORC
TCC
TNPR
;; classifying-space.lisp
@ -376,6 +380,8 @@
;; macros.lisp
-1-EXPT-N
-1-EXPT-N+1
-1-EXPT-N-1
?
2-EXP
ABAR-LIST
@ -407,8 +413,11 @@
GNRT-NAME
GRIN
GRML
I-ADD
I-CMPS
I-SBTR
KFLL
LEXICO
LF
LG
LINE-MINUS-5
@ -422,7 +431,13 @@
TERM
TERM-CMBN
TCC
TNPR
WITH--TERM
WITH-ABSM
WITH-CMBN
WITh-CRPR
WITH-TERM
WITh-TNPR
;; searching-homology.lisp
@ -532,6 +547,8 @@
;; various.lisp
*PRINT-LENGTH*
*PRINT-LEVEL*
+EMPTY-LIST+
<A-B<
<A-B>

213
src/macros.lisp
View File

@ -13,28 +13,23 @@
(DEFMACRO -1-EXPT-N (n)
`(the fixnum (if (evenp (the fixnum ,n)) 1 -1)))
(DEFMACRO -1-EXPT-N+1 (n)
`(the fixnum (if (evenp (the fixnum ,n)) -1 1)))
(DEFMACRO -1-EXPT-N-1 (n)
`(-1-expt-n+1 ,n))
#|
()
(-1-expt-n 5)
(-1-expt-n 6)
(-1-expt-n+1 5)
(-1-expt-n+1 6)
(-1-expt-n-1 5)
(-1-expt-n-1 6)
|#
(DEFMACRO 2-EXP (n)
`(aref +2-exp+ ,n))
(DEFMACRO MASK (n)
`(aref +mask+ ,n))
(DEFMACRO BINOMIAL-P-Q (p q)
`(binomial-n-p (+ ,p ,q) ,p))
@ -52,38 +47,31 @@
(lexico ,@(rest rest))
,vrslt))))
#|
()
(let ((*print-level* nil))
(declare (special
#+aclpc allegro:*top-print-level*
#-aclpc *print-level*))
(pprint (macroexpand-1
'(lexico
comparison1
comparison2
comparison3
comparison4))))
|#
(DEFMACRO TERM (cffc gnrt)
`(cons ,cffc ,gnrt))
(DEFMACRO -TERM (mark)
`(car ,mark))
(DEFMACRO CFFC (term)
`(car ,term))
(DEFMACRO -CFFC (mark)
`(caar ,mark))
(DEFMACRO GNRT (term)
`(cdr ,term))
(DEFMACRO -GNRT (mark)
`(cdar ,mark))
(DEFMACRO WITH-TERM ((cffc gnrt) term . body)
`(let (,@(if cffc `((,cffc (cffc ,term))) nil)
,@(if gnrt `((,gnrt (gnrt ,term))) nil))
@ -92,14 +80,6 @@
(type gnrt ,@(if gnrt `(,gnrt) nil)))
,@body))
#|
(macroexpand-1 '(with-term (cffc gnrt) term
(statement-1)
(statement-2)))
(macroexpand-1 '(with-term (nil gnrt) term
(statement-1)
(statement-2)))
|#
(DEFMACRO WITH--TERM ((cffc gnrt) mark . body)
`(let ((,cffc (-cffc ,mark))
@ -109,12 +89,6 @@
(type gnrt ,gnrt))
,@body))
#|
(macroexpand-1 '(with--term (cffc gnrt) mark
(statement-1)
(statement-2)))
|#
(DEFMACRO WITH-CMBN ((degr list) cmbn . body)
`(let ((,degr (cmbn-degr ,cmbn))
@ -124,12 +98,6 @@
(list ,list))
,@body))
#|
(macroexpand-1 '(with-cmbn (degr list) cmbn
(statement-1)
(statement-2)))
|#
(DEFMACRO TERM-CMBN (degr cffc gnrt)
`(make-cmbn :degr ,degr
@ -139,19 +107,23 @@
(DEFMACRO CMBN-NON-ZERO-P (cmbn)
`(cmbn-list ,cmbn))
(DEFMACRO CMBN-ZERO-P (cmbn)
`(null (cmbn-list ,cmbn)))
(DEFMACRO CONTROL (cmpr cmbn)
(if *cmbn-control*
`(do-control ,cmpr ,cmbn)
cmbn))
(DEFMACRO CONTROLN (cmpr cmbn)
(if *cmbn-control*
`(do-control ,cmpr ,cmbn)
nil))
(DEFVAR *WRONG-CMBN*)
@ -164,13 +136,10 @@
(1 `(cmpr1 ,@rest))
(3 `(cmpr3 ,@rest))))
(DEFMACRO CMPR3 (object item1 item2)
`(funcall (cmpr1 ,object) ,item1 ,item2))
#|
(macroexpand '(cmpr chcm))
(macroexpand '(cmpr chcm item1 item2))
|#
(DEFMACRO BASIS (&rest rest)
(ecase (length rest)
@ -178,20 +147,17 @@
(2 `(basis2 ,@rest))
(3 `(basis3 ,@rest))))
(DEFMACRO BASIS3 (smst dmns keyword)
(declare (ignore keyword))
`(a-basis2 (basis ,smst) ,dmns))
(DEFMACRO DFFR (&rest rest)
(ecase (length rest)
(1 `(dffr1 ,@rest))
((2 3) `(? (dffr1 ,(first rest)) ,@(rest rest)))))
#|
(macroexpand '(dffr chcm))
(macroexpand '(dffr chcm cmbn))
(macroexpand '(dffr chcm degr gnrt))
|#
(DEFMACRO ? (&rest rest)
(ecase (length rest)
@ -207,30 +173,16 @@
`(cmps ,mrph1 (i-cmps ,@rest))
mrph1))
#|
(macroexpand '(i-cmps m1))
(macroexpand '(i-cmps m1 m2))
(macroexpand '(i-cmps m1 m2 m3))
|#
(DEFMACRO I-ADD (mrph1 &rest rest)
(if rest
`(add ,mrph1 (i-add ,@rest))
mrph1))
#|
(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))
|#
;;;
;;; EFFECTIVE HOMOLOGY
@ -242,23 +194,20 @@
(otherwise
`(? (bcc1 ,(first rest)) ,@(rest rest)))))
(DEFMACRO TCC (&rest rest)
(case (length rest)
(1 `(tcc1 ,@rest))
(otherwise
`(? (tcc1 ,(first rest)) ,@(rest rest)))))
(DEFMACRO F (&rest rest)
(case (length rest)
(1 `(f1 ,@rest))
(otherwise
`(? (f1 ,(first rest)) ,@(rest rest)))))
#|
(macroexpand '(f rdct))
(macroexpand '(f rdct cmbn))
(macroexpand '(f rdct degr gnrt))
|#
(DEFMACRO G (&rest rest)
(case (length rest)
@ -266,61 +215,69 @@
(otherwise
`(? (g1 ,(first rest)) ,@(rest rest)))))
(DEFMACRO H (&rest rest)
(case (length rest)
(1 `(h1 ,@rest))
(otherwise
`(? (h1 ,(first rest)) ,@(rest rest)))))
(DEFMACRO LBCC (&rest rest)
(case (length rest)
(1 `(lbcc1 ,@rest))
(otherwise
`(? (lbcc1 ,(first rest)) ,@(rest rest)))))
(DEFMACRO RBCC (&rest rest)
(case (length rest)
(1 `(rbcc1 ,@rest))
(otherwise
`(? (rbcc1 ,(first rest)) ,@(rest rest)))))
(DEFMACRO LF (&rest rest)
(case (length rest)
(1 `(lf1 ,@rest))
(otherwise
`(? (lf1 ,(first rest)) ,@(rest rest)))))
(DEFMACRO LG (&rest rest)
(case (length rest)
(1 `(lg1 ,@rest))
(otherwise
`(? (lg1 ,(first rest)) ,@(rest rest)))))
(DEFMACRO LH (&rest rest)
(case (length rest)
(1 `(lh1 ,@rest))
(otherwise
`(? (lh1 ,(first rest)) ,@(rest rest)))))
(DEFMACRO RF (&rest rest)
(case (length rest)
(1 `(rf1 ,@rest))
(otherwise
`(? (rf1 ,(first rest)) ,@(rest rest)))))
(DEFMACRO RG (&rest rest)
(case (length rest)
(1 `(rg1 ,@rest))
(otherwise
`(? (rg1 ,(first rest)) ,@(rest rest)))))
(DEFMACRO RH (&rest rest)
(case (length rest)
(1 `(rh1 ,@rest))
(otherwise
`(? (rh1 ,(first rest)) ,@(rest rest)))))
;;;
;;; HOMOLOGY-GROUPS
;;;
@ -328,6 +285,7 @@
(DEFMACRO BASELIG (mat n)
`(aref (leftcol ,mat) ,n))
(DEFMACRO BASECOL (mat n)
`(aref (uplig ,mat) ,n))
@ -338,9 +296,11 @@
(DEFMACRO CON0 (gnrt)
`(make-cone :conx 0 :icon ,gnrt))
(DEFMACRO CON1 (gnrt)
`(make-cone :conx 1 :icon ,gnrt))
(DEFMACRO WITH-CONE ((conx icon) cone . body)
(let ((scone (gensym)))
(declare (symbol scone))
@ -351,21 +311,25 @@
(declare (type (member 0 1) ,conx) (type gnrt ,icon))
,@body))))
(DEFMACRO BCNB (gnrt)
"(BCNB GNRT) returns the representation of the generator GNRT belonging to the
chain complex B."
"(BCNB GNRT) returns the representation of the generator GNRT belonging to
the chain complex B."
`(make-bicn :bcnx :bcnb :ibicn ,gnrt))
(DEFMACRO BCNC (gnrt)
"(BCNC GNRT) returns the representation of the generator GNRT belonging to the
chain complex C."
"(BCNC GNRT) returns the representation of the generator GNRT belonging to
the chain complex C."
`(make-bicn :bcnx :bcnc :ibicn ,gnrt))
(DEFMACRO BCND (gnrt)
"(BCND GNRT) returns the representation of the generator GNRT belonging to the
chain complex D."
"(BCND GNRT) returns the representation of the generator GNRT belonging to
the chain complex D."
`(make-bicn :bcnx :bcnd :ibicn ,gnrt))
(DEFMACRO WITH-BICN ((bcnx ibicn) bicn . body)
`(let ((,bcnx (bcnx ,bicn))
(,ibicn (ibicn ,bicn)))
@ -374,7 +338,6 @@ chain complex D."
(type gnrt ,ibicn))
,@body))
;;;
;;; TENSOR PRODUCTS
;;;
@ -410,17 +373,6 @@ chain complex D."
(type gnrt ,@(if gnrt1 `(,gnrt1) nil) ,@(if gnrt2 `(,gnrt2) nil)))
,@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
(statement-1)
(statement-2)))
(macroexpand-1 '(with-tnpr (nil gnrt1 degr2 gnrt2) tnpr
(statement-1)
(statement-2)))
|#
;;;
;;; COALGEBRAS
;;;
@ -437,18 +389,23 @@ chain complex D."
(DEFMACRO CBGN (degr gnrt)
`(cons ,degr ,gnrt))
(DEFMACRO CDEGR (cbgn)
`(car ,cbgn))
(DEFMACRO CGNRT (cbgn)
`(cdr ,cbgn))
(DEFMACRO -CDEGR (cbgn)
`(caar ,cbgn))
(DEFMACRO -CGNRT (cbgn)
`(cdar ,cbgn))
(DEFMACRO WITH-CBGN ((cdegr cgnrt) cbgn . body)
`(let ((,cdegr (cdegr ,cbgn))
(,cgnrt (cgnrt ,cbgn)))
@ -457,6 +414,7 @@ chain complex D."
(type gnrt ,cgnrt))
,@body))
(DEFMACRO WITH--CBGN ((cdegr cgnrt) cbgn . body)
`(let ((,cdegr (-cdegr ,cbgn))
(,cgnrt (-cgnrt ,cbgn)))
@ -465,11 +423,13 @@ chain complex D."
(type gnrt ,cgnrt))
,@body))
(DEFMACRO WITH-ALLP ((list) allp . body)
`(let ((,list (allp-list ,allp)))
(declare (list ,list))
,@body))
(DEFMACRO GNRT-ALLP-TNPR (degr gnrt allp)
`(make-allp :list (cons (cbgn (1- ,degr) ,gnrt) ,allp)))
@ -490,18 +450,23 @@ chain complex D."
(DEFMACRO BRGN (degr gnrt)
`(cons ,degr ,gnrt))
(DEFMACRO BDEGR (brgn)
`(car ,brgn))
(DEFMACRO BGNRT (brgn)
`(cdr ,brgn))
(DEFMACRO -BDEGR (brgn)
`(caar ,brgn))
(DEFMACRO -BGNRT (brgn)
`(cdar ,brgn))
(DEFMACRO WITH-BRGN ((bdegr bgnrt) brgn . body)
`(let ((,bdegr (bdegr ,brgn))
(,bgnrt (bgnrt ,brgn)))
@ -510,6 +475,7 @@ chain complex D."
(type gnrt ,bgnrt))
,@body))
(DEFMACRO WITH--BRGN ((bdegr bgnrt) brgn . body)
`(let ((,bdegr (-bdegr ,brgn))
(,bgnrt (-bgnrt ,brgn)))
@ -590,21 +556,27 @@ chain complex D."
(type gmsm ,gmsm-var))
,@body))))
(DEFMACRO DEGENERATE-P (absm)
`(plusp (dgop ,absm)))
(DEFMACRO NON-DEGENERATE-P (absm)
`(zerop (dgop ,absm)))
(DEFMACRO BSPN (smst)
`(bsgn ,smst))
(DEFMACRO BNDR (&rest rest)
`(dffr ,@rest))
(DEFMACRO DGNL (&rest rest)
`(cprd ,@rest))
(DEFMACRO FACE (&rest rest)
(ecase (length rest)
(1 `(face1 ,@rest))
@ -627,15 +599,19 @@ chain complex D."
(DEFMACRO MAKE-GMSM-FACES-INFO (&key gmsm faces bndr)
`(cons ,gmsm (cons ,faces ,bndr)))
(DEFMACRO INFO-GMSM (gmsm-faces-info)
`(car ,gmsm-faces-info))
(DEFMACRO INFO-FACES (gmsm-faces-info)
`(cadr ,gmsm-faces-info))
(DEFMACRO INFO-FACE-I (gmsm-faces-info i)
`(svref (cadr ,gmsm-faces-info) ,i))
(DEFMACRO INFO-BNDR (gmsm-faces-info)
`(cddr ,gmsm-faces-info))
@ -656,24 +632,15 @@ chain complex D."
(2 `(crpr2 ,@rest))
(4 `(crpr4 ,@rest))))
(DEFMACRO CRPR2 (absm1 absm2)
`(crpr4 (dgop ,absm1) (gmsm ,absm1) (dgop ,absm2) (gmsm ,absm2)))
(DEFMACRO CRPR4 (dgop1 gmsm1 dgop2 gmsm2)
`(make-crpr :dgop1 ,dgop1 :gmsm1 ,gmsm1
:dgop2 ,dgop2 :gmsm2 ,gmsm2))
#|
()
(crpr (absm 3 'a) (absm 4 'b))
(crpr 3 'a 4 'b)
|#
#|
()
(macroexpand '(crpr absm1 absm2))
(macroexpand '(crpr dgop1 gmsm1 dgop2 gmsm2))
|#
#|
(DEFMACRO DGOP1 (crpr)
@ -697,22 +664,11 @@ chain complex D."
(DEFMACRO ABSM1 (crpr)
`(absm (dgop1 ,crpr) (gmsm1 ,crpr)))
(DEFMACRO ABSM2 (crpr)
`(absm (dgop2 ,crpr) (gmsm2 ,crpr)))
#|
()
(setf c (crpr 1 'a 2 'b))
(dgop1 c)
(gmsm1 c)
(dgop2 c)
(gmsm2 c)
(absm1 c)
(absm2 c)
|#
(DEFMACRO WITH-CRPR (&rest rest)
(ecase (length (first rest))
(2 `(with-crpr-2 ,@rest))
@ -733,10 +689,6 @@ chain complex D."
(declare (type absm ,absm1 ,absm2))
,@body))
#|
()
(with-crpr (absm1 absm2) (crpr 3 'a 4 'b) (list absm1 absm2))
|#
(DEFMACRO WITH-CRPR-4 ((dgop1 gmsm1 dgop2 gmsm2) crpr . body)
`(let ((,dgop1 (dgop1 ,crpr))
@ -748,18 +700,6 @@ chain complex D."
(type gmsm ,gmsm1 ,gmsm2))
,@body))
#|
()
(macroexpand-1
(macroexpand-1 '(with-crpr (dgop1 gmsm1 dgop2 gmsm2) crpr
(statement-1)
(statement-2))))
(macroexpand-1
(macroexpand-1 '(with-crpr (absm1 absm2) crpr
(statement-1)
(statement-2))))
|#
;;;
;;; EILENBERG-ZILBER
;;;
@ -789,11 +729,13 @@ chain complex D."
(0 `(grml1 ,smgr))
((1 2) `(? (grml1 ,smgr) ,@rest))))
(DEFMACRO GRIN (smgr &rest rest)
(case (length rest)
(0 `(grin1 ,smgr))
(otherwise `(? (grin1 ,smgr) ,@rest))))
(DEFMACRO BUILD-AB-SMGR (&rest rest)
`(change-class (build-smgr ,@rest) 'ab-simplicial-group))
@ -804,12 +746,15 @@ chain complex D."
(DEFMACRO POWR (gmsm expn)
`(cons ,gmsm ,expn))
(DEFMACRO PGMSM (powr)
`(car ,powr))
(DEFMACRO EXPN (powr)
`(cdr ,powr))
(DEFMACRO WITH-POWR ((gmsm expn) powr . body)
`(let ((,gmsm (car ,powr))
(,expn (cdr ,powr)))
@ -818,6 +763,7 @@ chain complex D."
(fixnum expn))
,@body))
(DEFMACRO WITH-APOWR ((dgop gmsm expn) apowr . body)
`(let ((,dgop (apdgop ,apowr))
(,gmsm (cadr ,apowr))
@ -827,9 +773,11 @@ chain complex D."
(type gmsm ,gmsm))
,@body))
(DEFMACRO APOWR (dgop gmsm expn)
`(cons ,dgop (cons ,gmsm ,expn)))
(DEFMACRO APDGOP (apowr)
`(car ,apowr))
@ -837,6 +785,7 @@ chain complex D."
(DEFMACRO APGMSM (apowr)
`(cadr ,apowr))
(DEFMACRO APEXPN (apowr)
`(cddr ,apowr))
@ -847,9 +796,11 @@ chain complex D."
(DEFMACRO LINE-NUMBER (mtrx)
`(first (array-dimensions ,mtrx)))
(DEFMACRO COLUMN-NUMBER (mtrx)
`(second (array-dimensions ,mtrx)))
(DEFMACRO LINE-OP-5 (mtrx-list begin lambda line1 line2)
(let ((slambda (gensym)))
`(let ((,slambda ,lambda))
@ -857,6 +808,7 @@ chain complex D."
(line-op (second ,mtrx-list) 0 ,slambda ,line1 ,line2)
(line-op (third ,mtrx-list) ,begin ,slambda ,line1 ,line2))))
(DEFMACRO COLUMN-OP-5 (mtrx-list begin lambda column1 column2)
(let ((slambda (gensym)))
`(let ((,slambda ,lambda))
@ -864,29 +816,34 @@ chain complex D."
(column-op (fourth ,mtrx-list) 0 ,slambda ,column1 ,column2)
(line-op (fifth ,mtrx-list) 0 (- ,slambda) ,column2 ,column1))))
(DEFMACRO LINE-SWAP-5 (mtrx-list begin line1 line2)
`(progn
(column-swap (first ,mtrx-list) 0 ,line1 ,line2)
(line-swap (second ,mtrx-list) 0 ,line1 ,line2)
(line-swap (third ,mtrx-list) ,begin ,line1 ,line2)))
(DEFMACRO COLUMN-SWAP-5 (mtrx-list begin column1 column2)
`(progn
(column-swap (third ,mtrx-list) ,begin ,column1 ,column2)
(column-swap (fourth ,mtrx-list) 0 ,column1 ,column2)
(line-swap (fifth ,mtrx-list) 0 ,column1 ,column2)))
(DEFMACRO LINE-MINUS-5 (mtrx-list begin line)
`(progn
(column-minus (first ,mtrx-list) 0 ,line)
(line-minus (second ,mtrx-list) 0 ,line)
(line-minus (third ,mtrx-list) ,begin ,line)))
(DEFMACRO COLUMN-MINUS-5 (mtrx-list begin column)
`(progn
(column-minus (third ,mtrx-list) ,begin ,column)
(column-minus (fourth ,mtrx-list) 0 ,column)
(line-minus (fifth ,mtrx-list) 0 ,column)))
(DEFMACRO GNRT-NAME (i)
`(intern (format nil "GN-~D" ,i) +gnrts-pckg+))

128
test/macros-test.lisp Normal file
View File

@ -0,0 +1,128 @@
(in-package :kenzo-test)
(in-suite :kenzo)
(test -1-expt-n
(is (equal -1 (cat:-1-expt-n 5)))
(is (equal 1 (cat:-1-expt-n 6))))
(test -1-expt-n+1
(is (equal 1 (cat:-1-expt-n+1 5)))
(is (equal -1 (cat:-1-expt-n+1 6))))
(test -1-expt-n-1
(is (equal 1 (cat:-1-expt-n+1 5)))
(is (equal -1 (cat:-1-expt-n+1 6))))
(test lexico
(let ((cat:*print-level* nil))
(declare (special
#+aclpc allegro:*top-print-level*
#-aclpc cat:*print-level*))
(pprint (macroexpand-1
'(cat:lexico
comparison1
comparison2
comparison3
comparison4)))))
(test with-term
(macroexpand-1 '(cat:with-term (cffc gnrt) term
(statement-1)
(statement-2)))
(macroexpand-1 '(cat:with-term (nil gnrt) term
(statement-1)
(statement-2))))
(test with--term
(macroexpand-1 '(cat:with--term (cffc gnrt) mark
(statement-1)
(statement-2))))
(test with-cmbn
(macroexpand-1 '(cat:with-cmbn (degr list) cmbn
(statement-1)
(statement-2))))
(test cmpr
(macroexpand '(cat:cmpr chcm))
(macroexpand '(cat:cmpr chcm item1 item2)))
(test dffr
(macroexpand '(cat:dffr chcm))
(macroexpand '(cat:dffr chcm cmbn))
(macroexpand '(cat:dffr chcm degr gnrt)))
(test i-cmps
(macroexpand '(cat:i-cmps m1))
(macroexpand '(cat:i-cmps m1 m2))
(macroexpand '(cat:i-cmps m1 m2 m3)))
(test i-add
(macroexpand '(cat:i-add m1))
(macroexpand '(cat:i-add m1 m2))
(macroexpand '(cat:i-add m1 m2 m3)))
(test i-sbtr
(macroexpand '(cat:i-sbtr m1 m2))
(macroexpand '(cat:i-sbtr m1 m2 m3)))
(test f
(macroexpand '(cat:f rdct))
(macroexpand '(cat:f rdct cmbn))
(macroexpand '(cat:f rdct degr gnrt)))
(test tnpr
(macroexpand '(cat:tnpr 1 a 2 b))
(cat:tnpr 2 'a 4 (cat:tnpr 2 'b 2 'c)))
(test with-tnpr
(macroexpand-1 '(cat:with-tnpr (degr1 gnrt1 degr2 gnrt2) tnpr
(statement-1)
(statement-2)))
(macroexpand-1 '(cat:with-tnpr (nil gnrt1 degr2 gnrt2) tnpr
(statement-1)
(statement-2))))
(test crpr
(cat:crpr (cat:absm 3 'a) (cat:absm 4 'b))
(cat:crpr 3 'a 4 'b)
(macroexpand '(cat:crpr absm1 absm2))
(macroexpand '(cat:crpr dgop1 gmsm1 dgop2 gmsm2))
(let ((c (cat:crpr 1 'a 2 'b)))
(cat:dgop1 c)
(cat:gmsm1 c)
(cat:dgop2 c)
(cat:gmsm2 c)
(cat:absm1 c)
(cat:absm2 c)))
(test with-crpr
(cat:with-crpr (absm1 absm2) (cat:crpr 3 'a 4 'b) (list absm1 absm2))
(macroexpand-1
(macroexpand-1 '(cat:with-crpr (dgop1 gmsm1 dgop2 gmsm2) crpr
(statement-1)
(statement-2))))
(macroexpand-1
(macroexpand-1 '(cat:with-crpr (absm1 absm2) crpr
(statement-1)
(statement-2)))))