diff options
Diffstat (limited to 'scripts/compile')
-rwxr-xr-x | scripts/compile | 143 |
1 files changed, 0 insertions, 143 deletions
diff --git a/scripts/compile b/scripts/compile deleted file mode 100755 index 6651722f0..000000000 --- a/scripts/compile +++ /dev/null @@ -1,143 +0,0 @@ -#!/bin/sh -# -*- scheme -*- -exec ${GUILE-guile} -e '(@ (scripts compile) compile)' -s $0 "$@" -!# -;;; Compile --- Command-line Guile Scheme compiler - -;; Copyright 2005,2008,2009 Free Software Foundation, Inc. -;; -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation; either version 2, or -;; (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this software; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301 USA - -;;; Author: Ludovic Courtès <ludo@gnu.org> -;;; Author: Andy Wingo <wingo@pobox.com> - -;;; Commentary: - -;; Usage: compile [ARGS] -;; -;; PROGRAM does something. -;; -;; TODO: Write it! - -;;; Code: - -(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 - (lambda (opt name arg result) - (alist-cons 'help? #t result))) - - (option '(#\L "load-path") #t #f - (lambda (opt name arg result) - (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))) - (option '(#\e "expand-only") #f #f - (lambda (opt name arg result) - (alist-cons 'expand-only? #t result))) - (option '(#\t "translate-only") #f #f - (lambda (opt name arg result) - (alist-cons 'translate-only? #t result))) - (option '(#\c "compile-only") #f #f - (lambda (opt name arg result) - (alist-cons 'compile-only? #t 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" opt) - (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)))) - - -(define (compile args) - (let* ((options (parse-args (cdr args))) - (help? (assoc-ref options 'help?)) - (optimize? (assoc-ref options 'optimize?)) - (expand-only? (assoc-ref options 'expand-only?)) - (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 - (format #t "Usage: compile [OPTION] FILE... -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 - -c, --compile-only stop after the compilation to GLIL - -Report bugs to <guile-user@gnu.org>.~%") - (exit 0))) - - (set! %load-path (append load-path %load-path)) - - (let ((compile-opts (append (if optimize? '(#:O) '()) - (if expand-only? '(#:e) '()) - (if translate-only? '(#:t) '()) - (if compile-only? '(#:c) '())))) - (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 -;;; End: |