Work in progress, recovered from old crybaby.

[sod] / src / impl-module.lisp

diff --git a/src/impl-module.lisp b/src/impl-module.lisp
index 8349b852f98ac759404ee03d30be2c5311eca254..753ca0a1dc86c208417cfd078cbdbdfe37ecd399 100644 (file)
--- a/src/impl-module.lisp
+++ b/src/impl-module.lisp
@@ -64,8 +64,20 @@ (defun build-module
     (name thunk &key (truename (probe-file name)) location)
   "Construct a new module.
 
-   This is the functionality underlying `define-module'."
-
+   This is the functionality underlying `define-module': see that macro for
+   full information."
+
+  ;; Check for an import cycle.
+  (when truename
+    (let ((existing (gethash truename *module-map*)))
+      (cond ((null existing))
+           ((eq (module-state existing) t)
+            (return-from build-module existing))
+           (t
+            (error "Module ~A already being imported at ~A"
+                   name (module-state existing))))))
+
+  ;; Construct the new module.
   (let ((*module* (make-instance 'module
                                 :name (pathname name)
                                 :state (file-location location))))
@@ -186,4 +198,51 @@ (defmacro define-fragment ((reason name) &body things)
                                                    (cons 'list constraint))
                                                  constraints))))))
 
+;;;--------------------------------------------------------------------------
+;;; File searching.
+
+(export '*module-dirs*)
+(defparameter *module-dirs* nil
+  "A list of directories (as pathname designators) to search for files.
+
+   Both SOD module files and Lisp extension files are searched for in this
+   list.  The search works by merging the requested pathname with each
+   element of this list in turn.  The list is prefixed by the pathname of the
+   requesting file, so that it can refer to other files relative to wherever
+   it was found.
+
+   See `find-file' for the grubby details.")
+
+(export 'find-file)
+(defun find-file (scanner name what thunk)
+  "Find a file called NAME on the module search path, and call THUNK on it.
+
+   The file is searched for relative to the SCANNER's current file, and also
+   in the directories mentioned in the `*module-dirs*' list.  If the file is
+   found, then THUNK is invoked with two arguments: the name we used to find
+   it (which might be relative to the starting directory) and the truename
+   found by `probe-file'.
+
+   If the file wasn't found, or there was some kind of error, then an error
+   is signalled; WHAT should be a noun phrase describing the kind of thing we
+   were looking for, suitable for inclusion in the error message.
+
+   While `find-file' establishes condition handlers for its own purposes,
+   THUNK is not invoked with any additional handlers defined."
+
+  (handler-case
+      (dolist (dir (cons (pathname (scanner-filename scanner)) *module-dirs*)
+              (values nil nil))
+       (let* ((path (merge-pathnames name dir))
+              (probe (probe-file path)))
+         (when probe
+           (return (values path probe)))))
+    (file-error (error)
+      (error "Error searching for ~A ~S: ~A" what (namestring name) error))
+    (:no-error (path probe)
+      (cond ((null path)
+            (error "Failed to find ~A ~S" what (namestring name)))
+           (t
+            (funcall thunk path probe))))))
+
 ;;;----- That's all, folks --------------------------------------------------