[Openmcl-devel] extensible require mechanism

[bryan o'connor]

following from the discussion of whether to bundle asdf-install
with openmcl -- i did a quick port of sbcl's require facility.

the idea is that require only deals with the case when optional
pathname(s) are passed.  if not, then it goes through a list of
provider modules until the module is loaded.  if nothing is found,
an error message is given.

i moved the current require algorithm to a module called
#'module-provide-search-path.  i also give the example provider
function that asdf could ship with.  i imagine that a similar
one would be written for defsystem.

this was a 15 minute port/hack.. so no guarantees.


				...bryan


(in-package :ccl)

(defparameter *module-provider-functions* '(module-provide-search-path))

(defun require (module &optional pathnames)
   (when (null module) (report-bad-arg module '(not null)))
   (let ((saved-modules (copy-list *modules*)))
     (unless (member (string module) *modules* :test #'string=)
       (cond (pathnames
              (unless (listp pathnames) (setf pathnames (list 
pathnames)))
              ;; ambiguity in standard: should we try all pathnames in 
the
              ;; list, or should we stop as soon as one of them calls 
PROVIDE?
              (dolist (ele pathnames t)
                (load ele)))
             (t
              (unless (some (lambda (p) (funcall p module))
                            *module-provider-functions*)
                (error "Don't know how to load ~A" module)))))
     (set-difference *modules* saved-modules)))


(defun module-provide-search-path (module)
   (format *debug-io* "trying module-provide-search-path~%")
   (let* ((module-name (string module))
          (pathname (find-module-pathnames module-name)))
     (when pathname
       (if (consp pathname)
           (dolist (path pathname) (load path))
         (load pathname))
       (setq *modules* (adjoin module-name *modules* :test 
#'string-equal)))))

;;;
;;; example provider function distributed with asdf.
;;;

(defun module-provide-asdf (module)
   (handler-bind ((style-warning #'muffle-warning))
                 (let ((system (asdf:find-system module nil)))
                   (when system
                     (asdf:operate 'asdf:load-op module)
                     t))))

(pushnew 'module-provide-asdf ccl::*module-provider-functions*)