diff options
author | Ludovic Courtès <ludo@gnu.org> | 2009-02-21 00:36:29 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2009-02-21 00:38:06 +0100 |
commit | 73f4d8d1d21fce623fd3b13ba3ef56a4548fe2c7 (patch) | |
tree | 0a565e25495bcc807ea699e0b55a0ef35d889600 | |
parent | 3bef3ae42886d910c43655792ecd9cfdc73ba886 (diff) | |
download | guile-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.scm | 5 | ||||
-rwxr-xr-x | scripts/compile | 27 |
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 |