source: CGBLisp/src/make-cgb.lisp@ 1

#|
  $Id: make-cgb.lisp,v 1.3 2009/01/19 07:05:15 marek Exp $
  *--------------------------------------------------------------------------*
  |  Copyright (C) 1994, Marek Rychlik (e-mail: rychlik@math.arizona.edu)    |
  |    Department of Mathematics, University of Arizona, Tucson, AZ 85721    |
  |                                                                          |
  | Everyone is permitted to copy, distribute and modify the code in this    |
  | directory, as long as this copyright note is preserved verbatim.         |
  *--------------------------------------------------------------------------*
|#
;;(eval-when (eval load compile)
;;  (require :user-manual "../contrib/user_man/user-manual"))

(defpackage "MAKE-CGB"
  (:use "COMMON-LISP"))

(in-package "MAKE-CGB")

(defvar *save-path* "cgblisp")

(defvar *cgb-version-string* "CGB Package: @(#)defsystem.lisp, version 1.9 of 2/13/96(17:56:13)"
  "Refer to this version string when reporting bugs.")

(defvar *lisp-suffix* ".lisp" "File extension used by the lisp system.")
(defvar *cgb-packages*
  '("MAKELIST" "ORDER" "MONOM" "XGCD" "MODULAR" "COEFFICIENT-RING"
    "TERM" "POLY" "MODULAR-POLY" "DIVISION" "PARSE" "PRINTER" "POLY-WITH-SUGAR"
    "GROBNER" "COLORED-POLY" "POLY-GCD" "RAT" "RATPOLY"
    "STRING-GROBNER" "DYNAMICS" "PROVER"
    "INFIX" "CGB-LISP"))

;;----------------------------------------------------------------
;; Various features which affect the functioning of the package
;;----------------------------------------------------------------

;;Use pseudodivision to keep the size of integer coefficients 
;;as small as possible
(pushnew :pseudodivide *features*)

;;Use the grobner package within colored-poly package
(pushnew :colored-poly-use-grobner *features*)

;;colored-poly package
;;Compute saturation of green lists with respect to
;;red lists in order to eliminate cases early
(pushnew :use-saturation *features*)

;;Print tracing and debugging output
(pushnew :debug *features*)

;;Use gcd of integers to keep the size of integer coefficients
;; of S-polynomials and normal forms down
(pushnew :use-gcd *features*)

;;grobner package
;;Use the algorithm of Gebauer and Moeller (1988) to
;;calculate Grobner bases
;;(pushnew :use-gebauer-moeller *features*)

#|
;;Needed by Allegro Common Lisp in order to maintain
;;compatibility with the book of Steele (1st edition)
;;in regard to in-package and related operations
(pushnew :cgb-cltl1-compatibility *features*)
|#

;;Use pair reordering according to some heuristic in the
;;Grobner algorithm
(pushnew :reorder-pairs *features*)

;;Perform Buchberger criterion every time a Grobner
;;basis is returned or assumed as an argument;
;;This feature is mostly for debugging by the
;;package developer, but if you detect failure
;;of the package in this way, please send the
;;output to rychlik@math.arizona.edu
;;DO NOT TURN THIS FEATURE ON IF EFFICIENCY
;;IS REQUIRED!!!
;;(pushnew :grobner-check *features*)

#|
#+cgb-cltl1-compatibility
(progn
  #+allegro
  (progn
    (setf *cltl1-in-package-compatibility-p* t)
    (setf comp:*cltl1-compile-file-toplevel-compatibility-p* t)
    (use-package *cltl1-package*))
  )
|#

(defun package-file (package-name)
  (string-downcase package-name))

(defun cgb-compile ()
  #+kcl(system "rm *.o")
  (dolist (package *cgb-packages*)
    (print '----------------)
    (compile-file (package-file package))
    (load (package-file package))))

(defun cgb-load (&key (print nil))
  (declare (ignore print))
  (dolist (package *cgb-packages*)
    (load (package-file package)))
  ;;A fix around a bug in GCL which causes
  ;;an undefined symbol __setjmp with
  ;;compiled code
  #+gcl (load (concatenate 'string "parse" *lisp-suffix*))
  )

(defun cgb-load-lisp (&key (print nil))
  (declare (ignore print))
  (dolist (package *cgb-packages*)
    (let ((lisp-file (concatenate 'string (package-file package) *lisp-suffix*)))
      (load lisp-file)
      ;;(use-package package)
      )))

(defun cgb-compile-and-load ()
  (cgb-compile)
  (cgb-load))

(defun cgb-go ()
  (in-package :cgb-lisp))

#+allegro
(defun start-cgb-lisp ()
  (tpl:start-interactive-top-level
   *terminal-io*
   #'cgb-lisp-top-level-read-eval-print-loop
   nil
   :initial-bindings nil))

#+allegro
(defun cgb-lisp-top-level-read-eval-print-loop (&rest args)
  (in-package :cgb-lisp)
  (apply #'tpl:top-level-read-eval-print-loop args))

#+allegro
(defun cgb-lisp-banner ()
  (format 
   t 
   "~&Comprehensive Grobner Basis package by Marek Rychlik preloaded.~%~a~%"
   *cgb-version-string*))

#+kcl
(defun cgb-save ()
  (defvar system::*akcl-top-level* (symbol-function 'system::top-level))
  (compile 
   'system::top-level
   '(lambda  ()
      (format 
       t 
       "~&Comprehensive Grobner Basis package by Marek Rychlik preloaded.~%~a~%"
       *cgb-version-string*)
      (funcall system::*akcl-top-level*)))
  (save *save-path*))

#+allegro
(defun cgb-save ()
  (setf excl:*restart-init-function* 'cgb-lisp-banner)
  ;;(setf excl:*restart-app-function* 'start-cgb-lisp)
  (excl:dumplisp
   :name *save-path*
   :home-env-var "CGBLISP_HOME"))

;;(load-system)

;;----------------------------------------------------------------
;; Generate documentation
;;----------------------------------------------------------------
;;(defun create-cgb-manuals (prefix format)
;;  (create-manuals (mapcar #'intern *cgb-packages*)
;;                            :prefix prefix
;;                            :extension '.lisp
;;                            :output-format format))

;;(defun cgb-doc ()
;;  (create-cgb-manuals '../doc/ 'text)
;;  (create-cgb-manuals '../latex-doc/ 'latex))