;;;----- Licensing notice ---------------------------------------------------
;;;
-;;; This file is part of the Sensble Object Design, an object system for C.
+;;; This file is part of the Sensible Object Design, an object system for C.
;;;
;;; SOD is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; along with SOD; if not, write to the Free Software Foundation,
;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-(cl:in-package #:sod)
+(cl:defpackage #:sod-frontend
+ (:use #:common-lisp #:optparse #:sod #:sod-parser)
+ (:shadowing-import-from #:optparse #:int))
+
+(cl:in-package #:sod-frontend)
+
+;;;--------------------------------------------------------------------------
+;;; Preparation for dumping.
+
+(clear-the-decks)
+(exercise)
;;;--------------------------------------------------------------------------
;;; The main program.
;; 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))
;; Option definitions.
(define-program
:help "Process SOD input files to produce (e.g.) C output."
- :version "0.1.0"
+ :version *sod-version*
:usage "SOURCES..."
:options (options
(help-options :short-version #\V)
- "Crazy options"
+ "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))
(or builtinsp args))
(die-usage))
- ;; Prepare the builtins.
- (make-builtin-module)
-
;; 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 we're writing the builtin module then now seems like a
- ;; good time to do that.
- (when builtinsp
- (clear-the-decks)
- (hack-module *builtin-module*))
-
- ;; Parse and write out the remaining modules.
- (dolist (arg args)
- (clear-the-decks)
- (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 --------------------------------------------------
~mdw / sod / blobdiff