;;; 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)
;;;--------------------------------------------------------------------------
;;; 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
(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 ()
(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"
(#\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)
;; 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 ()
;; 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)
~mdw / sod / blobdiff