debian/: Ship `symbols' file for better downstream dependency versioning.

[sod] / src / frontend.lisp

diff --git a/src/frontend.lisp b/src/frontend.lisp
index 06311a3..92573e7 100644 (file)
--- a/src/frontend.lisp
+++ b/src/frontend.lisp
@@ -23,9 +23,10 @@
 ;;; along with SOD; if not, write to the Free Software Foundation,
 ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 
-(cl:defpackage #:sod-frontend
-  (:use #:common-lisp #:sod-utilities #:optparse #:sod #:sod-parser)
-  (:shadowing-import-from #:optparse #:int))
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (handler-bind ((warning #'muffle-warning))
+    (cl:defpackage #:sod-frontend
+      (:use #:common-lisp #:sod-utilities #:optparse #:sod #:sod-parser))))
 
 (cl:in-package #:sod-frontend)
 
@@ -77,6 +78,15 @@
 (defun update-usage ()
   (setf *usage* (simple-usage *options* "SOURCES...")))
 
+(export 'augment-options)
+(defun augment-options (options)
+  "Add OPTIONS to the program's options list."
+  (asetf *options* (append it options))
+  (setf (op-options *option-parser*) *options*)
+  (update-usage))
+
+(use-package "SOD-FRONTEND" "SOD-USER")
+
 (export 'main)
 (defun main ()
 
@@ -89,6 +99,7 @@
        (backtracep nil)
        (builtinsp nil)
        (stdoutp nil)
+       (track-deps-p nil)
        (args nil))
 
     ;; Option definitions.
@@ -110,6 +121,35 @@
                (#\d "directory" (:arg "DIR")
                     ("Write output files to DIR.")
                     (dirpath output-path))
+               (#\e "eval" (:arg "LISP")
+                    ("Evaluate raw Lisp code.")
+                    (lambda (lisp)
+                      (handler-case
+                          (let ((*package* (find-package "SOD-USER")))
+                            (eval (read-from-string lisp)))
+                        (error (error)
+                          (option-parse-error "~A" error)))))
+               (#\l "load" (:arg "FILE")
+                    ("Load a file of Lisp code.")
+                    (lambda (file)
+                      (let ((file (merge-pathnames file
+                                                   (make-pathname
+                                                    :type "LISP"
+                                                    :case :common))))
+                        (handler-case
+                            (let ((*package* (find-package "SOD-USER")))
+                              (find-file *default-pathname-defaults* file
+                                         "Lisp file"
+                                         (lambda (path true)
+                                           (declare (ignore path))
+                                           (load true
+                                                 :verbose nil
+                                                 :print nil))))
+                          (error (error)
+                            (option-parse-error "~A" error))))))
+               (#\M "track-dependencies"
+                    "Write make(1) fragments recording dependencies."
+                    (set track-deps-p))
                (#\p "stdout"
                     ("Write output files to standard output.")
                     (set stdoutp))
@@ -136,37 +176,30 @@
 
                 ;; 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))
+
+                       (when track-deps-p
+                         (write-dependency-file module reason
+                                                output-path))))
 
                   ;; Error recovery.
                   (continue ()