diff options
Diffstat (limited to 'scripts')
| -rw-r--r-- | scripts/Makefile.am | 1 | ||||
| -rwxr-xr-x | scripts/bootstrap | 489 |
2 files changed, 490 insertions, 0 deletions
diff --git a/scripts/Makefile.am b/scripts/Makefile.am index 291ff75..a4552de 100644 --- a/scripts/Makefile.am +++ b/scripts/Makefile.am @@ -15,6 +15,7 @@ # along with Gamma. If not, see <http://www.gnu.org/licenses/>. EXTRA_DIST = \ + bootstrap\ guile-doc-snarf\ guile-doc-snarf.awk\ gitlog-to-changelog diff --git a/scripts/bootstrap b/scripts/bootstrap new file mode 100755 index 0000000..be7cef0 --- /dev/null +++ b/scripts/bootstrap @@ -0,0 +1,489 @@ +#! /bin/sh +# aside from this initial boilerplate, this is actually -*- scheme -*- code +main='(module-ref (resolve-module '\''(scripts bootstrap)) '\'main')' +exec ${GUILE-guile} -l $0 -c "(apply $main (cons \"$0\" (cdr (command-line))))" "$@" +!# +;;;; This file is part of Gamma. +;;;; Copyright (C) 2010 Sergey Poznyakoff +;;;; +;;;; Gamma 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 3, or (at your option) +;;;; any later version. +;;;; +;;;; Gamma 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 Gamma. If not, see <http://www.gnu.org/licenses/>. + +(define-module (scripts bootstrap) + :use-module (ice-9 getopt-long) + :use-module (ice-9 rdelim) + :use-module (ice-9 regex) + :use-module (ice-9 popen) + :use-module (srfi srfi-1)) + +(debug-enable 'debug) +(debug-enable 'backtrace) + +(define module-dir #f) +(define srcdir "src") +(define makefile "src/modules.mk") +(define modconfig-file "m4/modules.m4") +(define modconfig-defun "gamma_MODCONFIG") +(define autogenerated-file-header + (list "-*- buffer-read-only: t -*- vi: set ro:" + "DO NOT EDIT! GENERATED AUTOMATICALLY!")) +(define reconfig-command "autoreconf -f -i -s") +(define files-from #f) + +(define grammar + `((topdir (single-char #\C) (value #t)) + (moddir (value #t)) + (srcdir (value #t)) + (makefile (value #t)) + (modconfig-file (value #t)) + (modconfig-defun (value #t)) + (reconfigure (value #t)) + (files-from (single-char #\T) (value #t)) + (help))) + +(define (usage) + (display "usage: bootstrap [OPTIONS] [FILES...]\n") + (display "Bootstraps the Gamma module system\n") + (display "OPTIONS are (defaults shown in brackets):\n") + (display " -C, --topdir DIR top source directory [.]\n") + (display " --moddir DIR module directory [.]\n") + (format #t " --srcdir DIR source directory [~A]~%" srcdir) + (format #t " --makefile FILE output makefile [~A]~%" makefile) + (format #t " --modconfig-file FILE module configuration file [~A]~%" modconfig-file) + (format #t " --modconfig-defun FUNC name of the module configuration defun [~A]~%" modconfig-defun) + (format #t " --reconfigure CMD reconfigure command [~A]~%" reconfig-command) + (display " -T, --files-from FILE read files from FILE\n")) + +(define progname #f) + +(define (error fmt . args) + (with-output-to-port + (current-error-port) + (lambda () + (display progname) + (display ": ") + (apply format (cons #t (cons fmt args))) + (newline)))) + +(define section-header-rx (make-regexp "^(.*):[ \t]*$")) + +(define (read-module-file file) + (let ((ret (list (cons 'module (basename file)))) + (section-name #f) + (section-body '())) + (with-input-from-file + (cond + ((or (string-prefix? "./" file) + (string-prefix? "/" file)) + file) + (module-dir + (string-append module-dir "/" file)) + (else + file)) + (lambda () + (do ((input (read-line) (read-line))) + ((eof-object? input) + (reverse (if section-name + (cons (cons (string->symbol section-name) + (reverse section-body)) + ret) + ret))) + (cond + ((regexp-exec section-header-rx input) => + (lambda (match) + (cond + (section-name + (set! ret (cons (cons (string->symbol section-name) + (reverse section-body)) + ret)))) + (set! section-name (match:substring match 1)) + (set! section-body '()))) + (else + (set! section-body (cons input section-body))))))))) + +(define (reduce-string-list inlist) + (if (or (not (list? inlist)) (null? inlist)) + inlist + (let ((x (car inlist))) + (if (string-null? x) + (reduce-string-list (cdr inlist)) + (cons x (reduce-string-list (cdr inlist))))))) + +(define (read-strings . rest) + (let reader ((pred (if (null? rest) #f (car rest)))) + (let ((input (read-line))) + (cond + ((eof-object? input) + '()) + ((and pred (not (pred input))) + (reader pred)) + (else + (cons input (reader pred))))))) + +(define (read-strings-from-file file . rest) + (with-input-from-file + file + (lambda () + (apply read-strings rest)))) + +(define (get-x-file-list source-list) + (let ((p (open-input-pipe + (apply string-append + (cons + "sed -r -n '/^#[[:blank:]]*include[[:blank:]]*</s/.*<(.*\\.x)>.*/\\1/p;/^#[[:blank:]]*include[[:blank:]]*\"/s/.*\"(.*\\.x)\".*/\\1/p'" + (map + (lambda (file-name) + (string-append " " srcdir "/" file-name)) + source-list)))))) + (let ((out-list (with-input-from-port p read-strings))) + (close-pipe p) + out-list))) + +(define (uniq-list lst) + (if (null? (cdr lst)) + lst + (reduce-right + (lambda (elem prev) + (let ((x (if (pair? prev) prev (list prev)))) + (if (string=? elem (car x)) + x + (cons elem x)))) + '() + lst))) + +(define (get-module-defn file) + (let* ((xdata '()) + (moddef (map + (lambda (sec) + (let ((id (car sec)) + (data (cdr sec))) + (case id + ((libraries scm) + (cons id (reduce-string-list data))) + ((sources) + (let ((file-list + (map + (lambda (file-name) + (cond + ((string-suffix? ".x" file-name) + (set! xdata (cons file-name xdata)) + (string-append + (string-drop-right file-name 1) "c")) + (else + file-name))) + (reduce-string-list data)))) + (set! xdata (append xdata + (get-x-file-list file-list))) + (cons id file-list))) + (else + sec)))) + (read-module-file file)))) + (if (not (null? xdata)) + (append moddef + (list (cons 'xdata + (uniq-list (sort xdata string<?))))) + moddef))) + +(define (write-autogenerated-header ocomm ccomm) + (for-each + (lambda (line) + (display ocomm) + (display line) + (if ccomm + (displat ccomm)) + (newline)) + autogenerated-file-header)) + +(define (write-string-list arg . rest) + (let ((indent (make-string (if (null? rest) 0 (car rest)) #\space))) + (for-each + (lambda (line) + (display indent) + (display line) + (newline)) + arg))) + +(define (write-module-header fmt moddef) + (display "#\n") + (let ((mname (assoc-ref moddef 'module))) + (if mname + (begin + (display "# ") + (format #t fmt mname) + (newline)))) + (display "#\n")) + +(define np-rx (make-regexp "[^[:alnum:]]" regexp/extended)) + +(define (write-arg-framework moddef thunk) + (let* ((mod-name (assoc-ref moddef 'module)) + (var-name (string-append + "gamma_" + (regexp-substitute/global + #f np-rx (string-downcase mod-name) + 'pre "_" 'post)))) + (format #t "AC_ARG_ENABLE([~A],~%" mod-name) + (format #t " AC_HELP_STRING([--disable-~A],~%" mod-name) + (format #t " [disable ~A]),~%" mod-name) + (format #t " [~A=$enableval],[~A=yes])~%" var-name var-name) + (cond + (thunk + (format #t "if test $~A = yes; then~%" var-name) + (thunk) + (display "fi\n"))) + (format #t "if test $~A = yes; then~%" var-name) + (let ((libraries (assoc-ref moddef 'libraries))) + (cond + ((and libraries (not (null? libraries))) + (display " GAMMA_LIB_LIST=\"$GAMMA_LIB_LIST") + (for-each + (lambda (root) + (format #t " libgamma-~A.la" root)) + libraries) + (display #\") + (newline) + + (display " GAMMA_INSTALL_HOOKS=\"$GAMMA_INSTALL_HOOKS") + (for-each + (lambda (root) + (format #t " install-~A-hook" root)) + libraries) + (display #\") + (newline)))) + (display "fi\n"))) + +(define (empty-string-list? lst) + (cond + ((null? lst) + #t) + ((not (string-null? (car lst))) + #f) + (else + (empty-string-list? (cdr lst))))) + +(define (write-modconfig modules) + (format #t "~A: writing module configuration file ~A~%" + progname modconfig-file) + (with-output-to-file + modconfig-file + (lambda () + (write-autogenerated-header "# " #f) + (newline) + (format #t "AC_DEFUN([~A],[~%" modconfig-defun) + (display "AC_SUBST([GAMMA_LIB_LIST])\n") + (display "AC_SUBST([GAMMA_INSTALL_HOOKS])\n") + (for-each + (lambda (moddef) + (let ((conf (assoc-ref moddef 'configure))) + (if conf + (begin + (write-module-header "Configuration for ~A" moddef) + (write-arg-framework moddef + (if (empty-string-list? conf) + #f + (lambda () + (write-string-list conf 2)))))))) + modules) + (display "])") + (newline)))) + +(define (write-backslashed-list lst prev) + (cond + ((not lst) + (newline)) + ((null? lst) + (newline)) + (else + (let* ((x (car lst)) + (p (not (string-null? x)))) + (cond (p + (cond (prev + (display #\\) + (newline) + (display " "))) + (display x))) + (write-backslashed-list (cdr lst) (or p prev)))))) + +(define (write-install-hook root) + (display (string-append "install-" root "-hook:\n")) + (format #t "\ +\t@here=`pwd`; \\\n\ +\tcd $(DESTDIR)$(libdir);\\\n\ +\tif test -f libgamma-~A.so; then \\\n\ +\t\t$(LN_S) -f libgamma-~A.so libgamma-~A-v-$(VERSION).so; \\\n\ +\tfi; \\\n\ +\tcd $$here" root root root) + (newline)) + + +(define (write-makefile modules) + (format #t "~A: writing makefile ~A~%" + progname makefile) + (with-output-to-file + makefile + (lambda () + (write-autogenerated-header "# " #f) + (newline) + (display "GAMMA_BUILT_DATA_FILES=\n") + (display "GAMMA_X_FILES=\n") + (for-each + (lambda (moddef) + (write-module-header "Module ~A" moddef) + + (let ((libraries (assoc-ref moddef 'libraries))) + (cond + ((and libraries (not (null? libraries))) + (display "EXTRA_LTLIBRARIES +=") + (for-each + (lambda (root) + (if (not (string-null? root)) + (format #t " libgamma-~A.la" root))) + libraries) + (newline) + + (if (null? (cdr libraries)) + (let ((root (car libraries))) + (format #t "libgamma_~A_la_SOURCES = " root) + (write-backslashed-list + (or (assoc-ref moddef + (string->symbol + (string-append root "-sources"))) + (assoc-ref moddef 'sources)) #f) + (newline) + (format #t "libgamma_~A_la_LDFLAGS = -rpath $(libdir) -version-info 0:0:0~%" root) + (newline) + (write-install-hook root)) + + (for-each + (lambda (root) + (format #t "libgamma_~A_la_SOURCES = " root) + (write-backslashed-list + (assoc-ref moddef (string->symbol + (string-append root "-sources"))) #f) + (newline) + (format #t "libgamma_~A_la_LDFLAGS = -rpath $(libdir) -version-info 0:0:0~%" root) + (newline) + (write-install-hook root)) + libraries)) + + (newline)))) + + (cond + ((assoc-ref moddef 'scm) => + (lambda (scm-list) + (let ((built-data '())) + (format #t "EXTRA_DIST +=") + (for-each + (lambda (file) + (if (string-suffix? ".sci" file) + (set! built-data (cons (string-append + (string-drop-right file 1) + "m") + built-data))) + (display " ") + (display file)) + scm-list) + (newline) + + (cond + ((not (null? built-data)) + (format #t "GAMMA_BUILT_DATA_FILES +=") + (for-each + (lambda (file) + (display " ") + (display file)) + built-data) + (newline))))))) + + (cond + ((assoc-ref moddef 'xdata) => + (lambda (xdata) + (format #t "GAMMA_X_FILES +=") + (for-each + (lambda (file) + (display " ") + (display file)) + xdata) + (newline)))) + + (cond + ((assoc-ref moddef 'makefile) => + (lambda (x) + (write-string-list x))))) + modules)))) + +(define (main . args) + (set! progname (car args)) + (let ((input-files '())) + (for-each + (lambda (x) + (case (car x) + ((()) + (set! input-files (cdr x))) + ((help) + (usage) + (exit 0)) + ((moddir) + (set! module-dir (cdr x))) + ((srcdir) + (set! srcdir (cdr x))) + ((modconfig-file) + (set! modconfig-file (cdr x))) + ((modconfig-defun) + (set! modconfig-defun (cdr x))) + ((topdir) + (chdir (cdr x))) + ((makefile) + (set! makefile (cdr x))) + ((reconfigure) + (set! reconfig-command (cdr x))) + ((files-from) + (set! files-from (cdr x))) + (else + (error "unhandled option: ~A" x)))) + (getopt-long args grammar)) + + (letrec ((pred (lambda (x) + (not (or + (string-null? x) + (string-prefix? "#" x)))))) + (if files-from + (set! input-files + (append input-files + (read-strings-from-file files-from pred)))) + + (cond + ((null? input-files) + (if module-dir + (let ((fname (string-append module-dir "/MODLIST"))) + (cond + ((file-exists? fname) + (format #t "~A: reading modules from ~A~%" progname fname) + (set! input-files (read-strings-from-file fname pred))))))))) + + (if (null? input-files) + (begin + (error "no input files") + (exit 1))) + + (let ((modules (map + (lambda (file) + (get-module-defn file)) + input-files))) +; (write modules) + (write-modconfig modules) + (write-makefile modules) + (cond + ((not (string-null? reconfig-command)) + (format #t "~A: running ~A~%" progname reconfig-command) + (system reconfig-command)))))) |