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

Moved all global variables to kenzo.lisp

Browse Source
This commit is contained in:
gheber 2014-12-26 20:04:29 -06:00
parent 0351445e49
commit 04a64f467e
13 changed files with 137 additions and 103 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

137
kenzo.lisp
View File

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

8
src/algebras.lisp
View File

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

27
src/chain-complexes.lisp
View File

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

4
src/coalgebras.lisp
View File

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

4
src/combinations.lisp
View File

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

17
src/effective-homology.lisp
View File

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

1
src/homology-groups.lisp
View File

@ -536,7 +536,6 @@
depart3
(return (append res (terminer-H* B)))))
(DEFVAR *HOMOLOGY-VERBOSE* t)
(DEFUN CHCM-MAT (chcm n)
(declare

4
src/kan.lisp
View File

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

4
src/simplicial-groups.lisp
View File

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

4
src/simplicial-mrphs.lisp
View File

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

4
src/simplicial-sets.lisp
View File

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

1
src/tensor-products.lisp
View File

@ -6,7 +6,6 @@
(PROVIDE "tensor-products")
(DEFVAR *TNPR-WITH-DEGREES* nil)
(DEFUN TNPR-PRINT (tnpr stream depth)
(declare

25
src/various.lisp
View File

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