X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/3a774b55edfea441c1715994924c2999e9202143..6213be581b6fd4836c19af2f7970ecead5f8ae97:/src/module-impl.lisp diff --git a/src/module-impl.lisp b/src/module-impl.lisp index cb3a8ad..44aa0b8 100644 --- a/src/module-impl.lisp +++ b/src/module-impl.lisp @@ -73,9 +73,11 @@ (let ((existing (gethash truename *module-map*))) (cond ((null existing)) ((eq (module-state existing) t) + (when (plusp (module-errors existing)) + (error "Module `~A' contains errors" name)) (return-from build-module existing)) (t - (error "Module ~A already being imported at ~A" + (error "Module `~A' already being imported at ~A" name (module-state existing)))))) ;; Construct the new module. @@ -101,10 +103,14 @@ (progv (mapcar #'car *module-bindings-alist*) (module-variables module) - (unwind-protect (funcall thunk) - (setf (module-variables module) - (mapcar (compose #'car #'symbol-value) - *module-bindings-alist*))))) + (handler-bind ((error (lambda (cond) + (declare (ignore cond)) + (incf (slot-value module 'errors)) + :decline))) + (unwind-protect (funcall thunk) + (setf (module-variables module) + (mapcar (compose #'car #'symbol-value) + *module-bindings-alist*)))))) (defun call-with-temporary-module (thunk) "Invoke THUNK in the context of a temporary module, returning its values. @@ -146,16 +152,6 @@ ;;;-------------------------------------------------------------------------- ;;; Code fragments. -(export '(c-fragment c-fragment-text)) -(defclass c-fragment () - ((location :initarg :location :type file-location :reader file-location) - (text :initarg :text :type string :reader c-fragment-text)) - (:documentation - "Represents a fragment of C code to be written to an output file. - - A C fragment is aware of its original location, and will bear proper - `#line' markers when written out.")) - (defun output-c-excursion (stream location func) "Invoke FUNC surrounding it by writing #line markers to STREAM. @@ -232,10 +228,10 @@ See `find-file' for the grubby details.") (export 'find-file) -(defun find-file (scanner name what thunk) +(defun find-file (home 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 + The file is searched for relative to the HOME file or directory, 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 @@ -249,8 +245,7 @@ THUNK is not invoked with any additional handlers defined." (handler-case - (dolist (dir (cons (pathname (scanner-filename scanner)) *module-dirs*) - (values nil nil)) + (dolist (dir (cons home *module-dirs*) (values nil nil)) (let* ((path (merge-pathnames name dir)) (probe (probe-file path))) (when probe