aboutsummaryrefslogtreecommitdiff
path: root/src/interp/daase.lisp
diff options
context:
space:
mode:
Diffstat (limited to 'src/interp/daase.lisp')
-rw-r--r--src/interp/daase.lisp73
1 files changed, 10 insertions, 63 deletions
diff --git a/src/interp/daase.lisp b/src/interp/daase.lisp
index 88f599e2..73c1c0a6 100644
--- a/src/interp/daase.lisp
+++ b/src/interp/daase.lisp
@@ -407,9 +407,7 @@
|OneDimensionalArrayAggregate&| |FiniteLinearAggregate&| |PrimitiveArray|
|Integer| |List| |OutputForm|))
(dolist (con constr)
- (let ((c (concatenate 'string
- (|systemRootDirectory|) "/algebra/"
- (string (getdatabase con 'abbreviation)) ".o")))
+ (let ((c (|getSystemModulePath| (string (getdatabase con 'abbreviation)))))
(format t " preloading ~a.." c)
(if (probe-file c)
(progn
@@ -559,7 +557,7 @@
(let (oldop op)
(setq op (car map))
(setq oldop (getdatabase op 'operation))
- (setq oldop (lisp::delete (cdr map) oldop :test #'equal))
+ (setq oldop (delete (cdr map) oldop :test #'equal))
(setf (gethash op *operation-hash*) oldop)))
(dolist (map (getdatabase constructor 'modemaps)) ; in with the new
(let (op newmap)
@@ -784,17 +782,14 @@
(if (consp data)
(setq data
(if (string= (directory-namestring (car data)) "")
- (concatenate 'string (|systemRootDirectory|) "algebra/" (car data) ".o")
+ (|getSystemModulePath| (car data))
(car data)))
(when (and data (string= (directory-namestring data) ""))
- (setq data (concatenate 'string (|systemRootDirectory|) "algebra/" data ".o")))))))
+ (setq data (|getSystemModulePath| data)))))))
data))
; )library top level command -- soon to be obsolete
-(defun |with| (args)
- (|library| args))
-
;; Current directory
;; Contributed by Juergen Weiss.
#+:cmu
@@ -805,44 +800,6 @@
(defun get-current-directory ()
(namestring (truename "")))
-
-; )library top level command
-
-(defun |library| (args)
- (declare (special |$options|))
- (declare (special |$newConlist|))
- (setq original-directory (get-current-directory))
- (setq |$newConlist| nil)
- (localdatabase args |$options|)
-#+:CCL
- (dolist (a args) (check-module-exists a))
- (|extendLocalLibdb| |$newConlist|)
- (|changeDirectory| original-directory)
- (tersyscommand))
-
-;; check-module-exists looks to see if a module exists in one of the current
-;; libraries and, if not, compiles it. If the output-library exists but has not
-;; been opened then it opens it first.
-#+:CCL
-(defun check-module-exists (module)
- (prog (|$options| mdate)
- (if (and (not output-library) (filep (or |$outputLibraryName| "user.lib")))
- (seq (setq |$outputLibraryName|
- (if |$outputLibraryName| (truename |$outputLibraryName|)
- (make-pathname :directory (get-current-directory)
- :name "user.lib")))
- (|openOutputLibrary| |$outputLibraryName|)))
- (setq mdate (modulep module))
- (setq |$options| '((|nolibrary| nil) (|quiet| nil)))
- (|sayMSG| (format nil " Checking for module ~s." (namestring module)))
- (let* ((fn (concatenate 'string (namestring module) ".lsp"))
- (fdate (filedate fn)) )
- (if (and fdate (or (null mdate) (datelessp mdate fdate)))
- (|compileAsharpLispCmd| (list fn))
- (let* ((fn (concatenate 'string (namestring module) ".NRLIB"))
- (fdate (filedate fn)) )
- (if (and fdate (or (null mdate) (datelessp mdate fdate)))
- (|compileSpadLispCmd| (list fn))))))))
; localdatabase tries to find files in the order of:
; NRLIB/index.KAF
@@ -855,15 +812,15 @@
(processOptions (options)
(let (only dir noexpose)
(when (setq only (assoc '|only| options))
- (setq options (lisp::delete only options :test #'equal))
+ (setq options (delete only options :test #'equal))
(setq only (cdr only)))
(when (setq dir (assoc '|dir| options))
- (setq options (lisp::delete dir options :test #'equal))
+ (setq options (delete dir options :test #'equal))
(setq dir (second dir))
(when (null dir)
(|sayKeyedMsg| 'S2IU0002 nil) ))
(when (setq noexpose (assoc '|noexpose| options))
- (setq options (lisp::delete noexpose options :test #'equal))
+ (setq options (delete noexpose options :test #'equal))
(setq noexpose 't) )
(when options
(format t " Ignoring unknown )library option: ~a~%" options))
@@ -876,8 +833,8 @@
(values
(mapcan #'(lambda (f)
(when (string-equal (pathname-type f) "NRLIB")
- (list (concatenate 'string (namestring f) "/"
- *index-filename*)))) allfiles)
+ (list (concatenate 'string (namestring f) "/" *index-filename*))))
+ allfiles)
(mapcan #'(lambda (f)
(when (string= (pathname-type f) "asy")
(push (pathname-name f) skipasos)
@@ -889,12 +846,7 @@
allfiles)
;; At the moment we will only look for user.lib: others are taken care
;; of by localasy and localnrlib.
-#+:CCL
- (mapcan #'(lambda (f)
- (when (and (string= (pathname-type f) "lib") (string= (pathname-name f) "user"))
- (list (namestring f))))
- allfiles)
-#-:CCL nil
+ nil
))))
(let (thisdir nrlibs asos asys libs object only dir key
(|$forceDatabaseUpdate| t) noexpose)
@@ -921,8 +873,6 @@
(concatenate 'string namedir filename ".ao")))
(push (namestring file) asos))
('else (format t " )library cannot find the file ~a.~%" filename)))))
-#+:CCL
- (dolist (file libs) (|addInputLibrary| (truename file)))
(dolist (file (nreverse nrlibs))
(setq key (pathname-name (first (last (pathname-directory file)))))
(setq object (concatenate 'string (directory-namestring file)
@@ -1311,7 +1261,6 @@
(let (opalistpos modemapspos cmodemappos master masterpos obj *print-pretty*
concategory categorypos kind niladic cosig abbrev defaultdomain
ancestors ancestorspos out)
- (declare (special *print-pretty*))
(print "building interp.daase")
(setq out (open "interp.build" :direction :output))
(princ " " out)
@@ -1369,7 +1318,6 @@
(defun write-browsedb ()
"make browse.daase from hash tables"
(let (master masterpos src formpos docpos attpos predpos *print-pretty* out)
- (declare (special *print-pretty*))
(print "building browse.daase")
(setq out (open "browse.build" :direction :output))
(princ " " out)
@@ -1404,7 +1352,6 @@
(defun write-categorydb ()
"make category.daase from scratch. contains the *hasCategory-hash* table"
(let (out master pos *print-pretty*)
- (declare (special *print-pretty*))
(print "building category.daase")
(|genCategoryTable|)
(setq out (open "category.build" :direction :output))