build/build-guile.in

   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
  18      ((null? args) (show-help '()))
  19      ((assoc (car args) command-table)
  20       => (lambda (row)
  21            ((cadr row) (cdr args))))
  22      (else
  23       (show-help '())))))
  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
  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))
  48     (dl "Usage: ")
  49     (dl "  " program-name " link        - print libraries to link with")
  50     ;; Not yet implemented.
  51     ;; (dl "  " program-name " main        - generate initialization code")
  52     (dl "  " program-name " info [VAR]  - print Guile build directories")
  53     (dl "  " program-name " --help      - show usage info (this message)")
  54     (dl "  " program-name " --help SUBCOMMAND - show help for SUBCOMMAND")
  55     (dl "  " program-name " --version   - show running version")))
  56
  57 (define (show-version args)
  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
 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
 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
 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.
 125 (define (build-main args)
 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
 160
 161 \f
 162 ;;;; trivial utilities
 163
 164 (define (display-line . args)
 165   (apply display-line-port (current-output-port) args))
 166
 167 (define (display-line-error . args)
 168   (apply display-line-port (current-error-port) args))
 169
 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
 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
 199 ;;; Local Variables:
 200 ;;; mode: scheme
 201 ;;; End: