diff --git a/build/build-guile.in b/build/build-guile.in index cec5438ed..e69de29bb 100644 --- a/build/build-guile.in +++ b/build/build-guile.in @@ -1,201 +0,0 @@ -#!@-bindir-@/guile \ --e main -s -!# -;;;; build-guile --- utility for linking programs with Guile -;;;; Jim Blandy --- September 1997 - -(use-modules (ice-9 regex) - (ice-9 string-fun)) - - -;;;; main function, command-line processing - -;;; The script's entry point. -(define (main args) - (set-program-name! (car args)) - (let ((args (cdr args))) - (cond - ((null? args) (show-help '())) - ((assoc (car args) command-table) - => (lambda (row) - ((cadr row) (cdr args)))) - (else - (show-help '()))))) - -(define program-name #f) -(define program-version "@-GUILE_VERSION-@") - -;;; Given an executable path PATH, set program-name to something -;;; appropriate f or use in error messages (i.e., with leading -;;; directory names stripped). -(define (set-program-name! path) - (set! program-name - (cond - ((string-match "/([^/]+)$" path) - => (lambda (match) (match:substring match 1))) - (else path)))) - -(define (show-help args) - (cond - ((null? args) (show-help-overview)) - ((assoc (car args) command-table) - => (lambda (row) ((caddr row)))) - (else - (show-help-overview)))) - -(define (show-help-overview) - (let ((dl display-line-error)) - (dl "Usage: ") - (dl " " program-name " link - print libraries to link with") - ;; Not yet implemented. - ;; (dl " " program-name " main - generate initialization code") - (dl " " program-name " info [VAR] - print Guile build directories") - (dl " " program-name " --help - show usage info (this message)") - (dl " " program-name " --help SUBCOMMAND - show help for SUBCOMMAND") - (dl " " program-name " --version - show running version"))) - -(define (show-version args) - (display-line program-name " - Guile version " program-version)) - - -;;;; the "link" subcommand - -;;; Write a set of linker flags to standard output to include the -;;; libraries that libguile needs to link against. -;;; -;;; In the long run, we want to derive these flags from Guile module -;;; declarations files that are installed along the load path. For -;;; now, we're just going to reach into Guile's configuration info and -;;; hack it out. -(define (build-link args) - (if (> (length args) 0) - (error - (string-append program-name - " link: arguments to subcommand not yet implemented"))) - - (let* ((flags - (let loop ((libs - ;; Get the string of linker flags we used to build - ;; Guile, and break it up into a list. - (separate-fields-discarding-char #\space - (get-build-info 'LIBS) - list))) - (cond - ((null? libs) '()) - - ;; Turn any "FOO/libBAR.a" elements into "-lBAR". - ((string-match "^.*/lib([^./]+).a$" (car libs)) - => (lambda (match) - (cons (string-append "-l" (match:substring match 1)) - (loop (cdr libs))))) - - ;; Remove any empty strings that may have seeped in there. - ((string=? (car libs) "") (loop (cdr libs))) - - (else (cons (car libs) (loop (cdr libs))))))) - - ;; Don't omit -lguile itself from the list of flags. - (flags (cons "-lguile" flags))) - - ;; Display the flags, separated by spaces. - (display-separated flags) - (newline))) - -(define (help-link) - (let ((dle display-line-error)) - (dle "Usage: " program-name " link") - (dle "Print linker flags for building the `guile' executable.") - (dle "Print the linker command-line flags necessary to link against the") - (dle "Guile library, and any other libraries it requires."))) - - - -(define (get-build-info name) - (let ((val (assq name %guile-build-info))) - (or val (error "get-build-info: no such build info: " name)) - (cdr val))) - - -;;;; The "main" subcommand - -;;; We haven't implemented this yet, because we don't have the -;;; mechanisms in place to discover the installed static link -;;; libraries. When we do implement this, remember to fix the message -;;; in show-help-overview. -(define (build-main args) - (display-line-error program-name ": `main' subcommand not yet implemented")) - -(define (help-main) - (let ((dle display-line-error)) - (dle "Usage: " program-name " main") - (dle "This subcommand is not yet implemented."))) - - -;;;; The "info" subcommand - -(define (build-info args) - (cond - ((null? args) (show-all-vars)) - ((null? (cdr args)) (show-var (car args))) - (else - (display-line-error "Usage: " program-name " info [VAR]")))) - -(define (show-all-vars) - (for-each (lambda (binding) - (display-line (car binding) " = " (cdr binding))) - %guile-build-info)) - -(define (show-var var) - (display (get-build-info (string->symbol var))) - (newline)) - -(define (help-info) - (let ((dle display-line-error)) - (dle "Usage: " program-name " info [VAR]") - (dle "Display the value of the Makefile variable VAR used when Guile") - (dle "was built. If VAR is omitted, display all Makefile variables.") - (dle "Use this command to find out where Guile was installed,") - (dle "where it will look for Scheme code at run-time, and so on."))) - - - -;;;; trivial utilities - -(define (display-line . args) - (apply display-line-port (current-output-port) args)) - -(define (display-line-error . args) - (apply display-line-port (current-error-port) args)) - -(define (display-line-port port . args) - (for-each (lambda (arg) (display arg port)) - args) - (newline)) - -(define (display-separated args) - (let loop ((args args)) - (cond ((null? args)) - ((null? (cdr args)) (display (car args))) - (else (display (car args)) - (display " ") - (loop (cdr args)))))) - - -;;;; the command table - -;;; We define this down here, so Guile builds the list after all the -;;; functions have been defined. -(define command-table - (list - (list "--version" show-version show-help-overview) - (list "--help" show-help show-help-overview) - (list "link" build-link help-link) - (list "main" build-main help-main) - (list "info" build-info help-info))) - - - - -;;; Local Variables: -;;; mode: scheme -;;; End: