diff --git a/wip-duuqnd/user-side-compiler/binary-test-build.lisp b/wip-duuqnd/user-side-compiler/binary-test-build.lisp index 3edec4e..e49297c 100644 --- a/wip-duuqnd/user-side-compiler/binary-test-build.lisp +++ b/wip-duuqnd/user-side-compiler/binary-test-build.lisp @@ -1,31 +1,67 @@ (in-package #:user-side-compiler) +(defparameter *batch-arguments* + '(("-o" "--output" " " "Output generated code into ." :output) + (nil "--print-ir" " " "Print specified IR instructions.") + ("-h" "--help" "" "Display this help message." :show-help-p) + ("-v" "--version" "" "Display the program's version." :show-version-p))) + (defun batch-parse-options (arguments) (let ((options '())) - (loop :with outputp := nil + (loop :with option := nil :for arg :in arguments - :do (cond (outputp - (setf (getf options :output) arg - outputp nil)) - ((or (string= arg "-o") (string= arg "--output")) - (setf outputp t)) - ((or (string= arg "-h") (string= arg "--help")) - (setf (getf options :show-help-p) t)) + :do (cond (option + (setf (getf options option) arg + option nil)) + ((and (char/= (char arg 0) #\-) + (null (getf options :input))) + (setf (getf options :input) arg)) + ((char= (char arg 0) #\-) + (let ((option-definition + (or (find arg *batch-arguments* :key #'first + :test #'string=) + (find arg *batch-arguments* :key #'second + :test #'string=)))) + (if option-definition + (setf option (fifth option-definition)) + (progn + (format t "Unknown option \"~A\"~%" arg) + (setf (getf options :show-help-p) t))))) (t - (setf (getf options :input) arg)))) + (setf (getf options :show-help-p) t) + (loop-finish)))) options)) +(defun batch-help () + (format t "Usage: c6lc [options] ~%") + (format t "Options:~%") + (loop :for (short long post message key) + :in *batch-arguments* + :do (if (null short) + (format t "~A~A~44T~A~%" long post message) + (format t "~A~A / ~A~A~44T~A~%" short post long post message)))) + +(defun batch-version () + (format t "Using c6lc v~A~%" + #.(asdf:component-version (asdf:find-system '#:user-side-compiler)))) + (defun batch-main () - (destructuring-bind (&key input output show-help-p) + (destructuring-bind (&key input output show-help-p show-version-p) (batch-parse-options (uiop:command-line-arguments)) - (if show-help-p - (progn - (format t "Usage: c6lc [-o ] ~%") - (sb-ext:exit :code -1)) - (batch-compile input output)))) + (cond ((or show-help-p + (every #'null (list input output show-help-p show-version-p))) + (batch-help)) + (show-version-p + (batch-version)) + (t + (restart-case + (batch-compile input output) + (abort () + (sb-ext:exit :code -1))))))) (defun build () (assert (not (member :swank *features*))) + (usc-init) (sb-ext:save-lisp-and-die "c6lc" :toplevel #'batch-main :executable t :save-runtime-options t :root-structures 'batch-main diff --git a/wip-duuqnd/user-side-compiler/interface.lisp b/wip-duuqnd/user-side-compiler/interface.lisp index 91b711e..0f50e55 100644 --- a/wip-duuqnd/user-side-compiler/interface.lisp +++ b/wip-duuqnd/user-side-compiler/interface.lisp @@ -155,20 +155,26 @@ (when return-allocs-p (list :allocs allocs)) (when return-asm-p (list :asm asm-obj)))))) -(defun batch-compile (input-filepath &optional output-filepath) - (usc-init) - (setf input-filepath (probe-file input-filepath)) - (assert (pathnamep input-filepath)) +(defun batch-compile (input-filepath output-filepath &rest compile-args) + (when (null input-filepath) + (format t "Missing path to input source file.~%") + (abort)) (when (null output-filepath) (setf output-filepath (make-pathname :name (pathname-name input-filepath) :type "bin"))) - (unless (string= "bin" (pathname-type output-filepath)) - (format t "To avoid overwriting files incorrectly, output files must end in \".bin\".") + (setf output-filepath + (parse-namestring output-filepath nil + *default-pathname-defaults* + :junk-allowed t)) + (when (null output-filepath) + (setf output-filepath (make-pathname :name (pathname-name input-filepath) + :type "bin"))) + (unless (equal "bin" (pathname-type output-filepath)) + (format t "To avoid overwriting files incorrectly, output files must end in \".bin\".~%") #-swank (sb-ext:exit :code -1) #+swank (abort)) - (assert (pathnamep output-filepath)) (handler-bind ((missing-function-error (lambda (c) (format t "Encountered unknown function \"~A\". Dummy created.~%" @@ -183,18 +189,28 @@ (sb-ext:exit :code 65) #+swank (abort c))) + (file-error + (lambda (c) + (format t "~A~%" c) + (abort c))) + (sb-int:stream-decoding-error + (lambda (c) + (format t "Tried to read text from a file which is not UTF-8.~%~%~A~%" c) + (abort c))) (error (lambda (c) (format t "---- COMPILER BUG ----~%") (format t "An UNHANDLED error was encountered during compilation.~%~%") (trivial-backtrace:print-backtrace c) - (format t "Please contact Duuqnd (duuqnd@stacken.kth.se).~%") + (format t "You may be elligible to win one (1) item from Stackomaten!~%") + (format t "Please send this whole output text to duuqnd@stacken.kth.se to claim your prize.~%") #-swank (sb-ext:exit :code 70) #+swank (abort c)))) - (let ((bytes (compile-string-to-bytes - (uiop:read-file-string input-filepath)))) + (let ((bytes (apply #'compile-string-to-bytes + (uiop:read-file-string input-filepath) + compile-args))) (with-open-file (stream output-filepath :direction :output :element-type '(unsigned-byte 8) :if-exists :supersede) diff --git a/wip-duuqnd/user-side-compiler/user-side-compiler.asd b/wip-duuqnd/user-side-compiler/user-side-compiler.asd index 16a53bf..0d44330 100644 --- a/wip-duuqnd/user-side-compiler/user-side-compiler.asd +++ b/wip-duuqnd/user-side-compiler/user-side-compiler.asd @@ -2,6 +2,7 @@ (defsystem #:user-side-compiler :serial t + :version "0.1.0" :depends-on (#:closer-mop #:alexandria #:trivial-backtrace) :in-order-to ((asdf:test-op (asdf:test-op #:user-side-compiler/test))) :components