From 04a64f467ec88fc4c71ea3e93a34bb4cb5ed8403 Mon Sep 17 00:00:00 2001 From: gheber Date: Fri, 26 Dec 2014 20:04:29 -0600 Subject: [PATCH] Moved all global variables to kenzo.lisp --- kenzo.lisp | 137 +++++++++++++++++++++++++++++++++++- src/algebras.lisp | 8 --- src/chain-complexes.lisp | 27 ------- src/coalgebras.lisp | 4 -- src/combinations.lisp | 4 +- src/effective-homology.lisp | 17 ----- src/homology-groups.lisp | 1 - src/kan.lisp | 4 -- src/simplicial-groups.lisp | 4 -- src/simplicial-mrphs.lisp | 4 -- src/simplicial-sets.lisp | 4 -- src/tensor-products.lisp | 1 - src/various.lisp | 25 ------- 13 files changed, 137 insertions(+), 103 deletions(-) diff --git a/kenzo.lisp b/kenzo.lisp index dbf160a..8b5f88a 100644 --- a/kenzo.lisp +++ b/kenzo.lisp @@ -2,8 +2,6 @@ (IN-PACKAGE #:cat) -;;; "kenzo" goes here. Hacks and glory await! - (DEFUN KENZO-VERSION () (format t "~%*** Kenzo-Version 1.1.7 ***~2%") (values)) @@ -11,9 +9,144 @@ ;;(PROCLAIM '(OPTIMIZE (speed 3) (safety 1) (space 0) (debug 0))) (DECLAIM '(OPTIMIZE (speed 0) (space 0) (debug 3))) +;; globals from cat-init.lisp + (DEFVAR *CMBN-CONTROL*) (SETF *CMBN-CONTROL* T) +;; globals from various.lisp + +(DEFINE-CONSTANT +EMPTY-LIST+ '()) + +(DEFINE-CONSTANT +F-EMPTY-VECTOR+ + (make-array 0 :element-type 'fixnum)) + +(DEFINE-CONSTANT +S-EMPTY-VECTOR+ #()) + +(DEFINE-CONSTANT +TRUE+ t) + +(DEFINE-CONSTANT +FALSE+ nil) + +(DEFINE-CONSTANT +2-EXP+ + (let ((rslt (make-array (integer-length most-positive-fixnum) + :element-type 'fixnum))) + (declare (type (array fixnum 1) rslt)) + (dotimes (i (integer-length most-positive-fixnum) rslt) + (setf (aref rslt i) (the fixnum (expt 2 i)))))) + +(DEFINE-CONSTANT +MASK+ + (let ((rslt (make-array (integer-length most-positive-fixnum) + :element-type 'fixnum))) + (declare (type (array fixnum 1) rslt)) + (dotimes (i (integer-length most-positive-fixnum) rslt) + (setf (aref rslt i) (the fixnum (1- (expt 2 i))))))) + +;; globals from chain-complexes.lisp + +(DEFVAR *LIST-LIST* +EMPTY-LIST+) + +(DEFVAR *CHCM-LIST*) +(SETF *CHCM-LIST* +EMPTY-LIST+) +(PUSHNEW '*CHCM-LIST* *LIST-LIST*) + +(DEFPARAMETER +MAXIMAL-DIMENSION+ 15) + +(DEFVAR *MRPH-LIST*) +(SETF *MRPH-LIST* +EMPTY-LIST+) +(PUSHNEW '*MRPH-LIST* *LIST-LIST*) + +(DEFVAR *START-STACK* +EMPTY-LIST+) + +(DEFPARAMETER +TOO-MUCH-TIME+ -1) + +(DEFVAR *RESULTS-MAX* (expt 10 5)) + +(DEFVAR *RESULTS-COEF* 3.0) +(DEFVAR *RESULTS-CMLT-TM* 0.0) +(DEFVAR *RESULTS-N* 0) + +(DEFVAR *RESULTS-VERBOSE* t) + +(DEFVAR *FUTURE-DISPLAY* nil) + +(DEFVAR *TIME-INTERVAL* 60000) + +;; globals from effective homology.lisp + +(DEFVAR *RDCT-LIST*) +(SETF *RDCT-LIST* +EMPTY-LIST+) +(PUSHNEW '*RDCT-LIST* *LIST-LIST*) + +(DEFVAR *HMEQ-LIST*) +(SETF *HMEQ-LIST* +EMPTY-LIST+) +(PUSHNEW '*HMEQ-LIST* *LIST-LIST*) + +(DEFVAR *TDD*) +(DEFVAR *BDD*) +(DEFVAR *ID-FG*) +(DEFVAR *ID-GF-DH-HD*) +(DEFVAR *HH*) +(DEFVAR *FH*) +(DEFVAR *HG*) +(DEFVAR *DF-FD*) +(DEFVAR *DG-GD*) + +(DEFVAR *TC*) +(DEFVAR *BC*) + +;; globals from homology-groups.lisp + +(DEFVAR *HOMOLOGY-VERBOSE* t) + +;; globals from tensor-products.lisp + +(DEFVAR *TNPR-WITH-DEGREES* nil) + +;; globals from coalgebras.lisp + +(DEFVAR *CLGB-LIST*) +(SETF *CLGB-LIST* +EMPTY-LIST+) +(PUSHNEW '*CLGB-LIST* *LIST-LIST*) + +;; globals from algebras.lisp + +(DEFVAR *ALGB-LIST*) +(SETF *ALGB-LIST* +EMPTY-LIST+) +(PUSHNEW '*ALGB-LIST* *LIST-LIST*) + +(DEFVAR *HOPF-LIST*) +(SETF *HOPF-LIST* +EMPTY-LIST+) +(PUSHNEW '*HOPF-LIST* *LIST-LIST*) + +;; globals from simplicial-sets.lisp + +(DEFVAR *SMST-LIST*) +(SETF *SMST-LIST* +empty-list+) +(PUSHNEW '*SMST-LIST* *list-list*) + +;; globals from simplicial-mrphs.lisp + +(DEFVAR *SMMR-LIST*) +(SETF *SMMR-LIST* +empty-list+) +(PUSHNEW '*SMMR-LIST* *LIST-LIST*) + +;; globals from kan.lisp + +(DEFVAR *KAN-LIST*) +(SETF *KAN-LIST* +EMPTY-LIST+) +(PUSHNEW '*KAN-LIST* *LIST-LIST*) + +;; globals from simplicial-groups.lisp + +(DEFVAR *SMGR-LIST*) +(SETF *SMGR-LIST* +empty-list+) +(PUSHNEW '*SMGR-LIST* *list-list*) + + + + + + ;; Don't mess with ANSI's definition of DEFCONSTANT! diff --git a/src/algebras.lisp b/src/algebras.lisp index 3e9c01b..d3e9eef 100644 --- a/src/algebras.lisp +++ b/src/algebras.lisp @@ -6,10 +6,6 @@ (PROVIDE "algebras") -(DEFVAR *ALGB-LIST*) -(SETF *ALGB-LIST* +empty-list+) -(PUSHNEW '*ALGB-LIST* *list-list*) - #+clisp(eval-when (:compile-toplevel :load-toplevel :execute) (setf (ext:package-lock :clos) nil)) (DEFMETHOD PRINT-OBJECT ((algb algebra) stream) @@ -77,10 +73,6 @@ (push chcm *algb-list*) chcm))) -(DEFVAR *HOPF-LIST*) -(SETF *HOPF-LIST* +empty-list+) -(PUSHNEW '*HOPF-LIST* *list-list*) - #+clisp(eval-when (:compile-toplevel :load-toplevel :execute) (setf (ext:package-lock :clos) nil)) (DEFMETHOD PRINT-OBJECT ((hopf hopf-algebra) stream) diff --git a/src/chain-complexes.lisp b/src/chain-complexes.lisp index d7f0b67..0a15615 100644 --- a/src/chain-complexes.lisp +++ b/src/chain-complexes.lisp @@ -6,8 +6,6 @@ (PROVIDE "chain-complexes") -(DEFVAR *LIST-LIST* +empty-list+) - (DEFUN CAT-INIT () (declare (special *idnm-counter* *results-n* *results-cmlt-tm*)) (setf *idnm-counter* 0 *results-n* 0 *results-cmlt-tm* 0.0) @@ -76,11 +74,7 @@ (when found (push (k idnm) k-list)))) (mapc #'kd (nreverse (mapcar #'idnm k-list))))) - -(DEFVAR *CHCM-LIST*) -(SETF *CHCM-LIST* +empty-list+) -(PUSHNEW '*CHCM-LIST* *list-list*) #+clisp(eval-when (:compile-toplevel :load-toplevel :execute) (setf (ext:package-lock :clos) nil)) @@ -109,13 +103,7 @@ (result-gnrt result) (result-value result) (result-clnm result) (result-rntm result)) result) - -(DEFPARAMETER +MAXIMAL-DIMENSION+ 15) - -(DEFVAR *MRPH-LIST*) -(SETF *MRPH-LIST* +empty-list+) -(PUSHNEW '*MRPH-LIST* *list-list*) (DEFMETHOD ?2 ((mrph morphism) cmbn) (declare (type cmbn cmbn)) @@ -237,17 +225,6 @@ ;;; FUNCTIONS -(DEFVAR *START-STACK* +empty-list+) - -(DEFPARAMETER +TOO-MUCH-TIME+ -1) - -(DEFVAR *RESULTS-MAX* (expt 10 5)) - -(DEFVAR *RESULTS-COEF* 3.0) -(DEFVAR *RESULTS-CMLT-TM* 0.0) -(DEFVAR *RESULTS-N* 0) - -(DEFVAR *RESULTS-VERBOSE* t) (DEFUN NRESULTS () (the fixnum @@ -440,10 +417,6 @@ (incf (wrtm mrph) time-spent))) |# -(DEFVAR *FUTURE-DISPLAY* nil) - -(DEFVAR *TIME-INTERVAL* 60000) - (DEFUN GNRT-? (mrph degr gnrt) (declare (type morphism mrph) diff --git a/src/coalgebras.lisp b/src/coalgebras.lisp index 5c9a6b4..3b18a15 100644 --- a/src/coalgebras.lisp +++ b/src/coalgebras.lisp @@ -6,10 +6,6 @@ (PROVIDE "coalgebras") -(DEFVAR *CLGB-LIST*) -(SETF *CLGB-LIST* +empty-list+) -(PUSHNEW '*CLGB-LIST* *list-list*) - #+clisp(eval-when (:compile-toplevel :load-toplevel :execute) (setf (ext:package-lock :clos) nil)) (DEFMETHOD PRINT-OBJECT ((clgb coalgebra) stream) diff --git a/src/combinations.lisp b/src/combinations.lisp index ad58f51..028f096 100644 --- a/src/combinations.lisp +++ b/src/combinations.lisp @@ -469,10 +469,10 @@ (if mark2 (push term (cdr mark2)) (push term rslt)) - (return)) + (return)) (:equal (incf (-cffc mark1) cffc) - (return)) + (return)) (:greater ))))) (make-cmbn :degr degr diff --git a/src/effective-homology.lisp b/src/effective-homology.lisp index 325a1f7..6711092 100644 --- a/src/effective-homology.lisp +++ b/src/effective-homology.lisp @@ -10,9 +10,6 @@ ;;; REDUCTIONS ;;; -(DEFVAR *RDCT-LIST*) -(SETF *RDCT-LIST* +empty-list+) -(PUSHNEW '*RDCT-LIST* *list-list*) #+clisp(eval-when (:compile-toplevel :load-toplevel :execute) (setf (ext:package-lock :clos) nil)) @@ -82,9 +79,6 @@ ;;; HOMOTOPY-EQUIVALENCES ;;; -(DEFVAR *HMEQ-LIST*) -(SETF *HMEQ-LIST* +empty-list+) -(PUSHNEW '*HMEQ-LIST* *list-list*) (DEFMETHOD BUILD-HMEQ ((keyword1 (eql :lrdct)) lrdct &key rrdct orgn) (declare @@ -236,15 +230,6 @@ ;; Functions. -(DEFVAR *TDD*) -(DEFVAR *BDD*) -(DEFVAR *ID-FG*) -(DEFVAR *ID-GF-DH-HD*) -(DEFVAR *HH*) -(DEFVAR *FH*) -(DEFVAR *HG*) -(DEFVAR *DF-FD*) -(DEFVAR *DG-GD*) (DEFUN PRE-CHECK-RDCT (rdct) (declare (type reduction rdct)) @@ -270,8 +255,6 @@ *hg* (cmps h g))) (done)) -(DEFVAR *TC*) -(DEFVAR *BC*) (DEFUN CHECK-RDCT () (dolist (cmbn '(*tc* *bc*)) diff --git a/src/homology-groups.lisp b/src/homology-groups.lisp index c347993..3f9005e 100644 --- a/src/homology-groups.lisp +++ b/src/homology-groups.lisp @@ -536,7 +536,6 @@ depart3 (return (append res (terminer-H* B))))) -(DEFVAR *HOMOLOGY-VERBOSE* t) (DEFUN CHCM-MAT (chcm n) (declare diff --git a/src/kan.lisp b/src/kan.lisp index 7268b1b..e3ed3cc 100644 --- a/src/kan.lisp +++ b/src/kan.lisp @@ -6,10 +6,6 @@ (provide "kan") -(DEFVAR *KAN-LIST*) -(SETF *KAN-LIST* +empty-list+) -(PUSHNEW '*KAN-LIST* *list-list*) - (DEFUN KAN (idnm) (declare (fixnum idnm)) (the (or null simplicial-group) diff --git a/src/simplicial-groups.lisp b/src/simplicial-groups.lisp index 139dd6d..7971105 100644 --- a/src/simplicial-groups.lisp +++ b/src/simplicial-groups.lisp @@ -6,10 +6,6 @@ (PROVIDE "simplicial-groups") -(DEFVAR *SMGR-LIST*) -(SETF *SMGR-LIST* +empty-list+) -(PUSHNEW '*SMGR-LIST* *list-list*) - (DEFUN SMGR (idnm) (declare (fixnum idnm)) (the (or null simplicial-group) diff --git a/src/simplicial-mrphs.lisp b/src/simplicial-mrphs.lisp index eb67d18..d72a832 100644 --- a/src/simplicial-mrphs.lisp +++ b/src/simplicial-mrphs.lisp @@ -6,10 +6,6 @@ (PROVIDE "simplicial-mrphs") -(DEFVAR *SMMR-LIST*) -(SETF *SMMR-LIST* +empty-list+) -(PUSHNEW '*SMMR-LIST* *LIST-LIST*) - (DEFMETHOD ?3 ((smmr simplicial-mrph) dmns absm-or-gmsm) (declare (fixnum dmns) diff --git a/src/simplicial-sets.lisp b/src/simplicial-sets.lisp index d4c66a0..26aacb2 100644 --- a/src/simplicial-sets.lisp +++ b/src/simplicial-sets.lisp @@ -7,10 +7,6 @@ (PROVIDE "simplicial-sets") -(DEFVAR *SMST-LIST*) -(SETF *SMST-LIST* +empty-list+) -(PUSHNEW '*SMST-LIST* *list-list*) - (DEFUN DGOP-EXT-INT (ext-dgop) (declare (list ext-dgop)) ;; (list fixnum) diff --git a/src/tensor-products.lisp b/src/tensor-products.lisp index 2c5f2eb..eb3e2a4 100644 --- a/src/tensor-products.lisp +++ b/src/tensor-products.lisp @@ -6,7 +6,6 @@ (PROVIDE "tensor-products") -(DEFVAR *TNPR-WITH-DEGREES* nil) (DEFUN TNPR-PRINT (tnpr stream depth) (declare diff --git a/src/various.lisp b/src/various.lisp index be56062..c88cdd6 100644 --- a/src/various.lisp +++ b/src/various.lisp @@ -6,31 +6,6 @@ (PROVIDE "various") -(DEFINE-CONSTANT +EMPTY-LIST+ '()) - -(DEFINE-CONSTANT +F-EMPTY-VECTOR+ - (make-array 0 :element-type 'fixnum)) - -(DEFINE-CONSTANT +S-EMPTY-VECTOR+ - #()) - -(DEFINE-CONSTANT +TRUE+ t) - -(DEFINE-CONSTANT +FALSE+ nil) - -(DEFINE-CONSTANT +2-EXP+ - (let ((rslt (make-array (integer-length most-positive-fixnum) - :element-type 'fixnum))) - (declare (type (array fixnum 1) rslt)) - (dotimes (i (integer-length most-positive-fixnum) rslt) - (setf (aref rslt i) (the fixnum (expt 2 i)))))) - -(DEFINE-CONSTANT +MASK+ - (let ((rslt (make-array (integer-length most-positive-fixnum) - :element-type 'fixnum))) - (declare (type (array fixnum 1) rslt)) - (dotimes (i (integer-length most-positive-fixnum) rslt) - (setf (aref rslt i) (the fixnum (1- (expt 2 i))))))) (DEFUN BINOMIAL-N-P (n p) (declare (fixnum n p))