module/scripts/autofrisk.scm

   1 ;;; autofrisk --- Generate module checks for use with auto* tools
   2
   3 ;;      Copyright (C) 2002, 2006 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 *recognized-keys* '(files-glob
  66                             non-critical-external
  67                             non-critical-internal
  68                             programs
  69                             pww-varname))
  70
  71 (define (canonical-configuration forms)
  72   (let ((chk (lambda (condition . x)
  73                (or condition (apply error "syntax error:" x)))))
  74     (chk (list? forms) "input not a list")
  75     (chk (every list? forms) "non-list element")
  76     (chk (every (lambda (form) (< 1 (length form))) forms) "list too short")
  77     (let ((un #f))
  78       (chk (every (lambda (form)
  79                     (let ((key (car form)))
  80                       (and (symbol? key)
  81                            (or (eq? 'quote key)
  82                                (memq key *recognized-keys*)
  83                                (begin
  84                                  (set! un key)
  85                                  #f)))))
  86                   forms)
  87            "unrecognized key:" un))
  88     (let ((bunched (map (lambda (key)
  89                           (fold (lambda (form so-far)
  90                                   (or (and (eq? (car form) key)
  91                                            (cdr form)
  92                                            (append so-far (cdr form)))
  93                                       so-far))
  94                                 (list key)
  95                                 forms))
  96                         *recognized-keys*)))
  97       (lambda (key)
  98         (assq-ref bunched key)))))
  99
 100 (define (>>strong modules)
 101   (for-each (lambda (module)
 102               (format #t "GUILE_MODULE_REQUIRED~A\n" module))
 103             modules))
 104
 105 (define (safe-name module)
 106   (let ((var (object->string module)))
 107     (string-map! (lambda (c)
 108                    (if (char-set-contains? char-set:letter+digit c)
 109                        c
 110                        #\_))
 111                  var)
 112     var))
 113
 114 (define *pww* "probably_wont_work")
 115
 116 (define (>>weak weak-edges)
 117   (for-each (lambda (edge)
 118               (let* ((up (edge-up edge))
 119                      (down (edge-down edge))
 120                      (var (format #f "have_guile_module~A" (safe-name up))))
 121                 (format #t "GUILE_MODULE_AVAILABLE(~A, ~A)\n" var up)
 122                 (format #t "test \"$~A\" = no &&\n  ~A=\"~A $~A\"~A"
 123                         var *pww* down *pww* "\n\n")))
 124             weak-edges))
 125
 126 (define (>>program module progs)
 127   (let ((vars (map (lambda (prog)
 128                      (format #f "guile_module~Asupport_~A"
 129                              (safe-name module)
 130                              prog))
 131                    progs)))
 132     (for-each (lambda (var prog)
 133                 (format #t "AC_PATH_PROG(~A, ~A)\n" var prog))
 134               vars progs)
 135     (format #t "test \\\n")
 136     (for-each (lambda (var)
 137                 (format #t " \"$~A\" = \"\" -o \\\n" var))
 138               vars)
 139     (format #t "~A &&\n~A=\"~A $~A\"\n\n"
 140             (list-ref (list "war = peace"
 141                             "freedom = slavery"
 142                             "ignorance = strength")
 143                       (random 3))
 144             *pww* module *pww*)))
 145
 146 (define (>>programs programs)
 147   (for-each (lambda (form)
 148               (>>program (car form) (cdr form)))
 149             programs))
 150
 151 (define (unglob pattern)
 152   (let ((p (open-input-pipe (format #f "echo '(' ~A ')'" pattern))))
 153     (map symbol->string (read p))))
 154
 155 (define (>>checks forms)
 156   (let* ((cfg (canonical-configuration forms))
 157          (files (apply append (map unglob (cfg 'files-glob))))
 158          (ncx (cfg 'non-critical-external))
 159          (nci (cfg 'non-critical-internal))
 160          (prog (cfg 'non-critical))
 161          (report ((make-frisker) files))
 162          (external (report 'external)))
 163     (let ((pww-varname (cfg 'pww-varname)))
 164       (or (null? pww-varname) (set! *pww* (car pww-varname))))
 165     (receive (weak strong)
 166         (partition (lambda (module)
 167                      (or (member module ncx)
 168                          (every (lambda (i)
 169                                   (member i nci))
 170                                 (map edge-down (mod-down-ls module)))))
 171                    external)
 172       (format #t "AC_DEFUN([AUTOFRISK_CHECKS],[\n\n")
 173       (>>strong strong)
 174       (format #t "\n~A=~S\n\n" *pww* "")
 175       (>>weak (fold (lambda (module so-far)
 176                       (append so-far (mod-down-ls module)))
 177                     (list)
 178                     weak))
 179       (>>programs (cfg 'programs))
 180       (format #t "AC_SUBST(~A)\n])\n\n" *pww*))))
 181
 182 (define (>>summary)
 183   (format #t
 184           (symbol->string
 185            '#{
 186 AC_DEFUN([AUTOFRISK_SUMMARY],[
 187 if test ! "$~A" = "" ; then
 188     p="         ***"
 189     echo "$p"
 190     echo "$p NOTE:"
 191     echo "$p The following modules probably won't work:"
 192     echo "$p   $~A"
 193     echo "$p They can be installed anyway, and will work if their"
 194     echo "$p dependencies are installed later.  Please see README."
 195     echo "$p"
 196 fi
 197 ])
 198 }#)
 199           *pww* *pww*))
 200
 201 (define (autofrisk . args)
 202   (let ((file (if (null? args) "modules.af" (car args))))
 203     (or (file-exists? file)
 204         (error "could not find input file:" file))
 205     (with-output-to-file (format #f "~A.m4" file)
 206       (lambda ()
 207         (>>checks (read-scheme-source-silently file))
 208         (>>summary)))))
 209
 210 (define main autofrisk)
 211
 212 ;; Local variables:
 213 ;; eval: (put 'receive 'scheme-indent-function 2)
 214 ;; End:
 215
 216 ;;; autofrisk ends here