X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/284f1fa2ace3e276052ff1bd7d66442500e693da..2c6153373f927d948a74b283ebb16330af8ee49a:/src/frontend.lisp

diff --git a/src/frontend.lisp b/src/frontend.lisp
index a4625f7..92573e7 100644
--- 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 #: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)
 
@@ -38,6 +39,9 @@
 ;;;--------------------------------------------------------------------------
 ;;; The main program.
 
+(defvar-unbound *option-parser*
+  "The program's main option parser.")
+
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defopthandler dirpath (var arg) ()
     "Convert the argument into a pathname with a directory component
@@ -71,6 +75,18 @@
 
 	     (setf var path))))))
 
+(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 ()
 
@@ -83,13 +99,13 @@
 	(backtracep nil)
 	(builtinsp nil)
 	(stdoutp nil)
+	(track-deps-p nil)
 	(args nil))
 
     ;; Option definitions.
     (define-program
       :help "Process SOD input files to produce (e.g.) C output."
       :version *sod-version*
-      :usage "SOURCES..."
       :options (options
 		(help-options :short-version #\V)
 		"Translator options"
@@ -105,20 +121,51 @@
 		(#\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))
 		(#\t "type" (:arg "OUT-TYPE")
 		     ("Produce output of type OUT-TYPE.")
 		     (list output-reasons 'keyword))))
+    (update-usage)
 
     ;; Actually parse the options.
-    (unless (and (option-parse-try
-		   (do-options ()
-		     (nil (rest)
-			  (setf args rest))))
-		 (or builtinsp args))
-      (die-usage))
+    (let ((*option-parser* (make-option-parser)))
+      (unless (and (option-parse-try
+		     (do-options (:parser *option-parser*)
+		       (nil (rest)
+			    (setf args rest))))
+		   (or builtinsp args))
+	(die-usage)))
 
     ;; Do the main parsing job.
     (labels ((hack-module (module)
@@ -129,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 ()
@@ -182,7 +222,9 @@
 
 	       ;; Parse and write out the remaining modules.
 	       (dolist (arg args)
-		 (hack-module (read-module arg)))))
+		 (let ((module (read-module arg)))
+		   (when (zerop (module-errors module))
+		     (hack-module module))))))
 
       (if backtracep (hack-modules)
 	  (multiple-value-bind (hunoz nerror nwarn)