;;;----- 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 #:sod-utilities #:optparse #:sod #:sod-parser)
+ (:shadowing-import-from #:optparse #:int))
+
+(cl:in-package #:sod-frontend)
+
+;;;--------------------------------------------------------------------------
+;;; Preparation for dumping.
+
+(clear-the-decks)
+(exercise)
;;;--------------------------------------------------------------------------
;;; 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
+ and no file component, suitable for merging."
+
+ ;; This is really fiddly and annoying. Unix pathnames don't tell you
+ ;; whether the thing named is meant to be a directory or not, and
+ ;; implementations differ as to how they cope with pathnames which do or
+ ;; don't name directories when they're expecting files, or vice versa.
+
+ (let ((path (ignore-errors (pathname arg))))
+ (cond ((null path)
+ ;; The namestring couldn't be parsed, or something else went
+ ;; horribly wrong.
+
+ (option-parse-error "Can't parse `~A' as a path" arg))
+
+ #+unix
+ ((or (pathname-name path) (pathname-type path))
+ ;; If this is Unix, or similar, then stick the filename piece on
+ ;; the end of the directory and hope that was sensible.
+
+ (setf var (make-pathname
+ :name nil :type nil :defaults path
+ :directory (append (or (pathname-directory path)
+ (list :relative))
+ (list (file-namestring path))))))
+
+ (t
+ ;; This actually looks like a plain directory name.
+
+ (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 ()
+
+ ;; Initialize the argument parser.
(set-command-line-arguments)
- (define-program
- :help "Probably ought to write this."
- :version "0.1.0"
- :usage nil
- :options (options
- (help-options :short-version #\V)
- "Crazy options"
- ))
-
- (unless (option-parse-try
- (do-options ()
- (nil (rest)
- (format t "My arguments are ~S~%" rest))))
- (die-usage))
- (exit))
+ ;; Collect information from the command line options.
+ (let ((output-reasons nil)
+ (output-path (make-pathname :directory '(:relative)))
+ (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*
+ :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))
+ (#\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.
+ (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)
+ ;; 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))
+ (exit (if (plusp nerror) 2 0)))))))
;;;----- That's all, folks --------------------------------------------------
~mdw / sod / blobdiff