src/module-output.lisp: Introduce `module-output-file'.

[sod] / src / frontend.lisp

diff --git a/src/frontend.lisp b/src/frontend.lisp
index 2d20fbc762a5ed97bea961ea0c2be1b4f82c6d74..1d0938250cc9f4726f3aa155ef11b7c44302be05 100644 (file)
--- a/src/frontend.lisp
+++ b/src/frontend.lisp
@@ -171,37 +171,26 @@     (define-program
 
                 ;; Arrange to be able to recover from errors.
                 (restart-case
-
-                    ;; Collect information for constructing the output
-                    ;; filenames here.  In particular,
-                    ;; `output-type-pathname' will sanity-check the
-                    ;; output type for us, which is useful even if
-                    ;; we're writing to stdout.
-                    (let ((outpath (output-type-pathname reason))
-                          (modpath (module-name module)))
-
-                      (if stdoutp
-
-                          ;; If we're writing to stdout then just do
-                          ;; that.
-                          (output-module module reason
-                                         *standard-output*)
-
-                          ;; Otherwise we have to construct an output
-                          ;; filename the hard way.
-                          (with-open-file
-                              (stream
-                               (reduce #'merge-pathnames
-                                       (list output-path
-                                             outpath
-                                             (make-pathname
-                                              :directory nil
-                                              :defaults modpath))
-                                       :from-end t)
-                               :direction :output
-                               :if-exists :supersede
-                               :if-does-not-exist :create)
-                            (output-module module reason stream))))
+                    (cond
+
+                      (stdoutp
+                       ;; If we're writing to stdout then use
+                       ;; `output-type-pathname' to check the output type
+                       ;; for us.
+
+                       (output-type-pathname reason)
+                       (output-module module reason *standard-output*))
+
+                      (t
+                       ;; Otherwise we have to construct an output
+                       ;; filename the hard way.
+                       (with-open-file
+                           (stream
+                            (module-output-file module reason output-path)
+                            :direction :output
+                            :if-exists :supersede
+                            :if-does-not-exist :create)
+                         (output-module module reason stream))))
 
                   ;; Error recovery.
                   (continue ()