lib/keyword.c (kw_parseempty): Use correct variable scanning `kwval' list.

[sod] / src / frontend.lisp

diff --git a/src/frontend.lisp b/src/frontend.lisp
index 68c8a9631eab5f6161629fd0603c55d89566e147..a00a8bbbb35dc4c34e3a14561406a0f9acfe9a17 100644 (file)
--- a/src/frontend.lisp
+++ b/src/frontend.lisp
@@ -23,21 +23,19 @@
 ;;; along with SOD; if not, write to the Free Software Foundation,
 ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 
 ;;; 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)
 
 
 (cl:in-package #:sod-frontend)
 

-;;;--------------------------------------------------------------------------
-;;; Preparation for dumping.
-
-(clear-the-decks)
-(exercise)
-

 ;;;--------------------------------------------------------------------------
 ;;; The main program.
 
 ;;;--------------------------------------------------------------------------
 ;;; 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
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defopthandler dirpath (var arg) ()
     "Convert the argument into a pathname with a directory component


@@ -71,6 +69,18 @@   (defopthandler dirpath (var arg) ()
 
             (setf var path))))))
 
 
             (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 ()
 
 (export 'main)
 (defun main ()
 


@@ -80,117 +90,152 @@ (defun main ()
   ;; Collect information from the command line options.
   (let ((output-reasons nil)
        (output-path (make-pathname :directory '(:relative)))
   ;; Collect information from the command line options.
   (let ((output-reasons nil)
        (output-path (make-pathname :directory '(:relative)))

+       (backtracep nil)

        (builtinsp nil)
        (stdoutp 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*
        (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"
                (#\I "include" (:arg "DIR")
                     ("Search DIR for module imports.")
                     (list *module-dirs* 'string))
       :options (options
                (help-options :short-version #\V)
                "Translator options"
                (#\I "include" (:arg "DIR")
                     ("Search DIR for module imports.")
                     (list *module-dirs* 'string))

+               ("backtrace"
+                    ("Print a Lisp backtrace on error (for debugging).")
+                    (set backtracep))

                ("builtins"
                     ("Process the builtin `sod-base' module.")
                     (set builtinsp))
                (#\d "directory" (:arg "DIR")
                     ("Write output files to DIR.")
                     (dirpath output-path))
                ("builtins"
                     ("Process the builtin `sod-base' module.")
                     (set builtinsp))
                (#\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"))
+                                (token (cons 'token nil)))
+                            (with-input-from-string (in lisp)
+                              (loop (let ((form (read in nil token)))
+                                      (when (eq form token) (return))
+                                      (eval form)))))
+                        (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))))
                (#\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.
 
     ;; 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.
 
     ;; Do the main parsing job.

-    (multiple-value-bind (hunoz nerror nwarn)
-       (count-and-report-errors ()
-         (with-default-error-location ((make-file-location *program-name*))
-
-           (flet ((hack-module (module)
-                    ;; Process the MODULE, writing out the generated code.
-
-                    ;; Work through each output type in turn.
-                    (dolist (reason output-reasons)
-
-                      ;; 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))))
-
-                        ;; Error recovery.
-                        (continue ()
-                          :report (lambda (stream)
-                                    (format stream
-                                            "Skip output type `~(~A~)'"
-                                            reason))
-                          nil)))))
-
-             ;; If there are no output types then there's nothing to do.
-             (unless output-reasons
-               (error "No output types given: nothing to do"))
-
-             ;; If we're writing the builtin module then now seems like a
-             ;; good time to do that.
-             (when builtinsp
-               (hack-module *builtin-module*))
-
-             ;; Parse and write out the remaining modules.
-             (dolist (arg args)
-               (hack-module (read-module arg))))))
-
-      ;; Report on how well everything worked.
-      (declare (ignore hunoz))
-      (when (or (plusp nerror) (plusp nwarn))
-       (format *error-output* "~A: Finished with~
-                               ~[~:; ~:*~D error~:P~[~:; and~]~:*~]~
-                               ~[~:; ~:*~D warning~:P~]~%"
-               *program-name* nerror nwarn))
-
-      ;; Exit with a sensible status.
-      (exit (if (plusp nerror) 2 0)))))
+    (labels ((hack-module (module)
+              ;; Process the MODULE, writing out the generated code.
+
+              ;; Work through each output type in turn.
+              (dolist (reason output-reasons)
+
+                ;; Arrange to be able to recover from errors.
+                (restart-case
+                    (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 ()
+                    :report (lambda (stream)
+                              (format stream
+                                      "Skip output type `~(~A~)'"
+                                      reason))
+                    nil))))
+
+            (hack-modules ()
+
+              ;; If there are no output types then there's nothing to do.
+              (unless output-reasons
+                (error "No output types given: nothing to do"))
+
+              ;; If we're writing the builtin module then now seems like a
+              ;; good time to do that.
+              (when builtinsp
+                (hack-module *builtin-module*))
+
+              ;; Parse and write out the remaining modules.
+              (dolist (arg args)
+                (let ((module (read-module arg)))
+                  (when (zerop (module-errors module))
+                    (hack-module module))))))
+
+      (if backtracep (hack-modules)
+         (multiple-value-bind (hunoz nerror nwarn)
+             (count-and-report-errors ()
+               (with-default-error-location
+                   ((make-file-location *program-name*))
+                 (hack-modules)))
+           (declare (ignore hunoz))
+           (when (or (plusp nerror) (plusp nwarn))
+             (format *error-output* "~A: Finished with~
+                                     ~[~:; ~:*~D error~:P~[~:; and~]~:*~]~
+                                     ~[~:; ~:*~D warning~:P~]~%"
+                     *program-name* nerror nwarn))
+           (uiop:quit (if (plusp nerror) 2 0)))))))

 
 ;;;----- That's all, folks --------------------------------------------------
 
 ;;;----- That's all, folks --------------------------------------------------