X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/1645e4335e58ef3a8f1cafb1834e93760d80d9ae..ae7a3c8fb42e457933efbbb9127d5a745096825a:/src/module-impl.lisp diff --git a/src/module-impl.lisp b/src/module-impl.lisp index ba04397..2626726 100644 --- a/src/module-impl.lisp +++ b/src/module-impl.lisp @@ -56,8 +56,10 @@ ;;;-------------------------------------------------------------------------- ;;; Module objects. -(defparameter *module-map* (make-hash-table :test #'equal) +(defvar-unbound *module-map* "Hash table mapping true names to module objects.") +(define-clear-the-decks reset-module-map + (setf *module-map* (make-hash-table :test #'equal))) (defun build-module (name thunk &key (truename (probe-file name)) location) @@ -154,29 +156,35 @@ A C fragment is aware of its original location, and will bear proper #line markers when written out.")) -(defun output-c-excursion (stream location thunk) - "Invoke THUNK surrounding it by writing #line markers to STREAM. +(defun output-c-excursion (stream location func) + "Invoke FUNC surrounding it by writing #line markers to STREAM. The first marker describes LOCATION; the second refers to the actual output position in STREAM. If LOCATION doesn't provide a line number then no markers are output after all. If the output stream isn't - position-aware then no final marker is output." - - (let* ((location (file-location location)) - (line (file-location-line location)) - (filename (file-location-filename location))) - (cond (line - (when (typep stream 'position-aware-stream) - (format stream "~&#line ~D~@[ ~S~]~%" line filename)) - (funcall thunk) - (when (typep stream 'position-aware-stream) - (fresh-line stream) - (format stream "~&#line ~D ~S~%" - (1+ (position-aware-stream-line stream)) - (let ((path (stream-pathname stream))) - (if path (namestring path) ""))))) - (t - (funcall thunk))))) + position-aware then no final marker is output. + + FUNC is passed the output stream as an argument. Complicated games may be + played with interposed streams. Try not to worry about it." + + (flet ((doit (stream) + (let* ((location (file-location location)) + (line (file-location-line location)) + (filename (file-location-filename location))) + (cond (line + (when (typep stream 'position-aware-stream) + (format stream "~&#line ~D~@[ ~S~]~%" line filename)) + (funcall func stream) + (when (typep stream 'position-aware-stream) + (fresh-line stream) + (format stream "#line ~D ~S~%" + (1+ (position-aware-stream-line stream)) + (let ((path (stream-pathname stream))) + (if path (namestring path) + ""))))) + (t + (funcall func stream)))))) + (print-ugly-stuff stream #'doit))) (defmethod print-object ((fragment c-fragment) stream) (let ((text (c-fragment-text fragment)) @@ -191,7 +199,7 @@ (prin1 (subseq text 0 37) stream) (write-string "..." stream)))) (output-c-excursion stream location - (lambda () (write-string text stream)))))) + (lambda (stream) (write-string text stream)))))) (defmethod make-load-form ((fragment c-fragment) &optional environment) (make-load-form-saving-slots fragment :environment environment))