From d89a465c194d12dc1eff31dc7adc861cdce98107 Mon Sep 17 00:00:00 2001 From: dos-reis Date: Sun, 22 Feb 2009 14:33:02 +0000 Subject: Remove unused code. --- src/interp/util.lisp | 275 +-------------------------------------------------- 1 file changed, 1 insertion(+), 274 deletions(-) (limited to 'src/interp/util.lisp') 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 "~©ing ~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) -- cgit v1.2.3