Remove unused code.

1 files changed, 1 insertions, 274 deletions

diff --git a/src/interp/util.lisp b/src/interp/util.lisp
index 6c664800..8e2b0b9b 100644
--- a/src/interp/util.lisp
+++ b/src/interp/util.lisp
@@ -1,6 +1,6 @@
 ;; Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
 ;; All rights reserved.
-;; Copyright (C) 2007-2008, Gabriel Dos Reis.
+;; Copyright (C) 2007-2009, Gabriel Dos Reis.
 ;; All rights reserved.
 ;;
 ;; Redistribution and use in source and binary forms, with or without
@@ -203,137 +203,6 @@
                       (boot bootfile lfile) (list bootfile))))))
 
 
-;; TAGS are useful for finding functions if you run Emacs. We have a
-;; set of functions that construct TAGS files for Axiom.
-(defun make-tags-file ()
-  (|changeDirectory| "/tmp")
-  (|runCommand| (concat "etags " (|makeAbsoluteFilename| "../../src/interp/*.lisp")))
-  (spadtags-from-directory "../../src/interp" "boot")
-  (|runCommand| "cat /tmp/boot.TAGS >> /tmp/TAGS"))
-
-(defun spadtags-from-directory (dir type)
-   (let* ((direc (make-directory dir))
-          (pattern (make-pathname :directory (pathname-directory direc)
-                                  :name :wild :type type))
-          (files (directory pattern)))
-     (with-open-file
-      (tagstream (concatenate 'string "/tmp/" type ".TAGS") :direction :output
-                 :if-exists :supersede :if-does-not-exist :create)
-      (dolist (file files (namestring tagstream))
-              (print (list "processing:" file))
-              (write-char #\page tagstream)
-              (terpri tagstream)
-              (write-string (namestring file) tagstream)
-              (write-char #\, tagstream)
-              (princ (spadtags-from-file file) tagstream)
-              (terpri tagstream)
-              (with-open-file (stream "/tmp/*TAGS")
-                 (do ((line (read-line stream nil nil)
-                            (read-line stream nil nil)))
-                     ((null line) nil)
-                     (write-line line tagstream)))))))
-
-(defun spadtags-from-file (spadfile)
-  (with-open-file (tagstream "/tmp/*TAGS" :direction :output
-                             :if-exists :supersede :if-does-not-exist :create)
-    (with-open-file (stream spadfile)
-       (do ((char-count 0 (file-position stream))
-            (line (read-line stream nil nil) (read-line stream nil nil))
-            (line-count 1 (1+ line-count)))
-           ((null line) (file-length tagstream))
-           (if (/= (length line) 0)
-               (let ((firstchar (elt line 0)) (end nil)
-                     (len (length line)))
-                 (cond ((member firstchar '(#\space #\{ #\} #\tab )
-                                :test #'char= ) "skip")
-                       ((string= line ")abb" :end1 (min 4 len))
-                        (setq end (position #\space line :from-end t
-                                            :test-not #'eql)
-                              end (and end (position #\space line :from-end t
-                                                     :end end)))
-                        (write-tag-line line tagstream end
-                                        line-count char-count))
-                       ((char= firstchar #\)) "skip")
-                       ((and (> len 1) (string= line "--" :end1 2)) "skip")
-                       ((and (> len 1) (string= line "++" :end1 2)) "skip")
-                       ((search "==>" line) "skip")
-                       ((and (setq end (position #\space line)
-                                   end (or (position #\( line :end end) end)
-                                   end (or (position #\: line :end end) end)
-                                   end (or (position #\[ line :end end) end))
-                             (equal end 0)) "skip")
-                       ((position #\] line :end end) "skip")
-                       ((string= line "SETANDFILEQ" :end1 end) "skip")
-                       ((string= line "EVALANDFILEACTQ" :end1 end) "skip")
-                       (t (write-tag-line line tagstream
-                                          (if (numberp end) (+ end 1) end)
-                                          line-count char-count))  )))))))
-
-(defun write-tag-line (line tagstream endcol line-count char-count)
-  (write-string line tagstream :end endcol)
-  (write-char #\rubout tagstream)
-  (princ line-count tagstream)
-  (write-char #\, tagstream)
-  (princ char-count tagstream)
-  (terpri tagstream))
-
-(defun blankcharp (c) (char= c #\Space))
-
-(defun findtag (tag &optional (tagfile (concat (|systemRootDirectory|) "/../../src/interp/TAGS")) )
-  ;; tag is an identifier
-    (with-open-file (tagstream tagfile)
-        (do ((tagline (read-line tagstream nil nil)
-                      (read-line tagstream nil nil))
-             (*package* (symbol-package tag))
-             (sourcefile)
-             (stringtag (string tag))
-             (pos)
-             (tpos)
-             (type))
-            ((null tagline) ())
-            (cond ((char= (char tagline 0) #\Page)
-                   (setq tagline (read-line tagstream nil nil))
-                   (setq sourcefile (subseq tagline 0
-                                            (position #\, tagline)))
-                   (setq type (pathname-type sourcefile)))
-                  ((string= type "lisp")
-                   (if (match-lisp-tag tag tagline)
-                       (return (cons sourcefile tagline))))
-                  ((> (mismatch ")abb" tagline) 3)
-                   (setq pos (position #\Space tagline :start 3))
-                   (setq pos (position-if-not #'blankcharp tagline
-                                              :start pos))
-                   (setq pos (position #\Space tagline :start pos))
-                   (setq pos (position-if-not #'blankcharp tagline
-                                              :start pos))
-                   (setq tpos (mismatch stringtag tagline :start2 pos))
-                   (if (and (= tpos (length (string tag)))
-                            (member (char tagline (+ pos tpos)) '(#\Space #\Rubout)))
-                       (return (cons sourcefile tagline))))
-                  ((setq pos (mismatch stringtag tagline))
-                   (if (and (= pos (length stringtag))
-                            (> (length tagline) pos)
-                            (member (char tagline pos)
-                                    '( #\Space #\( #\:) ))
-                       (return (cons sourcefile tagline))))))))
-
-(defun match-lisp-tag (tag tagline &optional (prefix nil)
-                           &aux (stringtag (string tag)) pos tpos)
-  (when (and (if prefix
-                 (= (mismatch prefix tagline :test #'char-equal)
-                    (length prefix))
-               t)
-             (numberp (setq pos (position #\Space tagline)))
-             (numberp (setq pos (position-if-not #'blankcharp tagline
-                                                 :start pos))))
-        (if (char= (char tagline pos) #\') (incf pos))
-        (if (member (char tagline pos) '( #\\ #\|))
-            (setq tpos (1+ pos))
-          (setq tpos pos))
-        (and (= (mismatch stringtag tagline :start2 tpos :test #'char-equal)
-                (length stringtag))
-             (eq tag (read-from-string tagline nil nil :start pos))) ))
-
 ;; Translate a single boot file to common lisp, compile it 
 ;; and load it.
 (defun compile-boot-file (file)
@@ -609,148 +478,6 @@
 
 (in-package "BOOT")
 
-(defun |tr| (fn)
-  (|spad2AsTranslatorAutoloadOnceTrigger|)
-  (|convertSpadFile| fn) )
-
-
-;; Make will not compare dates across directories.
-;; Rather than copy all of the code.lsp files to the MNT directory
-;; we run this function to compile the files that are out of date
-;; this function assumes that the shell variables INT and MNT are set.
-;; Also of note: on the rt some files (those in the nooptimize list)
-;; need to be compiled without optimize due to compiler bugs
-(defun makelib (mid out stype btype)
- "iterate over the NRLIBs, compiling ones that are out of date.
-  mid is the directory containing code.lsp
-  out is the directory containing code.o"
- (let (libs lspdate odate nooptimize (alphabet #\space))
-#+(and :akcl :rt)
-  (setq nooptimize '("FFCAT-.NRLIB" "CHVAR.NRLIB" "PFO.NRLIB" "SUP.NRLIB"
-                     "INTG0.NRLIB" "FSPRMELT.NRLIB" "VECTOR.NRLIB"
-                     "EUCDOM-.NRLIB"))
-  (if (and mid out)
-   (format t "doing directory on ~s...~%" (concatenate 'string mid "/*"))
-   (error "makelib:MID=~a OUT=~a~% these are not set properly~%" mid out))
-#+:akcl (compiler::emit-fn nil)
-  (|changeDirectory| mid)
-  (setq libs (directory "*.NRLIB"))
-  (unless libs
-   (format t "makelib:directory of ~a returned NIL~%" mid)
-   (bye -1))
-  (princ "checking ")
-  (dolist (lib libs)
-   (unless (char= (schar (pathname-name lib) 0) alphabet)
-    (setq alphabet (schar (pathname-name lib) 0))
-    (princ alphabet)
-    (finish-output))
-   (let (dotlsp doto mntlib intkaf mntkaf intkafdate mntkafdate)
-    (setq dotlsp
-      (concatenate 'string mid "/" (file-namestring lib) "/code." stype))
-    (setq doto
-      (concatenate 'string out "/" (pathname-name lib) ".NRLIB/code." btype))
-    (setq mntlib
-      (concatenate 'string out "/" (pathname-name lib) ".NRLIB"))
-    (setq intkaf
-      (concatenate 'string mid "/" (file-namestring lib) "/index.KAF*"))
-    (setq mntkaf
-      (concatenate 'string out "/" (pathname-name lib) ".NRLIB/index.KAF*"))
-    (unless (probe-file mntlib)
-     (format t "creating directory ~a~%" mntlib)
-     (|runCommand| (concatenate 'string "cp -pr " (namestring lib) " " out))
-     (when (probe-file (concatenate 'string mntlib "/code." stype))
-      (delete-file  (concatenate 'string mntlib "/code." stype))))
-    (setq intkafdate (and (probe-file intkaf) (file-write-date intkaf)))
-    (setq mntkafdate (and (probe-file mntkaf) (file-write-date mntkaf)))
-    (when intkafdate
-     (unless (and mntkafdate (> mntkafdate intkafdate))
-      (format t "~&copying ~s to ~s" intkaf mntkaf)
-      (|runCommand|
-       (concatenate 'string "cp " 
-         (namestring intkaf) " " (namestring mntkaf)))))
-    (setq lspdate (and (probe-file dotlsp) (file-write-date dotlsp)))
-    (setq odate (and (probe-file doto) (file-write-date doto)))
-    (when lspdate
-     (unless (and odate (> odate lspdate))
-#+(and :akcl :rt)
-      (if (member (file-namestring lib) nooptimize :test #'string=)
-       (setq compiler::*speed* 0)
-       (setq compiler::*speed* 3))
-      (compile-lib-file dotlsp :output-file doto)))))))
-
-
-;; Make will not compare dates across directories.
-;; In particular, it cannot compare the algebra files because there
-;; is a one-to-many correspondence. This function will walk over
-;; all of the algebra NRLIB files and find all of the spad files
-;; that are out of date and need to be recompiled. This function
-;; creates a file "/tmp/compile.input" to be used later in the
-;; makefile.
-;; Note that the file /tmp/compile.input is not currently used
-;; as algebra source recompiles are not necessarily something
-;; we want done automatically. Nevertheless, in the quest for
-;; quality we check anyway.
-(defun makespad (src mid stype)
- "iterate over the spad files, compiling ones that are out of date.
-  src is the directory containing .spad
-  mid is the directory containing code.lsp
-  out is the directory containing code.o"
- (let (mntlibs spadwork (alphabet #\space))
-  (labels (
-   (findsrc (mid libname)
-    "return a string name of the source file given the library file
-     name (eg PI) as a string"
-    (let (kaffile index alist)
-     (setq kaffile 
-      (concatenate 'string mid "/" libname ".NRLIB/index.KAF*"))
-     (with-open-file (kaf kaffile)
-      (setq index (read kaf))
-      (file-position kaf index)
-      (setq alist (read kaf))
-     (setq index (third (assoc "sourceFile" alist :test #'string=)))
-      (file-position kaf index)
-     (pathname-name (pathname (read kaf index)))))))
-  (format t "makespad:src=~s mid=~s stype=~s~%" src mid stype)
-  (if (and src mid)
-   (format t "doing directory on ~s...~%" (concatenate 'string src "/*"))
-   (error "makespad:SRC=~a MID=~a not set properly~%" src mid))
-  (|changeDirectory| mid)
-  (setq mntlibs (directory "*.NRLIB"))
-  (unless mntlibs
-   (format t "makespad:directory of ~a returned NIL~%" src)
-   (bye 1))
-  (princ "checking ")
-  (dolist (lib mntlibs)
-   (unless (char= (schar (pathname-name lib) 0) alphabet)
-    (setq alphabet (schar (pathname-name lib) 0))
-    (princ alphabet)
-    (finish-output))
-   (let (spad spaddate lsp lspdate)
-    (setq spad
-      (concatenate 'string src "/" (findsrc mid (pathname-name lib)) ".spad"))
-    (setq spaddate
-      (and (probe-file spad) (file-write-date spad)))
-    (setq lsp
-      (concatenate 'string mid "/" (pathname-name lib) ".NRLIB/code." stype))
-    (setq lspdate
-      (and (probe-file lsp) (file-write-date lsp)))
-    (cond
-     ((and spaddate lspdate (<= spaddate lspdate)))
-     ((and spaddate lspdate (> spaddate lspdate))
-       (setq spadwork (adjoin spad spadwork :test #'string=)))
-     ((and spaddate (not lspdate)) 
-       (setq spadwork (adjoin spad spadwork :test #'string=)))
-     ((and (not spaddate) lspdate)
-       (format t "makespad:missing spad file ~a for lisp file ~a~%" spad lsp))
-     ((and (not spaddate) (not lspdate))
-       (format t "makespad:NRLIB ~a exist but is spad ~a and lsp ~a don't~%"
-         lib spad lsp)))))
-   (with-open-file (tmp "/tmp/compile.input" :direction :output)
-    (dolist (spad spadwork)
-     (format t "~a is out of date~%" spad)
-     (format tmp ")co ~a~%" spad))))))
-
-
 ;; We need to ensure that the INTERP.EXPOSED list, which is a list
 ;; of the exposed constructors, is consistent with the actual libraries.
 (defun libcheck (int)