summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2009-02-21 00:36:29 +0100
committerLudovic Courtès <ludo@gnu.org>2009-02-21 00:38:06 +0100
commit73f4d8d1d21fce623fd3b13ba3ef56a4548fe2c7 (patch)
tree0a565e25495bcc807ea699e0b55a0ef35d889600
parent3bef3ae42886d910c43655792ecd9cfdc73ba886 (diff)
downloadguile-73f4d8d1d21fce623fd3b13ba3ef56a4548fe2c7.tar.gz
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'.
-rw-r--r--module/system/base/compile.scm5
-rwxr-xr-xscripts/compile27
2 files changed, 27 insertions, 5 deletions
diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm
index 0d08064ac..86e398ecc 100644
--- 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 15160cdcd..6651722f0 100755
--- 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))
+(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