ring->symbol (string-append name "?")))))
                      (unless (assq kw (available-optimizations))
                        (fail "Unknown optimization pass `~a'" name))
                      (return (list kw val))))
                  (cond
                   ((string=? arg "help")
                    (show-optimization-help)
                    (exit 0))
                   ((string->number arg)
                    => (lambda (level)
                         (unless (and (exact-integer? level) (<= 0 level 9))
                           (fail "Bad optimization level `~a'" level))
                         (alist-cons 'optimization-level level
                                     (alist-delete 'optimization-level result))))
                   ((string-prefix? "no-" arg)
                    (return-option (substring arg 3) #f))
                   (else
                    (return-option arg #t)))))
	(option '(#\f "from") #t #f
		(lambda (opt name arg result)
                  (if (assoc-ref result 'from)
                      (fail "`--from' option cannot be specified more than once")
                      (alist-cons 'from (string->symbol arg) result))))
	(option '(#\t "to") #t #f
		(lambda (opt name arg result)
                  (if (assoc-ref result 'to)
                      (fail "`--to' option cannot be specified more than once")
                      (alist-cons 'to (string->symbol arg) result))))
        (option '(#\T "target") #t #f
                (lambda (opt name arg result)
                  (if (assoc-ref result 'target)
                      (fail "`--target' option cannot be specified more than once")
                      (alist-cons 'target arg result))))))

(define (parse-args args)
  "Parse argument list @var{args} and return an alist with all the relevant
options."
  (args-fold args %options
             (lambda (opt name arg result)
               (format (current-error-port) "~A: unrecognized option~%" name)
	       (exit 1))
             (lambda (file result)
	       (let ((input-files (assoc-ref result 'input-files)))
		 (alist-cons 'input-files (cons file input-files)
			     result)))

	     ;; default option values
             `((input-files)
	       (load-path)
               (warning-level . ,(default-warning-level))
               (optimization-level . ,(default-optimization-level))
               (warnings unsupported-warning))))

(define (show-version)
  (format #t "compile (GNU Guile) ~A~%" (version))
  (format #t "Copyright (C) 2024 Free Software Foundation, Inc.
License LGPLv3+: GNU LGPL version 3 or later <http://gnu.org/licenses/lgpl.html>.
This is free software: you are free to change and redistribute it.
There is NO WARRANTY, to the extent permitted by law.~%"))

(define (show-warning-help)
  (format #t "The available warning types are:~%~%")
  (for-each (lambda (wt)
              (format #t "  ~22A ~A~%"
                      (format #f "`~A'" (warning-type-name wt))
                      (warning-type-description wt)))
            %warning-types)
  (format #t "~%")
  (format #t "You may also specify warning levels as `-W0`, `-W1',~%")
  (format #t "`-W2', or `-W3'.  The default is `-W1'.~%"))

(define (show-optimization-help)
  (format #t "The available optimizations are:~%~%")
  (let lp ((options (available-optimizations)))
    (match options
      (() #t)
      (((kw level) . options)
       (let ((name (string-trim-right (symbol->string (keyword->symbol kw))
                                      #\?)))
         (format #t "  -O~a~%" name)
         (lp options)))))
  (format #t "~%")
  (format #t "To disable an optimization, prepend it with `no-', for example~%")
  (format #t "`-Ono-cse.'~%~%")
  (format #t "You may also specify optimization levels as `-O0', `-O1',~%")
  (format #t "`-O2', or `-O3'.  Currently `-O0' turns off all optimizations,~%")
  (format #t "`-O1' turns on partial evaluation, and `-O2' and `-O3' turn on~%")
  (format #t "everything.  The default is equivalent to `-O2'.")
  (format #t "~%"))

