Add `-o'/`--output' option to "guile-tools compile".

* module/system/base/compile.scm (compile-file): Add optional
  OUTPUT-FILE argument.

* scripts/compile (fail): New procedure.
  (%options): Add `-o'/`--output' option.
  (compile): Handle `-o'.

diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm
index 0d08064..86e398e 100644 (file)
--- a/module/system/base/compile.scm
+++ b/module/system/base/compile.scm
@@ -88,8 +88,9 @@
       x
       (lookup-language x)))
 
-(define* (compile-file file #:key (to 'objcode) (opts '()))
-  (let ((comp (compiled-file-name file))
+(define* (compile-file file #:optional output-file
+                           #:key (to 'objcode) (opts '()))
+  (let ((comp (or output-file (compiled-file-name file)))
         (lang (ensure-language (current-language)))
         (to (ensure-language to)))
     (catch 'nothing-at-all

diff --git a/scripts/compile b/scripts/compile
index 15160cd..6651722 100755 (executable)
--- a/scripts/compile
+++ b/scripts/compile
@@ -37,10 +37,16 @@ exec ${GUILE-guile} -e '(@ (scripts compile) compile)' -s $0 "$@"
 (define-module (scripts compile)
   #:use-module ((system base compile) #:select (compile-file))
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-13)
   #:use-module (srfi srfi-37)
   #:export (compile))
 
 \f
+(define (fail . messages)
+  (format (current-error-port)
+         (string-concatenate `("error: " ,@messages "~%")))
+  (exit 1))
+
 (define %options
   ;; Specifications of the command-line options.
   (list (option '(#\h "help") #f #f
@@ -52,6 +58,12 @@ exec ${GUILE-guile} -e '(@ (scripts compile) compile)' -s $0 "$@"
                  (let ((load-path (assoc-ref result 'load-path)))
                    (alist-cons 'load-path (cons arg load-path)
                                result))))
+       (option '(#\o "output") #t #f
+               (lambda (opt name arg result)
+                 (if (assoc-ref result 'output-file)
+                     (fail "`-o' option cannot be specified more than once")
+                     (alist-cons 'output-file arg result))))
+
        (option '(#\O "optimize") #f #f
                (lambda (opt name arg result)
                  (alist-cons 'optimize? #t result)))
@@ -90,6 +102,7 @@ options."
          (translate-only? (assoc-ref options 'translate-only?))
          (compile-only?   (assoc-ref options 'compile-only?))
         (input-files     (assoc-ref options 'input-files))
+        (output-file     (assoc-ref options 'output-file))
         (load-path       (assoc-ref options 'load-path)))
     (if (or help? (null? input-files))
         (begin
@@ -99,6 +112,8 @@ Compile each Guile Scheme source file FILE into a Guile object.
   -h, --help           print this help message
 
   -L, --load-path=DIR  add DIR to the front of the module load path
+  -o, --output=OFILE   write output to OFILE
+
   -O, --optimize       turn on optimizations
   -e, --expand-only    only go through the code expansion stage
   -t, --translate-only stop after the translation to GHIL
@@ -113,9 +128,15 @@ Report bugs to <guile-user@gnu.org>.~%")
                                 (if expand-only? '(#:e) '())
                                 (if translate-only? '(#:t) '())
                                 (if compile-only? '(#:c) '()))))
-      (for-each (lambda (file)
-                  (apply compile-file file compile-opts))
-                input-files))))
+      (if output-file
+         (if (and (not (null? input-files))
+                  (null? (cdr input-files)))
+             (compile-file (car input-files) output-file)
+             (fail "`-o' option can only be specified "
+                   "when compiling a single file"))
+         (for-each (lambda (file)
+                     (apply compile-file file compile-opts))
+                   input-files)))))
 
 ;;; Local Variables:
 ;;; coding: latin-1