module/scripts/autofrisk.scm

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