mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

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

Browse source 
* 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'.
This commit is contained in:
Ludovic Courtès 2009-02-21 00:36:29 +01:00
parent 3bef3ae428
commit 73f4d8d1d2
2 changed files with 27 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

5
module/system/base/compile.scm
View file

@ -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

27
scripts/compile
View file

@ -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