guile18/scripts/autofrisk

   1 #!/bin/sh
   2 # aside from this initial boilerplate, this is actually -*- scheme -*- code
   3 main='(module-ref (resolve-module '\''(scripts autofrisk)) '\'main')'
   4 exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
   5 !#
   6 ;;; autofrisk --- Generate module checks for use with auto* tools
   7
   8 ;;      Copyright (C) 2002, 2006 Free Software Foundation, Inc.
   9 ;;
  10 ;; This program is free software; you can redistribute it and/or
  11 ;; modify it under the terms of the GNU General Public License as
  12 ;; published by the Free Software Foundation; either version 2, or
  13 ;; (at your option) any later version.
  14 ;;
  15 ;; This program is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18 ;; General Public License for more details.
  19 ;;
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with this software; see the file COPYING.  If not, write to
  22 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  23 ;; Boston, MA 02110-1301 USA
  24
  25 ;;; Author: Thien-Thi Nguyen <ttn@gnu.org>
  26
  27 ;;; Commentary:
  28
  29 ;; Usage: autofrisk [file]
  30 ;;
  31 ;; This program looks for the file modules.af in the current directory
  32 ;; and writes out modules.af.m4 containing autoconf definitions.
  33 ;; If given, look for FILE instead of modules.af and output to FILE.m4.
  34 ;;
  35 ;; After running autofrisk, you should add to configure.ac the lines:
  36 ;;   AUTOFRISK_CHECKS
  37 ;;   AUTOFRISK_SUMMARY
  38 ;; Then run "aclocal -I ." to update aclocal.m4, and finally autoconf.
  39 ;;
  40 ;; The modules.af file consists of a series of configuration forms (Scheme
  41 ;; lists), which have one of the following formats:
  42 ;;   (files-glob PATTERN ...)
  43 ;;   (non-critical-external MODULE ...)
  44 ;;   (non-critical-internal MODULE ...)
  45 ;;   (programs (MODULE PROG ...) ...)
  46 ;;   (pww-varname VARNAME)
  47 ;; PATTERN is a string that may contain "*" and "?" characters to be
  48 ;; expanded into filenames.  MODULE is a list of symbols naming a
  49 ;; module, such as `(srfi srfi-1)'.  VARNAME is a shell-safe name to use
  50 ;; instead of "probably_wont_work", the default.  This var is passed to
  51 ;; `AC_SUBST'.  PROG is a string.
  52 ;;
  53 ;; Only the `files-glob' form is required.
  54 ;;
  55 ;; TODO: Write better commentary.
  56 ;;       Make "please see README" configurable.
  57
  58 ;;; Code:
  59
  60 (define-module (scripts autofrisk)
  61   :autoload (ice-9 popen) (open-input-pipe)
  62   :use-module (srfi srfi-1)
  63   :use-module (srfi srfi-8)
  64   :use-module (srfi srfi-13)
  65   :use-module (srfi srfi-14)
  66   :use-module (scripts read-scheme-source)
  67   :use-module (scripts frisk)
  68   :export (autofrisk))
  69
  70 (define *recognized-keys* '(files-glob
  71                             non-critical-external
  72                             non-critical-internal
  73                             programs
  74                             pww-varname))
  75
  76 (define (canonical-configuration forms)
  77   (let ((chk (lambda (condition . x)
  78                (or condition (apply error "syntax error:" x)))))
  79     (chk (list? forms) "input not a list")
  80     (chk (every list? forms) "non-list element")
  81     (chk (every (lambda (form) (< 1 (length form))) forms) "list too short")
  82     (let ((un #f))
  83       (chk (every (lambda (form)
  84                     (let ((key (car form)))
  85                       (and (symbol? key)
  86                            (or (eq? 'quote key)
  87                                (memq key *recognized-keys*)
  88                                (begin
  89                                  (set! un key)
  90                                  #f)))))
  91                   forms)
  92            "unrecognized key:" un))
  93     (let ((bunched (map (lambda (key)
  94                           (fold (lambda (form so-far)
  95                                   (or (and (eq? (car form) key)
  96                                            (cdr form)
  97                                            (append so-far (cdr form)))
  98                                       so-far))
  99                                 (list key)
 100                                 forms))
 101                         *recognized-keys*)))
 102       (lambda (key)
 103         (assq-ref bunched key)))))
 104
 105 (define (>>strong modules)
 106   (for-each (lambda (module)
 107               (format #t "GUILE_MODULE_REQUIRED~A\n" module))
 108             modules))
 109
 110 (define (safe-name module)
 111   (let ((var (object->string module)))
 112     (string-map! (lambda (c)
 113                    (if (char-set-contains? char-set:letter+digit c)
 114                        c
 115                        #\_))
 116                  var)
 117     var))
 118
 119 (define *pww* "probably_wont_work")
 120
 121 (define (>>weak weak-edges)
 122   (for-each (lambda (edge)
 123               (let* ((up (edge-up edge))
 124                      (down (edge-down edge))
 125                      (var (format #f "have_guile_module~A" (safe-name up))))
 126                 (format #t "GUILE_MODULE_AVAILABLE(~A, ~A)\n" var up)
 127                 (format #t "test \"$~A\" = no &&\n  ~A=\"~A $~A\"~A"
 128                         var *pww* down *pww* "\n\n")))
 129             weak-edges))
 130
 131 (define (>>program module progs)
 132   (let ((vars (map (lambda (prog)
 133                      (format #f "guile_module~Asupport_~A"
 134                              (safe-name module)
 135                              prog))
 136                    progs)))
 137     (for-each (lambda (var prog)
 138                 (format #t "AC_PATH_PROG(~A, ~A)\n" var prog))
 139               vars progs)
 140     (format #t "test \\\n")
 141     (for-each (lambda (var)
 142                 (format #t " \"$~A\" = \"\" -o \\\n" var))
 143               vars)
 144     (format #t "~A &&\n~A=\"~A $~A\"\n\n"
 145             (list-ref (list "war = peace"
 146                             "freedom = slavery"
 147                             "ignorance = strength")
 148                       (random 3))
 149             *pww* module *pww*)))
 150
 151 (define (>>programs programs)
 152   (for-each (lambda (form)
 153               (>>program (car form) (cdr form)))
 154             programs))
 155
 156 (define (unglob pattern)
 157   (let ((p (open-input-pipe (format #f "echo '(' ~A ')'" pattern))))
 158     (map symbol->string (read p))))
 159
 160 (define (>>checks forms)
 161   (let* ((cfg (canonical-configuration forms))
 162          (files (apply append (map unglob (cfg 'files-glob))))
 163          (ncx (cfg 'non-critical-external))
 164          (nci (cfg 'non-critical-internal))
 165          (prog (cfg 'non-critical))
 166          (report ((make-frisker) files))
 167          (external (report 'external)))
 168     (let ((pww-varname (cfg 'pww-varname)))
 169       (or (null? pww-varname) (set! *pww* (car pww-varname))))
 170     (receive (weak strong)
 171         (partition (lambda (module)
 172                      (or (member module ncx)
 173                          (every (lambda (i)
 174                                   (member i nci))
 175                                 (map edge-down (mod-down-ls module)))))
 176                    external)
 177       (format #t "AC_DEFUN([AUTOFRISK_CHECKS],[\n\n")
 178       (>>strong strong)
 179       (format #t "\n~A=~S\n\n" *pww* "")
 180       (>>weak (fold (lambda (module so-far)
 181                       (append so-far (mod-down-ls module)))
 182                     (list)
 183                     weak))
 184       (>>programs (cfg 'programs))
 185       (format #t "AC_SUBST(~A)\n])\n\n" *pww*))))
 186
 187 (define (>>summary)
 188   (format #t
 189           (symbol->string
 190            '#{
 191 AC_DEFUN([AUTOFRISK_SUMMARY],[
 192 if test ! "$~A" = "" ; then
 193     p="         ***"
 194     echo "$p"
 195     echo "$p NOTE:"
 196     echo "$p The following modules probably won't work:"
 197     echo "$p   $~A"
 198     echo "$p They can be installed anyway, and will work if their"
 199     echo "$p dependencies are installed later.  Please see README."
 200     echo "$p"
 201 fi
 202 ])
 203 }#)
 204           *pww* *pww*))
 205
 206 (define (autofrisk . args)
 207   (let ((file (if (null? args) "modules.af" (car args))))
 208     (or (file-exists? file)
 209         (error "could not find input file:" file))
 210     (with-output-to-file (format #f "~A.m4" file)
 211       (lambda ()
 212         (>>checks (read-scheme-source-silently file))
 213         (>>summary)))))
 214
 215 (define main autofrisk)
 216
 217 ;; Local variables:
 218 ;; eval: (put 'receive 'scheme-indent-function 2)
 219 ;; End:
 220
 221 ;;; autofrisk ends here