68 lines
2.8 KiB
Common Lisp
68 lines
2.8 KiB
Common Lisp
(in-package #:user-side-compiler)
|
|
|
|
(defparameter *batch-arguments*
|
|
'(("-o" "--output" " <file>" "Output generated code into <file>." :output)
|
|
(nil "--print-ir" " <final|all|original|optimized>" "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 option := nil
|
|
:for arg :in arguments
|
|
: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 :show-help-p) t)
|
|
(loop-finish))))
|
|
options))
|
|
|
|
(defun batch-help ()
|
|
(format t "Usage: c6lc [options] <input file>~%")
|
|
(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 show-version-p)
|
|
(batch-parse-options (uiop:command-line-arguments))
|
|
(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
|
|
:compression t))
|