mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 11:40:18 +02:00
b8076ec6cc
* module/language/ghil.scm (unparse-ghil): Fix unparsing of quasiquoted expressions. * module/language/ghil/spec.scm (join): Define a joiner for GHIL. * module/language/scheme/compile-ghil.scm (cenv-ghil-env): Expand the definition of a CENV so it can have an actual ghil-env, if available. (compile-ghil): Return the actual ghil env in the cenv. * module/system/base/compile.scm (compile-file): Rewrite. `output-file' is now a keyword argument, along with the new kwargs `env' and `from'. We now allow exceptions to propagate up, and instead of printing the output file to the console, we return a string corresponding to its location. (compile-and-load): Use read-and-compile. (compile-fold): Thread around the cenv as well. Return all three values. (find-language-joint, read-and-compile): New exciting helpers. The idea is that compiling a file should be semantically equivalent to compiling each expression in it, one by one. Compilation can have side effects, e.g. affecting the current language or the current reader. So what we do is find a point in the compilation path at which different expressions of a given language can be joined into one. Expressions from the source language are compiled to the joint language, then joined and compiled to the target. (compile): Just return the first value from compile-fold. * module/system/base/language.scm (language-joiner): New optional field. * scripts/compile: Rework for changes to compile-file.
140 lines
4.8 KiB
Scheme
Executable file
140 lines
4.8 KiB
Scheme
Executable file
#!/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]
|
||
;;
|
||
;; A command-line interface to the Guile compiler.
|
||
|
||
;;; 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 '(#\f "from") #t #f
|
||
(lambda (opt name arg result)
|
||
(if (assoc-ref result 'from)
|
||
(fail "`--from' option cannot be specified more than once")
|
||
(alist-cons 'from (string->symbol arg) result))))
|
||
(option '(#\t "to") #t #f
|
||
(lambda (opt name arg result)
|
||
(if (assoc-ref result 'to)
|
||
(fail "`--to' option cannot be specified more than once")
|
||
(alist-cons 'to (string->symbol arg) 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?))
|
||
(compile-opts (if (assoc-ref options 'optimize?) '(#:O) '()))
|
||
(from (or (assoc-ref options 'from) 'scheme))
|
||
(to (or (assoc-ref options 'to) 'objcode))
|
||
(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 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
|
||
|
||
-f, --from=LANG specify a source language other than `scheme'
|
||
-t, --to=LANG specify a target language other than `objcode'
|
||
|
||
Report bugs to <guile-user@gnu.org>.~%")
|
||
(exit 0)))
|
||
|
||
(set! %load-path (append load-path %load-path))
|
||
|
||
(if (and output-file
|
||
(or (null? input-files)
|
||
(not (null? (cdr input-files)))))
|
||
(fail "`-o' option can only be specified "
|
||
"when compiling a single file"))
|
||
|
||
(for-each (lambda (file)
|
||
(format #t "wrote `~A'\n"
|
||
(compile-file file
|
||
#:output-file output-file
|
||
#:from from
|
||
#:to to
|
||
#:opts compile-opts)))
|
||
input-files)))
|
||
|
||
;;; Local Variables:
|
||
;;; coding: latin-1
|
||
;;; End:
|