Commit | Line | Data |
---|---|---|
b8b1f322 JB |
1 | #!@-bindir-@/guile \ |
2 | -e main -s | |
3 | !# | |
4 | ;;;; build-guile --- utility for linking programs with Guile | |
5 | ;;;; Jim Blandy <jim@red-bean.com> --- September 1997 | |
6 | ||
7 | (use-modules (ice-9 regex) | |
8 | (ice-9 string-fun)) | |
9 | ||
10 | \f | |
11 | ;;;; main function, command-line processing | |
12 | ||
13 | ;;; The script's entry point. | |
14 | (define (main args) | |
15 | (set-program-name! (car args)) | |
16 | (let ((args (cdr args))) | |
17 | (cond | |
5c2142ce JB |
18 | ((null? args) (show-help '())) |
19 | ((assoc (car args) command-table) | |
20 | => (lambda (row) | |
21 | ((cadr row) (cdr args)))) | |
22 | (else | |
23 | (show-help '()))))) | |
b8b1f322 JB |
24 | |
25 | (define program-name #f) | |
26 | (define program-version "@-GUILE_VERSION-@") | |
27 | ||
28 | ;;; Given an executable path PATH, set program-name to something | |
29 | ;;; appropriate f or use in error messages (i.e., with leading | |
30 | ;;; directory names stripped). | |
31 | (define (set-program-name! path) | |
32 | (set! program-name | |
33 | (cond | |
34 | ((string-match "/([^/]+)$" path) | |
35 | => (lambda (match) (match:substring match 1))) | |
36 | (else path)))) | |
37 | ||
5c2142ce JB |
38 | (define (show-help args) |
39 | (cond | |
40 | ((null? args) (show-help-overview)) | |
41 | ((assoc (car args) command-table) | |
42 | => (lambda (row) ((caddr row)))) | |
43 | (else | |
44 | (show-help-overview)))) | |
45 | ||
46 | (define (show-help-overview) | |
47 | (let ((dl display-line-error)) | |
b8b1f322 JB |
48 | (dl "Usage: ") |
49 | (dl " " program-name " link - print libraries to link with") | |
5c2142ce JB |
50 | ;; Not yet implemented. |
51 | ;; (dl " " program-name " main - generate initialization code") | |
52 | (dl " " program-name " info [VAR] - print Guile build directories") | |
b8b1f322 | 53 | (dl " " program-name " --help - show usage info (this message)") |
5c2142ce | 54 | (dl " " program-name " --help SUBCOMMAND - show help for SUBCOMMAND") |
b8b1f322 JB |
55 | (dl " " program-name " --version - show running version"))) |
56 | ||
5c2142ce | 57 | (define (show-version args) |
b8b1f322 JB |
58 | (display-line program-name " - Guile version " program-version)) |
59 | ||
60 | \f | |
61 | ;;;; the "link" subcommand | |
62 | ||
63 | ;;; Write a set of linker flags to standard output to include the | |
64 | ;;; libraries that libguile needs to link against. | |
65 | ;;; | |
66 | ;;; In the long run, we want to derive these flags from Guile module | |
67 | ;;; declarations files that are installed along the load path. For | |
68 | ;;; now, we're just going to reach into Guile's configuration info and | |
69 | ;;; hack it out. | |
70 | (define (build-link args) | |
71 | (if (> (length args) 0) | |
72 | (error | |
73 | (string-append program-name | |
74 | " link: arguments to subcommand not yet implemented"))) | |
75 | ||
76 | (let* ((flags | |
77 | (let loop ((libs | |
78 | ;; Get the string of linker flags we used to build | |
79 | ;; Guile, and break it up into a list. | |
80 | (separate-fields-discarding-char #\space | |
81 | (get-build-info 'LIBS) | |
82 | list))) | |
83 | (cond | |
84 | ((null? libs) '()) | |
85 | ||
86 | ;; Turn any "FOO/libBAR.a" elements into "-lBAR". | |
87 | ((string-match "^.*/lib([^./]+).a$" (car libs)) | |
88 | => (lambda (match) | |
89 | (cons (string-append "-l" (match:substring match 1)) | |
90 | (loop (cdr libs))))) | |
91 | ||
92 | ;; Remove any empty strings that may have seeped in there. | |
93 | ((string=? (car libs) "") (loop (cdr libs))) | |
94 | ||
95 | (else (cons (car libs) (loop (cdr libs))))))) | |
96 | ||
97 | ;; Don't omit -lguile itself from the list of flags. | |
98 | (flags (cons "-lguile" flags))) | |
99 | ||
100 | ;; Display the flags, separated by spaces. | |
101 | (display-separated flags) | |
102 | (newline))) | |
103 | ||
5c2142ce JB |
104 | (define (help-link) |
105 | (let ((dle display-line-error)) | |
106 | (dle "Usage: " program-name " link") | |
107 | (dle "Print linker flags for building the `guile' executable.") | |
108 | (dle "Print the linker command-line flags necessary to link against the") | |
109 | (dle "Guile library, and any other libraries it requires."))) | |
110 | ||
111 | ||
112 | ||
b8b1f322 JB |
113 | (define (get-build-info name) |
114 | (let ((val (assq name %guile-build-info))) | |
115 | (or val (error "get-build-info: no such build info: " name)) | |
116 | (cdr val))) | |
117 | ||
118 | \f | |
119 | ;;;; The "main" subcommand | |
120 | ||
5c2142ce JB |
121 | ;;; We haven't implemented this yet, because we don't have the |
122 | ;;; mechanisms in place to discover the installed static link | |
123 | ;;; libraries. When we do implement this, remember to fix the message | |
124 | ;;; in show-help-overview. | |
b8b1f322 | 125 | (define (build-main args) |
5c2142ce JB |
126 | (display-line-error program-name ": `main' subcommand not yet implemented")) |
127 | ||
128 | (define (help-main) | |
129 | (let ((dle display-line-error)) | |
130 | (dle "Usage: " program-name " main") | |
131 | (dle "This subcommand is not yet implemented."))) | |
132 | ||
133 | \f | |
134 | ;;;; The "info" subcommand | |
135 | ||
136 | (define (build-info args) | |
137 | (cond | |
138 | ((null? args) (show-all-vars)) | |
139 | ((null? (cdr args)) (show-var (car args))) | |
140 | (else | |
141 | (display-line-error "Usage: " program-name " info [VAR]")))) | |
142 | ||
143 | (define (show-all-vars) | |
144 | (for-each (lambda (binding) | |
145 | (display-line (car binding) " = " (cdr binding))) | |
146 | %guile-build-info)) | |
147 | ||
148 | (define (show-var var) | |
149 | (display (get-build-info (string->symbol var))) | |
150 | (newline)) | |
151 | ||
152 | (define (help-info) | |
153 | (let ((dle display-line-error)) | |
154 | (dle "Usage: " program-name " info [VAR]") | |
155 | (dle "Display the value of the Makefile variable VAR used when Guile") | |
156 | (dle "was built. If VAR is omitted, display all Makefile variables.") | |
157 | (dle "Use this command to find out where Guile was installed,") | |
158 | (dle "where it will look for Scheme code at run-time, and so on."))) | |
159 | ||
b8b1f322 JB |
160 | |
161 | \f | |
162 | ;;;; trivial utilities | |
163 | ||
164 | (define (display-line . args) | |
165 | (apply display-line-port (current-output-port) args)) | |
166 | ||
5c2142ce JB |
167 | (define (display-line-error . args) |
168 | (apply display-line-port (current-error-port) args)) | |
169 | ||
b8b1f322 JB |
170 | (define (display-line-port port . args) |
171 | (for-each (lambda (arg) (display arg port)) | |
172 | args) | |
173 | (newline)) | |
174 | ||
175 | (define (display-separated args) | |
176 | (let loop ((args args)) | |
177 | (cond ((null? args)) | |
178 | ((null? (cdr args)) (display (car args))) | |
179 | (else (display (car args)) | |
180 | (display " ") | |
181 | (loop (cdr args)))))) | |
182 | ||
183 | \f | |
5c2142ce JB |
184 | ;;;; the command table |
185 | ||
186 | ;;; We define this down here, so Guile builds the list after all the | |
187 | ;;; functions have been defined. | |
188 | (define command-table | |
189 | (list | |
190 | (list "--version" show-version show-help-overview) | |
191 | (list "--help" show-help show-help-overview) | |
192 | (list "link" build-link help-link) | |
193 | (list "main" build-main help-main) | |
194 | (list "info" build-info help-info))) | |
195 | ||
196 | ||
197 | ||
198 | \f | |
b8b1f322 JB |
199 | ;;; Local Variables: |
200 | ;;; mode: scheme | |
201 | ;;; End: |