Extracted tests from macros.lisp.

kenzo-test.asd

@@ -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")

package.lisp

@@ -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>

src/macros.lisp

@@ -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
+  "(BCNB GNRT) returns the representation of the generator GNRT belonging to
-chain complex B."
+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
+  "(BCNC GNRT) returns the representation of the generator GNRT belonging to
-chain complex C."
+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
+  "(BCND GNRT) returns the representation of the generator GNRT belonging to
-chain complex D."
+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+))

test/macros-test.lisp

@@ -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)))))
+
+