X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/1d8cc67a3f4ded443f5efc673a616883cbae9c50..9ec578d9fe450b7e7f9030dc9d930185593aa991:/src/frontend.lisp

diff --git a/src/frontend.lisp b/src/frontend.lisp
index b1fb0d9..5430285 100644
--- a/src/frontend.lisp
+++ b/src/frontend.lisp
@@ -28,24 +28,160 @@
 ;;;--------------------------------------------------------------------------
 ;;; The main program.
 
+(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))))))
+
 (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)))
+	(builtinsp nil)
+	(stdoutp nil)
+	(args nil))
+
+    ;; Option definitions.
+    (define-program
+      :help "Probably ought to write this."
+      :version "0.1.0"
+      :usage "SOURCES..."
+      :options (options
+		(help-options :short-version #\V)
+		"Crazy options"
+		(#\I "include" (:arg "DIR")
+		     ("Search DIR for module imports.")
+		     (list *module-dirs* 'string))
+		("builtins"
+		     ("Process the builtin `sod-base' module.")
+		     (set builtinsp))
+		(#\d "directory" (:arg "DIR")
+		     ("Write output files to DIR.")
+		     (dirpath output-path))
+		(#\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))))
+
+    ;; Actually parse the options.
+    (unless (and (option-parse-try
+		   (do-options ()
+		     (nil (rest)
+			  (setf args rest))))
+		 (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)))))
 
 ;;;----- That's all, folks --------------------------------------------------