Interface to mk:defsys



Since maxima uses mk:defsys to build itself and also to build some share
packages, I thought it might be nice if maxima could actually use mk:defsys.

Appended is a very rudimentary interface.  mk_oos(name, op) will run
mk:oos to compile/load the system named "name".  Op should be 'compile,
or 'load.  mk:oos has many other keyword options;  I didn't add support
for that, but they probably should be supported.

list_systems() will list all the systems in the share directories.  This
basically means any file with a "system" extension located anywhere in
the share directories.


I tested this briefly with cmucl.  mk_oos("lapack", 'compile) will
compile and load lapack.  list_systems() returns:

[affine, colnew-lisp, colnew, gentran, graphs, lapack-lisp, lapack,
 blas-lisp, lapack-lisp, lbfgs-lisp, linearalgebra, minpack-lisp,
minpack, sym]

Anyway, I think something like this will help standardize handling of
the share packages.  It will require work on the share packages to add
system definition files, but I think that would be a good thing.

We could also add (maybe) require(name) which will basically run mk_oos
to compile and load a system if it hasn't already been loaded.

Ray

(in-package "MAXIMA")

(defparameter $file_search_system
  (let ((defsys-patterns "###.system")
    (share-subdirs (format nil "{~{~A~^,~}}"
                   (share-subdirs-list))))
    (list '(mlist)
      (combine-path *maxima-userdir* defsys-patterns)
      (combine-path *maxima-sharedir* defsys-patterns)
      (combine-path *maxima-sharedir* share-subdirs defsys-patterns))))

;; Basically convert $file_search_system into a list of directories
;; that would be appropriate for mk:*central-registry*

(defun convert-defsys-search-paths (template)
  (let ((result nil))
    (mapc #'(lambda (p)
          (destructuring-bind (base &optional subdirs &rest patterns)
          ;; This bit of code taken from new-file-search in
          ;; mload.lisp.  Basically look at the template and
          ;; split it up if possible.  If so, we get the base
          ;; directory, the list of subdirectories, and the
          ;; pattern.
          (loop for w in (split-string p "{}")
            when (null (position #\, w))
            collect w
            else
            collect (split-string w ","))
        #+nil
        (progn
          (format t "p = ~S~%" p)
          (format t " base = ~S~%" base)
          (format t " subdirs = ~S~%" subdirs)
          (format t " patterns = ~S~%" patterns))
        (if subdirs
            (if patterns
            (dolist (s subdirs)
              (push (concatenate 'string base s "/") result))
            (push base result))
            (push base result))))
      template)
    (nreverse (mapcar #'(lambda (p)
              (make-pathname :directory (pathname-directory p)))
              result))))

(defun $mk_oos (name op)
  ;; We setup *central-registry* every time in case the user has
  ;; changed $file_search_system.
  (let ((mk:*central-registry* (convert-defsys-search-paths (cdr
$file_search_system))))
    (mk:oos (stripdollar name) (intern (string (stripdollar op)) :keyword))
    '$done))

(defun $list_systems ()
  (let ((result nil))
    ;; We setup *central-registry* every time in case the user has
    ;; changed $file_search_system.
    (dolist (p (convert-defsys-search-paths (cdr $file_search_system)))
      (let ((sys (directory (merge-pathnames "*.system" p))))
    (when sys
      (mapc #'(lambda (f)
            (push (pathname-name f) result))
        sys))))
    (list* '(mlist) (nreverse result))))