1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
|
#!@guile@ -s
# -*- Scheme -*-
!#
;;; guilec -- Command-line Guile Scheme compiler.
;;;
;;; Copyright 2005 Ludovic Court�s <ludovic.courtes@laas.fr>
;;;
;;;
;;; 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 of the License, 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 program; if not, write to the Free Software
;;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
(use-modules (system vm bootstrap)
(system base compile)
(ice-9 getopt-long))
(read-set! keywords 'prefix)
(define %guilec-options
'((help (single-char #\h) (value #f))
(optimize (single-char #\O) (value #f))
(expand-only (single-char #\e) (value #f))
(translate-only (single-char #\t) (value #f))
(compile-only (single-char #\c) (value #f))))
(let* ((options (getopt-long (command-line) %guilec-options))
(help? (option-ref options 'help #f))
(optimize? (option-ref options 'optimize #f))
(expand-only? (option-ref options 'expand-only #f))
(translate-only? (option-ref options 'translate-only #f))
(compile-only? (option-ref options 'compile-only #f)))
(if help?
(begin
(format #t "Usage: guilec [OPTION] FILE...
Compile each Guile Scheme source file FILE into a Guile object.
-h, --help print this help message
-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)))
(let ((compile-opts (append (if optimize? '(:O) '())
(if expand-only? '(:e) '())
(if translate-only? '(:t) '())
(if compile-only? '(:c) '()))))
(catch #t
(lambda ()
(for-each (lambda (file)
(apply compile-file (cons file compile-opts)))
(option-ref options '() '())))
(lambda (key . args)
(format (current-error-port) "exception `~a' caught~a~%" key
(if (null? args) ""
(if (string? (car args))
(string-append " in subr `" (car args) "'")
"")))
(format (current-error-port) "removing compiled files due to errors~%")
(false-if-exception
(for-each unlink (map compiled-file-name files)))
(exit 1)))))
|
