From ba8bae5fe1f190d4a61a4ab63b52725bc0e07c9b Mon Sep 17 00:00:00 2001 From: Mark Wooding Date: Tue, 15 Dec 2015 15:44:25 +0000 Subject: [PATCH] src/frontend.lisp: Add `--backtrace' option to expose error context. Skips the usual fancy error reporting. Useful when debugging. --- src/frontend.lisp | 155 ++++++++++++++++++++++++++++-------------------------- src/sod.1 | 8 +++ 2 files changed, 88 insertions(+), 75 deletions(-) diff --git a/src/frontend.lisp b/src/frontend.lisp index 68c8a96..a4625f7 100644 --- a/src/frontend.lisp +++ b/src/frontend.lisp @@ -80,6 +80,7 @@ ;; Collect information from the command line options. (let ((output-reasons nil) (output-path (make-pathname :directory '(:relative))) + (backtracep nil) (builtinsp nil) (stdoutp nil) (args nil)) @@ -95,6 +96,9 @@ (#\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)) @@ -117,80 +121,81 @@ (die-usage)) ;; 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 + + ;; 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)))) + + (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) + (hack-module (read-module arg))))) + + (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)) + (exit (if (plusp nerror) 2 0))))))) ;;;----- That's all, folks -------------------------------------------------- diff --git a/src/sod.1 b/src/sod.1 index 01168f4..5474bda 100644 --- a/src/sod.1 +++ b/src/sod.1 @@ -85,6 +85,14 @@ and exit successfully. Write a brief usage message to standard output, and exit successfully. .TP +.B "\-\-backtrace" +Generate a Lisp stack backtrace if an error is encountered. +This is useful when debugging, +if +.B sod +reports unusual errors, or +is complaining unjustifiably about something. +.TP .B "\-\-builtins" Generate output for to the built-in module, which defines the root classes -- 2.11.0