[armedbear-cvs] r12447 - trunk/abcl/src/org/armedbear/lisp

[Mark Evenson]

Author: mevenson
Date: Thu Feb 11 07:03:56 2010
New Revision: 12447

Log:
REQUIRE now searches for ASDF systems.

If ASDF is loaded via (REQUIRE 'ASDF), all subsequent invocations of
REQUIRE will search for a loadable ASDF system definitions if the
default resolver mechanism fails.

SYS::*MODULE-PROVIDER-FUNCTIONS* now contains a customizable list of
module provider functions.  Such a function takes a single argument of
the module that should be resolved and loaded.  There is a builtin
resolver #'SYS::MODULE-PROVIDE-SYSTEM that implicitly called before
any functions in this variable.



Modified:
   trunk/abcl/src/org/armedbear/lisp/asdf-abcl.lisp
   trunk/abcl/src/org/armedbear/lisp/require.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/asdf-abcl.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/asdf-abcl.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/asdf-abcl.lisp	Thu Feb 11 07:03:56 2010
@@ -44,5 +44,21 @@
     (if (every #'sys:pathname-jar-p files) 
         t
         (call-next-method))))
+
+(defun module-provide-asdf (name) 
+  (handler-case
+      (let* ((*verbose-out* (make-broadcast-stream))
+             (system (asdf:find-system name nil)))
+        (when system
+          (asdf:operate 'asdf:load-op name)
+          t))
+    (missing-component (e) 
+      (declare (ignore e))
+      nil)
+    (t (e)
+      (format *error-output* "ASDF could not load ~A because ~A.~%"
+              name e))))
+
+(pushnew #'module-provide-asdf sys::*module-provider-functions*)
   
 (provide 'asdf-abcl)

Modified: trunk/abcl/src/org/armedbear/lisp/require.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/require.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/require.lisp	Thu Feb 11 07:03:56 2010
@@ -36,6 +36,20 @@
   (pushnew (string module-name) *modules* :test #'string=)
   t)
 
+(defun module-provide-system (module) 
+  (let ((*readtable* (copy-readtable nil)))
+    (handler-case 
+        (load-system-file (string-downcase (string module)))
+      (t (e) 
+        (unless (and (typep e 'error)
+                     (search "Failed to find loadable system file"
+                             (format nil "~A" e)))
+          (format *error-output* "Failed to require  ~A because '~A'~%" 
+                  module e))
+        nil))))
+    
+(defvar *module-provider-functions* nil)
+
 (defun require (module-name &optional pathnames)
   (unless (member (string module-name) *modules* :test #'string=)
     (let ((saved-modules (copy-list *modules*)))
@@ -44,6 +58,9 @@
              (dolist (x pathnames)
                (load x)))
             (t
-             (let ((*readtable* (copy-readtable nil)))
-               (load-system-file (string-downcase (string module-name))))))
+             (unless (some (lambda (p) (funcall p module-name))
+                           (append (list #'module-provide-system)
+                                 sys::*module-provider-functions*))
+               (error "Don't know how to ~S ~A." 'require module-name))))
       (set-difference *modules* saved-modules))))
+