X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/sod/blobdiff_plain/dea4d05507e59ab779ed4bb209e05971d87e260c..bf090e021a5c20da452a4841cdfb8eb78e29544e:/src/impl-module.lisp?ds=inline

diff --git a/src/impl-module.lisp b/src/impl-module.lisp
index 8349b85..753ca0a 100644
--- 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 --------------------------------------------------